From 9bc856ddbfbb72ad01f2350ded06d7713781f645 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 14 May 2004 15:55:12 +0200 Subject: [PATCH] [multiple changes] 2004-05-14 Robert Dewar * gnat_ugn.texi: Minor change to -gnatS documentation * sprint.adb: Remove some instances of Assert (False) and for this purpose replace them by output of a ??? string. * checks.adb, exp_aggr.adb, sem_elim.adb: Remove useless pragma Assert (False). * lib-writ.adb, lib-load.adb, lib.ads, lib.adb: Remove Dependent_Unit flag processing. This was suppressing required dependencies in No_Run_Time mode and is not needed since the binder does not generate references for things in libgnat anyway. * sem_ch3.adb (Access_Type_Declaration): Reorganize code to avoid GCC warning. 2004-05-14 Thomas Quinot * gnat_ugn.texi: Document AIX-specific issue with initialization of resolver library. * exp_ch4.adb (Insert_Dereference_Action): Do not generate dereference action for the case of an actual parameter in an init proc call. 2004-05-14 Ed Schonberg * sem_ch4.adb (Analyze_Selected_Component): If prefix is a protected subtype, check visible entities in base type. * exp_ch7.adb (Clean_Simple_Protected_Objects): Do not generate cleanup actions if the object is a renaming. * sem_ch12.adb (Same_Instantiated_Entity): Predicate for Check_Formal_Package_Instance, to determine more precisely when the formal and the actual denote the same entity. 2004-05-14 Javier Miranda * par-ch10.adb (P_Context_Clause): Complete documentation on AI-262 * sem_ch10.adb (Analyze_With_Clause): After analyzed, the entity corresponding to a private_with must be removed from visibility; it will be made visible later, just before we analyze the private part of the package. (Check_Private_Child_Unit): Allow private_with clauses in public siblings. (Install_Siblings): Make visible the private entities of private-withed siblings. (Install_Withed_Unit): Do not install the private withed unit if we are compiling a package declaration and the Private_With_OK flag was not set by the caller. These declarations will be installed later, just before we analyze the private part of the package. * sem_ch3.adb (Analyze_Object_Declaration): In case of errors detected during the evaluation of the expression that initializes the object, decorate it with the expected type to avoid cascade errors. Code cleanup. * sem_ch6.adb (Analyze_Subprogram_Body): If we are compiling a library subprogram we have to install the private_with clauses after its specification has been analyzed (as documented in AI-262.TXT). * sem_ch8.adb (Has_Private_With): New function. Determines if the current compilation unit has a private with on a given entity. (Find_Direct_Name): Detect the Beaujolais problem described in AI-262.TXT * sem_utils.ads, sem_util.adb (Is_Ancestor_Package): New function. It provides the functionality of the function Is_Ancestor that was previously available in sem_ch10. It has been renamed to avoid overloading. * sprint.adb (Sprint_Node_Actual): Print limited_with clauses 2004-05-14 Richard Kenner * utils.c (build_vms_descriptor): Use SImode pointers. 2004-05-14 Vasiliy Fofanov * gnat_ugn.texi: Revised chapter "GNAT and Libraries". 2004-05-14 GNAT Script * Make-lang.in: Makefile automatically updated From-SVN: r81844 --- gcc/ada/ChangeLog | 88 +++++++++ gcc/ada/Make-lang.in | 8 +- gcc/ada/checks.adb | 3 +- gcc/ada/exp_aggr.adb | 12 +- gcc/ada/exp_ch4.adb | 21 +- gcc/ada/exp_ch7.adb | 1 + gcc/ada/gnat_ugn.texi | 447 ++++++++++++++++++++++++++++-------------- gcc/ada/lib-load.adb | 39 ---- gcc/ada/lib-writ.adb | 13 +- gcc/ada/lib.adb | 5 - gcc/ada/lib.ads | 11 -- gcc/ada/par-ch10.adb | 4 +- gcc/ada/sem_ch10.adb | 99 +++++----- gcc/ada/sem_ch12.adb | 67 ++++++- gcc/ada/sem_ch3.adb | 93 +++------ gcc/ada/sem_ch4.adb | 3 +- gcc/ada/sem_ch6.adb | 10 + gcc/ada/sem_ch8.adb | 118 ++++++++++- gcc/ada/sem_elim.adb | 2 +- gcc/ada/sem_util.adb | 25 +++ gcc/ada/sem_util.ads | 5 + gcc/ada/sprint.adb | 16 +- gcc/ada/utils.c | 22 ++- 23 files changed, 743 insertions(+), 369 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7ba15df2373..16d3d0a7225 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,91 @@ +2004-05-14 Robert Dewar + + * gnat_ugn.texi: Minor change to -gnatS documentation + + * sprint.adb: Remove some instances of Assert (False) and for this + purpose replace them by output of a ??? string. + + * checks.adb, exp_aggr.adb, sem_elim.adb: Remove useless pragma + Assert (False). + + * lib-writ.adb, lib-load.adb, lib.ads, lib.adb: Remove Dependent_Unit + flag processing. This was suppressing required dependencies in + No_Run_Time mode and is not needed since the binder does not generate + references for things in libgnat anyway. + + * sem_ch3.adb (Access_Type_Declaration): Reorganize code to avoid GCC + warning. + +2004-05-14 Thomas Quinot + + * gnat_ugn.texi: Document AIX-specific issue with initialization of + resolver library. + + * exp_ch4.adb (Insert_Dereference_Action): Do not generate dereference + action for the case of an actual parameter in an init proc call. + +2004-05-14 Ed Schonberg + + * sem_ch4.adb (Analyze_Selected_Component): If prefix is a protected + subtype, check visible entities in base type. + + * exp_ch7.adb (Clean_Simple_Protected_Objects): Do not generate cleanup + actions if the object is a renaming. + + * sem_ch12.adb (Same_Instantiated_Entity): Predicate for + Check_Formal_Package_Instance, to determine more precisely when the + formal and the actual denote the same entity. + +2004-05-14 Javier Miranda + + * par-ch10.adb (P_Context_Clause): Complete documentation on AI-262 + + * sem_ch10.adb (Analyze_With_Clause): After analyzed, the entity + corresponding to a private_with must be removed from visibility; it + will be made visible later, just before we analyze the private part of + the package. + (Check_Private_Child_Unit): Allow private_with clauses in public + siblings. + (Install_Siblings): Make visible the private entities of private-withed + siblings. + (Install_Withed_Unit): Do not install the private withed unit if we + are compiling a package declaration and the Private_With_OK flag was + not set by the caller. These declarations will be installed later, + just before we analyze the private part of the package. + + * sem_ch3.adb (Analyze_Object_Declaration): In case of errors detected + during the evaluation of the expression that initializes the object, + decorate it with the expected type to avoid cascade errors. + Code cleanup. + + * sem_ch6.adb (Analyze_Subprogram_Body): If we are compiling a library + subprogram we have to install the private_with clauses after its + specification has been analyzed (as documented in AI-262.TXT). + + * sem_ch8.adb (Has_Private_With): New function. Determines if the + current compilation unit has a private with on a given entity. + (Find_Direct_Name): Detect the Beaujolais problem described in + AI-262.TXT + + * sem_utils.ads, sem_util.adb (Is_Ancestor_Package): New function. It + provides the functionality of the function Is_Ancestor that was + previously available in sem_ch10. It has been renamed to avoid + overloading. + + * sprint.adb (Sprint_Node_Actual): Print limited_with clauses + +2004-05-14 Richard Kenner + + * utils.c (build_vms_descriptor): Use SImode pointers. + +2004-05-14 Vasiliy Fofanov + + * gnat_ugn.texi: Revised chapter "GNAT and Libraries". + +2004-05-14 GNAT Script + + * Make-lang.in: Makefile automatically updated + 2004-05-14 Arnaud Charlet Renaming of target specific files for clarity diff --git a/gcc/ada/Make-lang.in b/gcc/ada/Make-lang.in index 0a6775a438f..1342a542da2 100644 --- a/gcc/ada/Make-lang.in +++ b/gcc/ada/Make-lang.in @@ -2328,10 +2328,10 @@ ada/lib-load.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \ ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \ - ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \ - ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/types.ads \ - ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \ - ada/unchdeal.ads ada/urealp.ads ada/widechar.ads + ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tbuild.ads \ + ada/tbuild.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \ + ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \ + ada/urealp.ads ada/widechar.ads ada/lib-util.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \ ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \ diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 059730067e0..713ea26306c 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -2596,8 +2596,7 @@ package body Checks is Check_Null_Not_Allowed (N); when others => - pragma Assert (False); - null; + raise Program_Error; end case; end Null_Exclusion_Static_Checks; diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 8dd7492a631..966b848931c 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4122,8 +4122,7 @@ package body Exp_Aggr is -- Ada 0Y (AI-287): This case has not been analyzed??? - pragma Assert (False); - null; + raise Program_Error; end if; -- Name in assignment is explicit dereference. @@ -4743,11 +4742,13 @@ package body Exp_Aggr is Typ : Entity_Id; Target : Node_Id; Flist : Node_Id := Empty; - Obj : Entity_Id := Empty) return List_Id is + Obj : Entity_Id := Empty) return List_Id + is begin if Is_Record_Type (Etype (N)) then return Build_Record_Aggr_Code (N, Typ, Target, Flist, Obj); - elsif Is_Array_Type (Etype (N)) then + + else pragma Assert (Is_Array_Type (Etype (N))); return Build_Array_Aggr_Code (N => N, @@ -4757,9 +4758,6 @@ package body Exp_Aggr is Scalar_Comp => Is_Scalar_Type (Component_Type (Typ)), Indices => No_List, Flist => Flist); - else - pragma Assert (False); - return New_List; end if; end Late_Expansion; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index aec55719a8d..4ae959a992d 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -6529,7 +6529,7 @@ package body Exp_Ch4 is Loc : constant Source_Ptr := Sloc (N); Typ : constant Entity_Id := Etype (N); Pool : constant Entity_Id := Associated_Storage_Pool (Typ); - Pnod : constant Node_Id := Parent (N); + Pnod : Node_Id := Parent (N); function Is_Checked_Storage_Pool (P : Entity_Id) return Boolean; -- Return true if type of P is derived from Checked_Pool; @@ -6578,6 +6578,25 @@ package body Exp_Ch4 is return; end if; + -- Do not generate a dereference check for the object passed + -- to an init proc: such a check is not desired (we know for + -- sure that a valid dereference is passed to init procs, + -- and the calls to 'Size and 'Alignment containent in the + -- dereference check would be erroneous anyway if the init proc + -- has not been executed yet.) + + while Present (Pnod) loop + if Nkind (Pnod) = N_Procedure_Call_Statement + and then Is_Entity_Name (Name (Pnod)) + and then Is_Init_Proc (Name (Pnod)) + then + return; + end if; + + Pnod := Parent (Pnod); + exit when Nkind (Pnod) not in N_Subexpr; + end loop; + Insert_Action (N, Make_Procedure_Call_Statement (Loc, Name => New_Reference_To ( diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 287b4efc792..426658564e2 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -706,6 +706,7 @@ package body Exp_Ch7 is or else Ekind (E) = E_Constant) and then Has_Simple_Protected_Object (Etype (E)) and then not Has_Task (Etype (E)) + and then Nkind (Parent (E)) /= N_Object_Renaming_Declaration then declare Typ : constant Entity_Id := Etype (E); diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 5ae1a892124..1a30c465a55 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -450,10 +450,9 @@ Cleaning Up Using gnatclean GNAT and Libraries -* Creating an Ada Library:: -* Installing an Ada Library:: -* Using an Ada Library:: -* Creating an Ada Library to be Used in a Non-Ada Context:: +* Introduction to Libraries in GNAT:: +* General Ada Libraries:: +* Stand-alone Ada Libraries:: * Rebuilding the GNAT Run-Time Library:: Using the GNU make Utility @@ -580,6 +579,7 @@ Platform-Specific Information for the Run-Time Libraries * Solaris-Specific Considerations:: * IRIX-Specific Considerations:: * Linux-Specific Considerations:: +* AIX-Specific Considerations:: Example of Binder Output File @@ -6264,7 +6264,7 @@ The use of the switch @option{-gnatS} for an Ada compilation will cause the compiler to output a representation of package Standard in a form very close to standard Ada. It is not quite possible to -do this and remain entirely Standard (since new +do this entirely in standard Ada (since new numeric base types cannot be created in standard Ada), but the output is easily readable to any Ada programmer, and is useful to @@ -6628,7 +6628,7 @@ The content of the @file{ada_source_path} file which is part of the GNAT installation tree and is used to store standard libraries such as the GNAT Run Time Library (RTL) source files. @ifclear vms -@ref{Installing an Ada Library} +@ref{Installing the library} @end ifclear @end enumerate @@ -7552,7 +7552,7 @@ installation tree and is used to store standard libraries such as the GNAT Run Time Library (RTL) unless the switch @option{-nostdlib} is specified. @ifclear vms -@ref{Installing an Ada Library} +@ref{Installing the library} @end ifclear @end enumerate @@ -14403,8 +14403,8 @@ output source file @item @var{filename} is the name (including the extension) of the source file to reformat; ``wildcards'' or several file names on the same gnatpp command are -allowed. The file name may contain path information; it does not have to follow -the GNAT file naming rules +allowed. The file name may contain path information; it does not have to +follow the GNAT file naming rules @end itemize @@ -14640,8 +14640,9 @@ Compact layout Uncompact layout @item ^-notab^/NOTABS^ -All the VT characters are removed from the comment text. All the HT characters are -expanded with the sequences of space characters to get to the next tab stops. +All the VT characters are removed from the comment text. All the HT characters +are expanded with the sequences of space characters to get to the next tab +stops. @end table @@ -16263,26 +16264,39 @@ where @code{gnatclean} was invoked. @ifclear vms @node GNAT and Libraries @chapter GNAT and Libraries -@cindex Library, building, installing +@cindex Library, building, installing, using @noindent -This chapter addresses some of the issues related to building and using -a library with GNAT. It also shows how the GNAT run-time library can be -recompiled. +This chapter addresses the issues related to building and using +libraries with GNAT. It also shows how the GNAT run-time library can be +recompiled. It is recommended that the user understands how to use the +@ref{GNAT Project Manager} facility before reading this chapter. @menu -* Creating an Ada Library:: -* Installing an Ada Library:: -* Using an Ada Library:: -* Creating an Ada Library to be Used in a Non-Ada Context:: +* Introduction to Libraries in GNAT:: +* General Ada Libraries:: +* Stand-alone Ada Libraries:: * Rebuilding the GNAT Run-Time Library:: @end menu -@node Creating an Ada Library -@section Creating an Ada Library +@node Introduction to Libraries in GNAT +@section Introduction to Libraries in GNAT @noindent -In the GNAT environment, a library has two components: +A library is, conceptually, a collection of objects which does not have its +own main thread of execution, but rather provides certain services to the +applications that use it. A library can be either statically linked with the +application, in which case its code is directly included in the application, +or, on platforms that support it, be dynamically linked, in which case +its code is shared by all applications making use of this library. GNAT +supports both types of libraries. In the static case, the compiled code can +be provided in different ways. The simplest way is to provide directly the +set of objects produced by the compiler during the compilation of the library. +It is also possible to group the objects into an archive using whatever +commands are provided by the operating system. For the later case, the objects +are grouped into a shared library. + +In the GNAT environment, a library has two types of components: @itemize @bullet @item Source files. @@ -16291,37 +16305,76 @@ Compiled code and Ali files. See @ref{The Ada Library Information Files}. @end itemize @noindent -In order to use other packages @ref{The GNAT Compilation Model} -requires a certain number of sources to be available to the compiler. -The minimal set of -sources required includes the specs of all the packages that make up the -visible part of the library as well as all the sources upon which they -depend. The bodies of all visible generic units must also be provided. -@noindent -Although it is not strictly mandatory, it is recommended that all sources -needed to recompile the library be provided, so that the user can make -full use of inter-unit inlining and source-level debugging. This can also -make the situation easier for users that need to upgrade their compilation -toolchain and thus need to recompile the library from sources. +GNAT libraries can either completely expose their source files to the +compilation context of the user's application, or alternatively only expose +a limited set of source files, called interface units, in which case they are +called @ref{Stand-alone Ada Libraries}. In addition, GNAT provides full support +for foreign libraries which are only available in the object format. + +Ada semantics requires that all compilation units comprising the application +are elaborated in the timely fashion. Where possible, GNAT provides facilities +to ensure that compilation units of a library are automatically elaborated; +however, there are cases where this must be responsibility of a user. This will +be addressed in greater detail further on. + +@node General Ada Libraries +@section General Ada Libraries + +@menu +* Building the library:: +* Installing the library:: +* Using the library:: +@end menu + +@node Building the library +@subsection Building the library @noindent -The compiled code can be provided in different ways. The simplest way is -to provide directly the set of objects produced by the compiler during -the compilation of the library. It is also possible to group the objects -into an archive using whatever commands are provided by the operating -system. Finally, it is also possible to create a shared library (see -option -shared in the GCC manual). +The easiest way to build a library is to use the @ref{GNAT Project Manager}, +which supports a special type of projects called @ref{Library Projects}. + +A project is considered a library project, when two project-level attributes +are defined in it: @code{Library_Name} and @code{Library_Dir}. In order to +control different aspects of library configuration, additional optional +project-level attributes can be specified: +@itemize +@item @code{Library_Kind} +This attribute controls whether the library is to be static or shared +@item @code{Library_Version} +This attribute specifies what is the library version; this value is used +during dynamic linking of shared libraries to determine if the currently +installed versions of the binaries are compatible. +@item @code{Library_Options}, @code{Library_GCC} +These attributes specify additional low-level options to be used during +library generation, and redefine the actual application used to generate +library. +@end itemize @noindent +GNAT Project Manager takes full care of the library maintenance task, +including recompilation of the source files for which objects do not exist +or are not up to date, assembly of the library archive, and installation of +the library, i.e. the copy of associated source, object and ALI files to the +specific location. + +It is not entirely trivial to correctly do all the steps required to +produce a library. We recommend that you use @ref{GNAT Project Manager} +for this task. In special cases where this is not desired, the necessary +steps are discussed below. + There are various possibilities for compiling the units that make up the library: for example with a Makefile @ref{Using the GNU make Utility}, or with a conventional script. For simple libraries, it is also possible to create a dummy main program which depends upon all the packages that comprise the interface of the library. This dummy main program can then be given to -gnatmake, in order to build all the necessary objects. Here is an example -of such a dummy program and the generic commands used to build an -archive or a shared library. +gnatmake, which will ensure that all necessary objects are built. + +After this task is accomplished, the user should follow the standard procedure +of the underlying operating system to produce the static or shared library. + +Below is an example of such a dummy program and the generic commands used to +build an archive or a shared library. @smallexample @c ada @iftex @@ -16360,30 +16413,23 @@ $ chmod -w *.ali @end smallexample -@noindent -When the objects are grouped in an archive or a shared library, the user -needs to specify the desired library at link time, unless a pragma -linker_options has been used in one of the sources: -@smallexample @c ada -pragma Linker_Options ("-lmy_lib"); -@end smallexample - @noindent Please note that the library must have a name of the form libxxx.a or libxxx.so in order to be accessed by the directive -lxxx at link time. -@node Installing an Ada Library -@section Installing an Ada Library +@node Installing the library +@subsection Installing the library @noindent In the GNAT model, installing a library consists in copying into a specific -location the files that make up this library. It is possible to install -the sources in a different directory from the other files (ALI, objects, -archives) since the source path and the object path can easily be -specified separately. +location the files that make up this library. When the library is built using +projects, it is automatically installed in the location specified in the +project by means of the attribute @code{Library_Dir}, otherwise it is +responsibility of the user. GNAT also supports installing the sources in a +different directory from the other files (ALI, objects, archives) since the +source path and the object path can be specified separately. -@noindent For general purpose libraries, it is possible for the system administrator to put those libraries in the default compiler paths. To achieve this, he must specify their location in the configuration files @@ -16403,7 +16449,6 @@ in their order of appearance in the file. The names can be either absolute or relative, in the latter case, they are relative to where theses files are located. -@noindent @file{ada_source_path} and @file{ada_object_path} might actually not be present in a GNAT installation, in which case, GNAT will look for its run-time library in @@ -16416,27 +16461,52 @@ be @file{adainclude}). In the same way, the @file{ada_object_path} file must contain the location for the GNAT run-time objects (which can simply be @file{adalib}). -@noindent You can also specify a new default path to the runtime library at compilation time with the switch @option{--RTS=rts-path}. You can easily choose and change the runtime you want your program to be compiled with. This switch is recognized by gcc, gnatmake, gnatbind, gnatls, gnatfind and gnatxref. -@noindent It is possible to install a library before or after the standard GNAT library, by reordering the lines in the configuration files. In general, a library must be installed before the GNAT library if it redefines any part of it. -@node Using an Ada Library -@section Using an Ada Library + +@node Using the library +@subsection Using the library + +@noindent +Once again, the project facility greatly simplifies the addition of libraries +to the compilation. If the project file for an application lists a library +project in its @code{with} clause, the project manager will ensure that the +library files are consistent, and are considered during compilation and +linking of the main application. + +Even if you have a third-party, non-Ada library, you can still use GNAT +Project facility to provide a wrapper for it. The following project for +example, when "withed" in your main project, will link with the third-party +library liba.a: + +@smallexample @c projectfile +@group +project Liba is + for Source_Dirs use (); + for Library_Dir use "lib"; + for Library_Name use "a"; + for Library_Kind use "static"; +end Liba; +@end group +@end smallexample @noindent -In order to use a Ada library, you need to make sure that this +In order to use an Ada library manually, you need to make sure that this library is on both your source and object path @ref{Search Paths and the Run-Time Library (RTL)} -and @ref{Search Paths for gnatbind}. For -instance, you can use the library @file{mylib} installed in +and @ref{Search Paths for gnatbind}. Furthermore, when the objects are grouped +in an archive or a shared library, the user needs to specify the desired +library at link time. + +By means of example, you can use the library @file{mylib} installed in @file{/dir/my_lib_src} and @file{/dir/my_lib_obj} with the following commands: @smallexample @@ -16460,98 +16530,173 @@ variable @code{ADA_INCLUDE_PATH}, or by the administrator to the file variable @code{ADA_OBJECTS_PATH}, or by the administrator to the file @file{ada_object_path} @item -a pragma @code{Linker_Options}, as mentioned in @ref{Creating an Ada Library}, -has been added to the sources. +a pragma @code{Linker_Options}, has been added to one of the sources. +For example: + +@smallexample @c ada +pragma Linker_Options ("-lmy_lib"); +@end smallexample @end itemize -@noindent -@node Creating an Ada Library to be Used in a Non-Ada Context -@section Creating an Ada Library to be Used in a Non-Ada Context -@noindent -The previous sections detailed how to create and install a library that -was usable from an Ada main program. Using this library in a non-Ada -context is not possible, because the elaboration of the library is -automatically done as part of the main program elaboration. +@node Stand-alone Ada Libraries +@section Stand-alone Ada Libraries +@cindex Stand-alone library, building, using -GNAT also provides the ability to build libraries that can be used both -in an Ada and non-Ada context. This section describes how to build such -a library, and then how to use it from a C program. The method for -interfacing with the library from other languages such as Fortran for -instance remains the same. +@menu +* Introduction to Stand-Alone Libraries:: +* Building SAL:: +* Creating SAL to be used in a non-Ada context:: +* Restrictions in SALs:: +@end menu -@subsection Creating the Library +@node Introduction to Stand-Alone Libraries +@subsection Introduction to Stand-Alone Libraries -@itemize @bullet -@item Identify the units representing the interface of the library. +@noindent +A Stand-alone Library (SAL) is a library that contains the necessary code to +elaborate the Ada units that are included in the library. Different from +ordinary libraries, which consist of all sources, objects and ALI files of the +library, the SAL creator can specify a restricted subset of compilation units +comprising SAL to serve as a library interface. In this case, the fully +self-sufficient set of files of such library will normally consist of objects +archive, sources of interface units specs, and ALI files of interface units. +Note that if interface specs contain generics or inlined subprograms, body +source must also be provided; if the units that must be provided in the source +form depend on other units, the source and ALIs of those must also be provided. -Here is an example of simple library interface: +The main purpose of SAL is to minimize the recompilation overhead of client +applications when the new version of the library is installed. Specifically, +if the interface sources have not changed, client applications do not need to +be recompiled. If, furthermore, SAL is provided in the shared form and its +version, controlled by @code{Library_Version} attribute, is not changed, the +clients don't need to be relinked, either. -@smallexample @c ada -package Interface is +SALs also allow the library providers to minimize amount of library source +text exposed to the clients, which might be necessary for different reasons. - procedure Do_Something; +Stand-alone libraries are also well suited to be used in an executable which +main is not written in Ada. - procedure Do_Something_Else; +@node Building SAL +@subsection Building SAL -end Interface; -@end smallexample +@noindent +GNAT Project facility provides a simple way of building and installing +stand-alone libraries, see @ref{Stand-alone Library Projects}. +To be a Stand-alone Library Project, in addition to the two attributes +that make a project a Library Project (@code{Library_Name} and +@code{Library_Dir}, see @ref{Library Projects}), the attribute +@code{Library_Interface} must be defined. -@item Use @code{pragma Export} or @code{pragma Convention} for the -exported entities. +@smallexample @c projectfile +@group + for Library_Dir use "lib_dir"; + for Library_Name use "dummy"; + for Library_Interface use ("int1", "int1.child"); +@end group +@end smallexample -Our package @code{Interface} is then updated as follow: -@smallexample @c ada -package Interface is +Attribute @code{Library_Interface} has a non empty string list value, +each string in the list designating a unit contained in an immediate source +of the project file. - procedure Do_Something; - pragma Export (C, Do_Something, "do_something"); +When a Stand-alone Library is built, first the binder is invoked to build +a package whose name depends on the library name +(^b~dummy.ads/b^B$DUMMY.ADS/B^ in the example above). +This binder-generated package includes initialization and +finalization procedures whose +names depend on the library name (dummyinit and dummyfinal in the example +above). The object corresponding to this package is included in the library. - procedure Do_Something_Else; - pragma Export (C, Do_Something_Else, "do_something_else"); +The user must ensure timely (e.g. prior to any use of interfaces in the SAL) +calling of these procedures if static SAL is built, or shared SAL is built +with project-level attribute @code{Library_Auto_Init} set to "false". -end Interface; -@end smallexample +For a Stand-Alone Library, only the @file{ALI} files of the Interface Units +(those that are listed in attribute @code{Library_Interface}) are copied to +the Library Directory. As a consequence, only the Interface Units may be +imported from Ada units outside of the library. If other units are imported, +the binding phase will fail. -@item Compile all the units composing the library. +The attribute @code{Library_Src_Dir}, may be specified for a +Stand-Alone Library. @code{Library_Src_Dir} is a simple attribute that has a +single string value. Its value must be the path (absolute or relative to the +project directory) of an existing directory. This directory cannot be the +object directory or one of the source directories, but it can be the same as +the library directory. The sources of the Interface +Units of the library, necessary to an Ada client of the library, will be +copied to the designated directory, called Interface Copy directory. +These sources includes the specs of the Interface Units, but they may also +include bodies and subunits, when pragmas @code{Inline} or @code{Inline_Always} +are used, or when there is a generic units in the spec. Before the sources +are copied to the Interface Copy directory, an attempt is made to delete all +files in the Interface Copy directory. -@item Bind the library objects. +Building stand-alone libraries by hand is difficult. Below are listed the steps +necessary to be done by the user: +@itemize @bullet +@item +compile all library sources +@item +invoke the binder with the switch -n (No Ada main program), +with all the ALI files of the interfaces, and +with the switch -L to give specific names to the init and final +procedure. +@smallexample + gnatbind -n int1.ali int2.ali -Lsal1 +@end smallexample +@item +compile the binder generated file +@smallexample + gcc -c b~int2.adb +@end smallexample +@item +link the dynamic library with all the necessary object files, +indicating to the linker the names of the init (and possibly +final) procedures for automatic initialization (and finalization). +The built library should be put in a directory different from +the object directory. +@item +copy the ALI files of the interface to the library directory, +add in the copy the indication that it is an interface to a SAL +(i.e. add a word @option{SL} on the line in ALI file that starts +with letter P) and make the modified copy of the ALI file read-only. +@end itemize -This step is performed by invoking gnatbind with the @option{-L} -switch. @code{gnatbind} will then generate the library elaboration -procedure (named @code{init}) and the run-time finalization -procedure (named @code{final}). +@noindent +Using SALs is not different from using other libraries +(see @ref{Using the library}). -@smallexample -# generate the binder file in Ada -$ gnatbind -Lmylib interface +@node Creating SAL to be used in a non-Ada context +@subsection Creating SAL to be used in a non-Ada context -# generate the binder file in C -$ gnatbind -C -Lmylib interface -@end smallexample +@noindent +It is easy to adapt SAL build procedure discussed above for use of SAL in +a non-Ada context. -@item Compile the files generated by the binder +The only extra step required is to ensure that library interface subprograms +are compatible with the main program, by means of @code{pragma Export} +or @code{pragma Convention}. -@smallexample -$ gcc -c b~interface.adb -@end smallexample +Here is an example of simple library interface for use with C main program: -@item Create the library; +@smallexample @c ada +package Interface is -The procedure is identical to the procedure explained in -@ref{Creating an Ada Library}, -except that @file{b~interface.o} needs to be added to -the list of objects. + procedure Do_Something; + pragma Export (C, Do_Something, "do_something"); -@smallexample -# create an archive file -$ ar cr libmylib.a b~interface.o + procedure Do_Something_Else; + pragma Export (C, Do_Something_Else, "do_something_else"); -# create a shared library -$ gcc -shared -o libmylib.so b~interface.o +end Interface; @end smallexample -@item Provide a ``foreign'' view of the library interface; +@noindent +On the foreign language side, you must provide a ``foreign'' view of the +library interface; remeber that it should contain elaboration routines in +addition to interface subrporams. The example below shows the content of @code{mylib_interface.h} (note that there is no rule for the naming of this file, any name can be used) @@ -16566,9 +16711,6 @@ extern void mylibfinal (void); extern void do_something (void); extern void do_something_else (void); @end smallexample -@end itemize - -@subsection Using the Library @noindent Libraries built as explained above can be used from any program, provided @@ -16599,23 +16741,14 @@ main (void) @end smallexample @noindent -Note that this same library can be used from an equivalent Ada main -program. In addition, if the libraries are installed as detailed in -@ref{Installing an Ada Library}, it is not necessary to invoke the -library elaboration and finalization routines. The binder will ensure -that this is done as part of the main program elaboration and -finalization phases. - -@subsection The Finalization Phase - -@noindent -Invoking any library finalization procedure generated by @code{gnatbind} -shuts down the Ada run time permanently. Consequently, the finalization -of all Ada libraries must be performed at the end of the program. No -call to these libraries nor the Ada run time should be made past the +Note that invoking any library finalization procedure generated by +@code{gnatbind} shuts down the Ada run time permanently. Consequently, the +finalization of all Ada libraries must be performed at the end of the program. +No call to these libraries nor the Ada run time should be made past the finalization phase. -@subsection Restrictions in Libraries +@node Restrictions in SALs +@subsection Restrictions in SALs @noindent The pragmas listed below should be used with caution inside libraries, @@ -16647,11 +16780,12 @@ to be a consideration. @node Rebuilding the GNAT Run-Time Library @section Rebuilding the GNAT Run-Time Library +@cindex GNAT Run-Time Library, rebuilding @noindent It may be useful to recompile the GNAT library in various contexts, the most important one being the use of partition-wide configuration pragmas -such as Normalize_Scalar. A special Makefile called +such as @code{Normalize_Scalars}. A special Makefile called @code{Makefile.adalib} is provided to that effect and can be found in the directory containing the GNAT library. The location of this directory depends on the way the GNAT environment has been installed and can @@ -16667,6 +16801,7 @@ gnat library. This Makefile contains its own documentation and in particular the set of instructions needed to rebuild a new library and to use it. + @node Using the GNU make Utility @chapter Using the GNU @code{make} Utility @findex make @@ -20694,6 +20829,7 @@ information about several specific platforms. * Solaris-Specific Considerations:: * IRIX-Specific Considerations:: * Linux-Specific Considerations:: +* AIX-Specific Considerations:: @end menu @@ -21106,7 +21242,22 @@ compared to other native thread libraries: e.g. by using @code{killpg()}. @end itemize +@node AIX-Specific Considerations +@section AIX-Specific Considerations +@cindex AIX resolver library + +@noindent +On AIX, the resolver library initializes some internal structure on +the first call to @code{get*by*} functions, which are used to implement +@code{GNAT.Sockets.Get_Host_By_Name} and @code{GNAT.Sockets.Get_Host_By_Addrss}. +If such initialization occurs within an Ada task, and the stack size for +the task is the default size, a stack overflow may occur. +To avoid this overflow, the user should either ensure that the first call +to @code{GNAT.Sockets.Get_Host_By_Name} or @code{GNAT.Sockets.Get_Host_By_Addrss} +occurs in the environment task, or use @code{pragma Storage_Size} to +specify a sufficiently large size for the stack of the task that contains +this call. @c ******************************* @node Example of Binder Output File diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index b294a84305f..03dcfe8cd73 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -43,7 +43,6 @@ with Sinfo; use Sinfo; with Sinput; use Sinput; with Sinput.L; use Sinput.L; with Stand; use Stand; -with Targparm; use Targparm; with Tbuild; use Tbuild; with Uname; use Uname; @@ -143,7 +142,6 @@ package body Lib.Load is Cunit => Cunit, Cunit_Entity => Cunit_Entity, Dependency_Num => 0, - Dependent_Unit => False, Dynamic_Elab => False, Error_Location => Sloc (With_Node), Expected_Unit => Spec_Name, @@ -215,7 +213,6 @@ package body Lib.Load is Cunit => Empty, Cunit_Entity => Empty, Dependency_Num => 0, - Dependent_Unit => True, Dynamic_Elab => False, Error_Location => No_Location, Expected_Unit => No_Name, @@ -253,39 +250,6 @@ package body Lib.Load is Fname : File_Name_Type; Src_Ind : Source_File_Index; - procedure Set_Load_Unit_Dependency (U : Unit_Number_Type); - -- Sets the Dependent_Unit flag unless we have a predefined unit - -- being loaded in High_Integrity_Mode. In this case we do not want - -- to create a dependency, since we have loaded the unit only - -- to inline stuff from it. If this is not the case, an error - -- message will be issued in Rtsfind in any case. - - ------------------------------ - -- Set_Load_Unit_Dependency -- - ------------------------------ - - procedure Set_Load_Unit_Dependency (U : Unit_Number_Type) is - begin - -- Differentiate between pragma No_Run_Time mode (that can be - -- used with a standard installation), and HI-E mode which comes - -- with a special installation. - - -- For Configurable_Run_Time_Mode set by a pragma, we do not want to - -- create a dependency since the binder would generate references to - -- these units. In the case of configurable run-time, we do want to - -- establish this dependency. - - if Configurable_Run_Time_Mode - and then not Configurable_Run_Time_On_Target - and then not Debug_Flag_YY - and then Is_Internal_File_Name (Unit_File_Name (U)) - then - null; - else - Units.Table (U).Dependent_Unit := True; - end if; - end Set_Load_Unit_Dependency; - -- Start of processing for Load_Unit begin @@ -547,7 +511,6 @@ package body Lib.Load is end if; Load_Stack.Decrement_Last; - Set_Load_Unit_Dependency (Unum); return Unum; -- Unit is not already in table, so try to open the file @@ -574,7 +537,6 @@ package body Lib.Load is Cunit => Empty, Cunit_Entity => Empty, Dependency_Num => 0, - Dependent_Unit => False, Dynamic_Elab => False, Error_Location => Sloc (Error_Node), Expected_Unit => Uname_Actual, @@ -631,7 +593,6 @@ package body Lib.Load is -- Remove load stack entry and return the entry in the file table Load_Stack.Decrement_Last; - Set_Load_Unit_Dependency (Unum); return Unum; -- Case of file not found diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 1259bc890b7..7168e69c9a2 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -68,7 +68,6 @@ package body Lib.Writ is Cunit => Empty, Cunit_Entity => Empty, Dependency_Num => 0, - Dependent_Unit => True, Dynamic_Elab => False, Fatal_Error => False, Generate_Code => False, @@ -122,7 +121,6 @@ package body Lib.Writ is Cunit => Empty, Cunit_Entity => Empty, Dependency_Num => 0, - Dependent_Unit => True, Dynamic_Elab => False, Fatal_Error => False, Generate_Code => False, @@ -619,7 +617,6 @@ package body Lib.Writ is if Unit_Name (J) /= No_Name and then (With_Flags (J) or else Unit_Name (J) = Pname) - and then Units.Table (J).Dependent_Unit then Num_Withs := Num_Withs + 1; With_Table (Num_Withs) := J; @@ -1042,11 +1039,9 @@ package body Lib.Writ is Write_Info_Initiate ('D'); Write_Info_Char (' '); - -- Normal case of a dependent unit entry with a source index + -- Normal case of a unit entry with a source index - if Sind /= No_Source_File - and then Units.Table (Unum).Dependent_Unit - then + if Sind /= No_Source_File then Write_Info_Name (File_Name (Sind)); Write_Info_Tab (25); Write_Info_Str (String (Time_Stamp (Sind))); @@ -1078,8 +1073,8 @@ package body Lib.Writ is Write_Info_Name (Reference_Name (Sind)); end if; - -- Case where there is no source index (happens for missing files) - -- Also come here for non-dependent units. + -- Case where there is no source index (happens for missing + -- files). In this case we write a dummy time stamp. else Write_Info_Name (Unit_File_Name (Unum)); diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index e726c2d760f..d1e8781c904 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -83,11 +83,6 @@ package body Lib is return Units.Table (U).Dependency_Num; end Dependency_Num; - function Dependent_Unit (U : Unit_Number_Type) return Boolean is - begin - return Units.Table (U).Dependent_Unit; - end Dependent_Unit; - function Dynamic_Elab (U : Unit_Number_Type) return Boolean is begin return Units.Table (U).Dynamic_Elab; diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index d45ccfba746..e48f2245775 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -361,14 +361,6 @@ package Lib is -- then called to reflect the contributions of any unit on which this -- unit is semantically dependent. - -- Dependent_Unit - -- This is a Boolean flag, which is set True to indicate that this - -- entry is for a semantically dependent unit. This flag is nearly - -- always set True, the only exception is for a unit that is loaded - -- by an Rtsfind request in High_Integrity_Mode, where the entity that - -- is obtained by Rtsfind.RTE is for an inlined subprogram or other - -- entity for which a dependency need not be created. - -- The units table is reset to empty at the start of the compilation of -- each main unit by Lib.Initialize. Entries are then added by calls to -- the Lib.Load procedure. The following subprograms are used to access @@ -381,7 +373,6 @@ package Lib is function Cunit (U : Unit_Number_Type) return Node_Id; function Cunit_Entity (U : Unit_Number_Type) return Entity_Id; - function Dependent_Unit (U : Unit_Number_Type) return Boolean; function Dependency_Num (U : Unit_Number_Type) return Nat; function Dynamic_Elab (U : Unit_Number_Type) return Boolean; function Error_Location (U : Unit_Number_Type) return Source_Ptr; @@ -621,7 +612,6 @@ private pragma Inline (Cunit); pragma Inline (Cunit_Entity); pragma Inline (Dependency_Num); - pragma Inline (Dependent_Unit); pragma Inline (Fatal_Error); pragma Inline (Generate_Code); pragma Inline (Has_RACW); @@ -650,7 +640,6 @@ private Cunit : Node_Id; Cunit_Entity : Entity_Id; Dependency_Num : Int; - Dependent_Unit : Boolean; Fatal_Error : Boolean; Generate_Code : Boolean; Has_RACW : Boolean; diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb index d45e727e97c..d776635a778 100644 --- a/gcc/ada/par-ch10.adb +++ b/gcc/ada/par-ch10.adb @@ -799,8 +799,8 @@ package body Ch10 is -- Processing for WITH clause - -- Ada0Y (AI-50217): First check for LIMITED WITH, PRIVATE WITH, - -- or both. + -- Ada0Y (AI-50217, AI-262): First check for LIMITED WITH, + -- PRIVATE WITH, or both. if Token = Tok_Limited then Has_Limited := True; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 9c0da7f97f7..4283ae0beb2 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -1812,6 +1812,14 @@ package body Sem_Ch10 is null; end if; + + -- Ada 0Y (AI-262): Remove from visibility the entity corresponding to + -- private_with units; they will be made visible later (just before the + -- private part is analyzed) + + if Private_Present (N) then + Set_Is_Immediately_Visible (E_Name, False); + end if; end Analyze_With_Clause; ------------------------------ @@ -2226,8 +2234,12 @@ package body Sem_Ch10 is Item := First (Context_Items (N)); while Present (Item) loop + -- Ada 0Y (AI-262): Allow private_with of a private child package in + -- public siblings + if Nkind (Item) = N_With_Clause and then not Implicit_With (Item) + and then not Private_Present (Item) and then Is_Private_Descendant (Entity (Name (Item))) then Priv_Child := Entity (Name (Item)); @@ -2422,7 +2434,7 @@ package body Sem_Ch10 is Mark_Rewrite_Insertion (Withn); end if; - elsif Nkind (Nam) = N_Selected_Component then + else pragma Assert (Nkind (Nam) = N_Selected_Component); Withn := Make_With_Clause (Loc, @@ -2453,10 +2465,6 @@ package body Sem_Ch10 is Expand_Limited_With_Clause (Prefix (Nam), N); end if; - - else - null; - pragma Assert (False); end if; New_Nodes_OK := New_Nodes_OK - 1; @@ -3154,6 +3162,12 @@ package body Sem_Ch10 is Clause : Node_Id; begin + if Debug_Flag_I then + Write_Str ("install private with clauses of "); + Write_Name (Chars (P)); + Write_Eol; + end if; + if Nkind (Parent (Decl)) = N_Compilation_Unit then Clause := First (Context_Items (Parent (Decl))); while Present (Clause) loop @@ -3176,36 +3190,6 @@ package body Sem_Ch10 is Item : Node_Id; Id : Entity_Id; Prev : Entity_Id; - - function Is_Ancestor (E : Entity_Id) return Boolean; - -- Determine whether the scope of a child unit is an ancestor of - -- the current unit. - -- Shouldn't this be somewhere more general ??? - - ----------------- - -- Is_Ancestor -- - ----------------- - - function Is_Ancestor (E : Entity_Id) return Boolean is - Par : Entity_Id; - - begin - Par := U_Name; - while Present (Par) - and then Par /= Standard_Standard - loop - if Par = E then - return True; - end if; - - Par := Scope (Par); - end loop; - - return False; - end Is_Ancestor; - - -- Start of processing for Install_Siblings - begin -- Iterate over explicit with clauses, and check whether the -- scope of each entity is an ancestor of the current unit. @@ -3219,14 +3203,22 @@ package body Sem_Ch10 is Id := Entity (Name (Item)); if Is_Child_Unit (Id) - and then Is_Ancestor (Scope (Id)) + and then Is_Ancestor_Package (Scope (Id), U_Name) then Set_Is_Immediately_Visible (Id); - Prev := Current_Entity (Id); + + -- Ada 0Y (AI-262): Make visible the private entities of + -- private-withed siblings + + if Private_Present (Item) then + Install_Private_Declarations (Id); + end if; -- Check for the presence of another unit in the context, -- that may be inadvertently hidden by the child. + Prev := Current_Entity (Id); + if Present (Prev) and then Is_Immediately_Visible (Prev) and then not Is_Child_Unit (Prev) @@ -3257,7 +3249,7 @@ package body Sem_Ch10 is -- the child immediately visible. elsif Is_Child_Unit (Scope (Id)) - and then Is_Ancestor (Scope (Scope (Id))) + and then Is_Ancestor_Package (Scope (Scope (Id)), U_Name) then Set_Is_Immediately_Visible (Scope (Id)); end if; @@ -3327,8 +3319,7 @@ package body Sem_Ch10 is return; when others => - pragma Assert (False); - null; + raise Program_Error; end case; P := Defining_Unit_Name (Specification (P_Unit)); @@ -3472,9 +3463,25 @@ package body Sem_Ch10 is P : constant Entity_Id := Scope (Uname); begin + -- Ada 0Y (AI-262): Do not install the private withed unit if we are + -- compiling a package declaration and the Private_With_OK flag was not + -- set by the caller. These declarations will be installed later (before + -- analyzing the private part of the package). + + if Private_Present (With_Clause) + and then Nkind (Cunit (Current_Sem_Unit)) = N_Package_Declaration + and then not (Private_With_OK) + then + return; + end if; if Debug_Flag_I then - Write_Str ("install withed unit "); + if Private_Present (With_Clause) then + Write_Str ("install private withed unit "); + else + Write_Str ("install withed unit "); + end if; + Write_Name (Chars (Uname)); Write_Eol; end if; @@ -3492,17 +3499,13 @@ package body Sem_Ch10 is end if; if P /= Standard_Standard then - if Private_Present (With_Clause) - and then not (Private_With_OK) - then - return; -- If the unit is not analyzed after analysis of the with clause, -- and it is an instantiation, then it awaits a body and is the main -- unit. Its appearance in the context of some other unit indicates -- a circular dependency (DEC suite perversity). - elsif not Analyzed (Uname) + if not Analyzed (Uname) and then Nkind (Parent (Uname)) = N_Package_Instantiation then Error_Msg_N @@ -3520,7 +3523,6 @@ package body Sem_Ch10 is Set_Is_Visible_Child_Unit (Related_Instance (Defining_Entity (Unit (Library_Unit (With_Clause))))); - null; end if; -- The parent unit may have been installed already, and @@ -3909,8 +3911,7 @@ package body Sem_Ch10 is return; when others => - pragma Assert (False); - null; + raise Program_Error; end case; -- Check if the chain is already built diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 69930b81a04..7684845103a 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3636,6 +3636,16 @@ package body Sem_Ch12 is -- Common error routine for mismatch between the parameters of -- the actual instance and those of the formal package. + function Same_Instantiated_Entity (E1, E2 : Entity_Id) return Boolean; + -- The formal may come from a nested formal package, and the actual + -- may have been constant-folded. To determine whether the two denote + -- the same entity we may have to traverse several definitions to + -- recover the ultimate entity that they refer to. + + -------------------- + -- Check_Mismatch -- + -------------------- + procedure Check_Mismatch (B : Boolean) is begin if B then @@ -3645,6 +3655,42 @@ package body Sem_Ch12 is end if; end Check_Mismatch; + ------------------------------ + -- Same_Instantiated_Entity -- + ------------------------------ + + function Same_Instantiated_Entity (E1, E2 : Entity_Id) return Boolean is + Ent : Entity_Id; + + begin + Ent := E2; + while Present (Ent) loop + if E1 = Ent then + return True; + + elsif Ekind (Ent) /= E_Constant then + return False; + + elsif Is_Entity_Name (Constant_Value (Ent)) then + if Entity (Constant_Value (Ent)) = E1 then + return True; + else + Ent := Entity (Constant_Value (Ent)); + end if; + + -- The actual may be a constant that has been folded. Recover + -- original name. + + elsif Is_Entity_Name (Original_Node (Constant_Value (Ent))) then + Ent := Entity (Original_Node (Constant_Value (Ent))); + else + return False; + end if; + end loop; + + return False; + end Same_Instantiated_Entity; + -- Start of processing for Check_Formal_Package_Instance begin @@ -3723,10 +3769,8 @@ package body Sem_Ch12 is if Entity (Expr1) = Entity (Expr2) then null; - elsif Ekind (Entity (Expr2)) = E_Constant - and then Is_Entity_Name (Constant_Value (Entity (Expr2))) - and then - Entity (Constant_Value (Entity (Expr2))) = Entity (Expr1) + elsif + Same_Instantiated_Entity (Entity (Expr1), Entity (Expr2)) then null; else @@ -3736,6 +3780,14 @@ package body Sem_Ch12 is Check_Mismatch (True); end if; + elsif Is_Entity_Name (Original_Node (Expr1)) + and then Is_Entity_Name (Expr2) + and then + Same_Instantiated_Entity + (Entity (Original_Node (Expr1)), Entity (Expr2)) + then + null; + elsif Nkind (Expr1) = N_Null then Check_Mismatch (Nkind (Expr1) /= N_Null); @@ -6160,8 +6212,7 @@ package body Sem_Ch12 is end loop; when others => - null; - pragma Assert (False); + raise Program_Error; end case; end Find_Matching_Actual; @@ -8650,6 +8701,10 @@ package body Sem_Ch12 is Set_In_Private_Part (P); end if; + -- This looks incomplete: what about compilation units that + -- were made visible by Install_Parent but should not remain + -- visible??? Standard is on the scope stack. + elsif not In_Open_Scopes (Scope (P)) then Set_Is_Immediately_Visible (P, False); end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index a800768af5b..88480d8332b 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -840,37 +840,6 @@ package body Sem_Ch3 is Set_Can_Never_Be_Null (T_Name, Null_Exclusion_Present (T_Def)); - -- ------------------------------------------------------------------- - -- I assume that the following statements should also be here. - -- Need some tests to check it. Detected by comparison with the - -- access_definition subprogram??? - -- ------------------------------------------------------------------- - - -- The anonymous access type is as public as the discriminated type or - -- subprogram that defines it. It is imported (for back-end purposes) - -- if the designated type is. - --- Set_Is_Public (T_Name, Is_Public (Scope (T_Name))); - - -- Ada 0Y (AI-50217): Propagate the attribute that indicates that the - -- designated type comes from the limited view (for back-end purposes). - --- Set_From_With_Type (T_Name, From_With_Type (Desig_Type)); - - -- The context is either a subprogram declaration or an access - -- discriminant, in a private or a full type declaration. In - -- the case of a subprogram, If the designated type is incomplete, - -- the operation will be a primitive operation of the full type, to - -- be updated subsequently. - --- if Ekind (Desig_Type) = E_Incomplete_Type --- and then Is_Overloadable (Current_Scope) --- then --- Append_Elmt (Current_Scope, Private_Dependents (Desig_Type)); --- Set_Has_Delayed_Freeze (Current_Scope); --- end if; - -- --------------------------------------------------------------- - Check_Restriction (No_Access_Subprograms, T_Def); end Access_Subprogram_Declaration; @@ -885,9 +854,6 @@ package body Sem_Ch3 is Desig : Entity_Id; -- Designated type - N_Desig : Entity_Id; - -- Non-limited view, when needed - begin -- Check for permissible use of incomplete type @@ -937,26 +903,28 @@ package body Sem_Ch3 is -- available, use it as the designated type of the access type, so that -- the back-end gets a usable entity. - if From_With_Type (Desig) then - Set_From_With_Type (T); + declare + N_Desig : Entity_Id; - if Ekind (Desig) = E_Incomplete_Type then - N_Desig := Non_Limited_View (Desig); + begin + if From_With_Type (Desig) then + Set_From_With_Type (T); - elsif Ekind (Desig) = E_Class_Wide_Type then - if From_With_Type (Etype (Desig)) then - N_Desig := Non_Limited_View (Etype (Desig)); - else - N_Desig := Etype (Desig); + if Ekind (Desig) = E_Incomplete_Type then + N_Desig := Non_Limited_View (Desig); + + else pragma Assert (Ekind (Desig) = E_Class_Wide_Type); + if From_With_Type (Etype (Desig)) then + N_Desig := Non_Limited_View (Etype (Desig)); + else + N_Desig := Etype (Desig); + end if; end if; - else - null; - pragma Assert (False); - end if; - pragma Assert (Present (N_Desig)); - Set_Directly_Designated_Type (T, N_Desig); - end if; + pragma Assert (Present (N_Desig)); + Set_Directly_Designated_Type (T, N_Desig); + end if; + end; -- Note that Has_Task is always false, since the access type itself -- is not a task type. See Einfo for more description on this point. @@ -991,7 +959,10 @@ package body Sem_Ch3 is -- Ada 0Y (AI-230): Access Definition case - elsif Present (Access_Definition (Component_Definition (N))) then + else + pragma Assert (Present + (Access_Definition (Component_Definition (N)))); + T := Access_Definition (Related_Nod => N, N => Access_Definition (Component_Definition (N))); @@ -1012,10 +983,6 @@ package body Sem_Ch3 is then T := Replace_Anonymous_Access_To_Protected_Subprogram (N, T); end if; - - else - pragma Assert (False); - null; end if; -- If the subtype is a constrained subtype of the enclosing record, @@ -1715,6 +1682,13 @@ package body Sem_Ch3 is if Present (E) and then E /= Error then Analyze (E); + -- In case of errors detected in the analysis of the expression, + -- decorate it with the expected type to avoid cascade errors + + if not Present (Etype (E)) then + Set_Etype (E, T); + end if; + -- If an initialization expression is present, then we set the -- Is_True_Constant flag. It will be reset if this is a variable -- and it is indeed modified. @@ -2997,7 +2971,7 @@ package body Sem_Ch3 is -- Ada 0Y (AI-230): Access Definition case - elsif Present (Access_Definition (Component_Def)) then + else pragma Assert (Present (Access_Definition (Component_Def))); Element_Type := Access_Definition (Related_Nod => Related_Id, N => Access_Definition (Component_Def)); @@ -3021,10 +2995,6 @@ package body Sem_Ch3 is (Def, Element_Type); end if; end; - - else - pragma Assert (False); - null; end if; -- Constrained array case @@ -3205,8 +3175,7 @@ package body Sem_Ch3 is Acc := Parameter_Type (N); when others => - null; - pragma Assert (False); + raise Program_Error; end case; Decl := Make_Full_Type_Declaration (Loc, diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 4f9383142e5..8722b77692d 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -2768,7 +2768,8 @@ package body Sem_Ch4 is <> Next_Entity (Comp); exit when not In_Scope - and then Comp = First_Private_Entity (Prefix_Type); + and then + Comp = First_Private_Entity (Base_Type (Prefix_Type)); end loop; Set_Is_Overloaded (N, Is_Overloaded (Sel)); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 89512b51c7e..8e2cd6a8ea7 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -48,6 +48,7 @@ with Sem_Ch3; use Sem_Ch3; with Sem_Ch4; use Sem_Ch4; with Sem_Ch5; use Sem_Ch5; with Sem_Ch8; use Sem_Ch8; +with Sem_Ch10; use Sem_Ch10; with Sem_Ch12; use Sem_Ch12; with Sem_Disp; use Sem_Disp; with Sem_Dist; use Sem_Dist; @@ -1149,6 +1150,15 @@ package body Sem_Ch6 is Build_Body_To_Inline (N, Spec_Id); end if; + -- Ada 0Y (AI-262): In library subprogram bodies, after the analysis + -- if its specification we have to install the private withed units. + + if Is_Compilation_Unit (Body_Id) + and then Scope (Body_Id) = Standard_Standard + then + Install_Private_With_Clauses (Body_Id); + end if; + -- Now we can go on to analyze the body HSS := Handled_Statement_Sequence (N); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 03529634ae5..518179d8587 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -428,6 +428,10 @@ package body Sem_Ch8 is -- Find a type derived from Character or Wide_Character in the prefix of N. -- Used to resolved qualified names whose selector is a character literal. + function Has_Private_With (E : Entity_Id) return Boolean; + -- Ada 0Y (AI-262): Determines if the current compilation unit has a + -- private with on E + procedure Find_Expanded_Name (N : Node_Id); -- Selected component is known to be expanded name. Verify legality -- of selector given the scope denoted by prefix. @@ -685,8 +689,7 @@ package body Sem_Ch8 is -- Ada 0Y (AI-230/AI-254): Access renaming - elsif Present (Access_Definition (N)) then - + else pragma Assert (Present (Access_Definition (N))); T := Access_Definition (Related_Nod => N, N => Access_Definition (N)); @@ -706,9 +709,6 @@ package body Sem_Ch8 is Error_Msg_N ("(Ada 0Y): null-excluding attribute ignored " & "('R'M 8.5.1(6))?", N); end if; - else - pragma Assert (False); - null; end if; -- An object renaming requires an exact match of the type; @@ -2406,6 +2406,11 @@ package body Sem_Ch8 is -- user point of view to warrant an error message of "not visible" -- rather than undefined. + Nvis_Is_Private_Subprg : Boolean := False; + -- Ada 0Y (AI-262): Set True to indicate that a form of Beaujolais + -- effect concerning library subprograms has been detected. Used to + -- generate the precise error message. + function From_Actual_Package (E : Entity_Id) return Boolean; -- Returns true if the entity is declared in a package that is -- an actual for a formal package of the current instance. Such an @@ -2566,10 +2571,46 @@ package body Sem_Ch8 is ------------------- procedure Nvis_Messages is - Ent : Entity_Id; - Hidden : Boolean := False; + Comp_Unit : Node_Id; + Ent : Entity_Id; + Hidden : Boolean := False; + Item : Node_Id; begin + -- Ada 0Y (AI-262): Generate a precise error concerning the + -- Beaujolais effect that was previously detected + + if Nvis_Is_Private_Subprg then + + pragma Assert (Nkind (E2) = N_Defining_Identifier + and then Ekind (E2) = E_Function + and then Scope (E2) = Standard_Standard + and then Has_Private_With (E2)); + + -- Find the sloc corresponding to the private with'ed unit + + Comp_Unit := Cunit (Current_Sem_Unit); + Item := First (Context_Items (Comp_Unit)); + Error_Msg_Sloc := No_Location; + + while Present (Item) loop + if Nkind (Item) = N_With_Clause + and then Private_Present (Item) + and then Entity (Name (Item)) = E2 + then + Error_Msg_Sloc := Sloc (Item); + exit; + end if; + + Next (Item); + end loop; + + pragma Assert (Error_Msg_Sloc /= No_Location); + + Error_Msg_N ("(Ada 0Y): hidden by private with clause #", N); + return; + end if; + Undefined (Nvis => True); if Msg then @@ -2949,6 +2990,29 @@ package body Sem_Ch8 is elsif Is_Potentially_Use_Visible (E2) then Only_One_Visible := False; All_Overloadable := All_Overloadable and Is_Overloadable (E2); + + -- Ada 0Y (AI-262): Protect against a form of Beujolais effect + -- that can occurr in private_with clauses. Example: + + -- with A; + -- private with B; package A is + -- package C is function B return Integer; + -- use A; end A; + -- V1 : Integer := B; + -- private function B return Integer; + -- V2 : Integer := B; + -- end C; + + -- V1 resolves to A.B, but V2 resolves to library unit B. + + elsif Ekind (E2) = E_Function + and then Scope (E2) = Standard_Standard + and then Has_Private_With (E2) + then + Only_One_Visible := False; + All_Overloadable := False; + Nvis_Is_Private_Subprg := True; + exit; end if; E2 := Homonym (E2); @@ -4433,6 +4497,30 @@ package body Sem_Ch8 is return Found; end Has_Implicit_Character_Literal; + ---------------------- + -- Has_Private_With -- + ---------------------- + + function Has_Private_With (E : Entity_Id) return Boolean is + Comp_Unit : constant Node_Id := Cunit (Current_Sem_Unit); + Item : Node_Id; + + begin + Item := First (Context_Items (Comp_Unit)); + while Present (Item) loop + if Nkind (Item) = N_With_Clause + and then Private_Present (Item) + and then Entity (Name (Item)) = E + then + return True; + end if; + + Next (Item); + end loop; + + return False; + end Has_Private_With; + --------------------------- -- Has_Implicit_Operator -- --------------------------- @@ -5356,6 +5444,7 @@ package body Sem_Ch8 is Prev : Entity_Id; Current_Instance : Entity_Id := Empty; Real_P : Entity_Id; + Private_With_OK : Boolean := False; begin if Ekind (P) /= E_Package then @@ -5396,12 +5485,25 @@ package body Sem_Ch8 is Real_P := P; end if; + -- Ada 0Y (AI-262): Check the use_clause of a private withed package + -- found in the private part of a package specification + + if In_Private_Part (Current_Scope) + and then Has_Private_With (P) + and then Is_Child_Unit (Current_Scope) + and then Is_Child_Unit (P) + and then Is_Ancestor_Package (Scope (Current_Scope), P) + then + Private_With_OK := True; + end if; + -- Loop through entities in one package making them potentially -- use-visible. Id := First_Entity (P); while Present (Id) - and then Id /= First_Private_Entity (P) + and then (Id /= First_Private_Entity (P) + or else Private_With_OK) -- Ada 0Y (AI-262) loop Prev := Current_Entity (Id); diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb index cb07a921c87..f5200ca5406 100644 --- a/gcc/ada/sem_elim.adb +++ b/gcc/ada/sem_elim.adb @@ -657,7 +657,7 @@ package body Sem_Elim is -- Should never fall through, since entry should be in table - pragma Assert (False); + raise Program_Error; end Eliminate_Error_Msg; ---------------- diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 263e701e11d..9eb9af0b388 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -3152,6 +3152,31 @@ package body Sem_Util is end if; end Is_Aliased_View; + ------------------------- + -- Is_Ancestor_Package -- + ------------------------- + + function Is_Ancestor_Package + (E1 : Entity_Id; + E2 : Entity_Id) return Boolean + is + Par : Entity_Id; + + begin + Par := E2; + while Present (Par) + and then Par /= Standard_Standard + loop + if Par = E1 then + return True; + end if; + + Par := Scope (Par); + end loop; + + return False; + end Is_Ancestor_Package; + ---------------------- -- Is_Atomic_Object -- ---------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index d85c35c1e88..a32ddc09239 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -424,6 +424,11 @@ package Sem_Util is -- Determine if Obj is an aliased view, i.e. the name of an -- object to which 'Access or 'Unchecked_Access can apply. + function Is_Ancestor_Package + (E1 : Entity_Id; + E2 : Entity_Id) return Boolean; + -- Determine whether package E1 is an ancestor of E2 + function Is_Atomic_Object (N : Node_Id) return Boolean; -- Determines if the given node denotes an atomic object in the sense -- of the legality checks described in RM C.6(12). diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 57b2fe0fdaf..5fe9e1c550e 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -1014,9 +1014,9 @@ package body Sprint is end if; Sprint_Node (Subtype_Indication (Node)); + else - pragma Assert (False); - null; + Write_Str (" ??? "); end if; when N_Component_Declaration => @@ -1782,8 +1782,7 @@ package body Sprint is Sprint_Node (Subtype_Mark (Node)); else - pragma Assert (False); - null; + Write_Str (" ??? "); end if; Write_Str_With_Col_Check (" renames "); @@ -2601,8 +2600,15 @@ package body Sprint is -- Ada 0Y (AI-50217): Print limited with_clauses - if Limited_Present (Node) then + if Private_Present (Node) and Limited_Present (Node) then + Write_Indent_Str ("limited private with "); + + elsif Private_Present (Node) then + Write_Indent_Str ("private with "); + + elsif Limited_Present (Node) then Write_Indent_Str ("limited with "); + else Write_Indent_Str ("with "); end if; diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index f84907d383b..6022dbfe758 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -2444,13 +2444,12 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) field_list = chainon (field_list, - make_descriptor_field ("POINTER", - build_pointer_type (type), - record_type, - build1 (ADDR_EXPR, - build_pointer_type (type), - build (PLACEHOLDER_EXPR, - type)))); + make_descriptor_field + ("POINTER", + build_pointer_type_for_mode (type, SImode, false), record_type, + build1 (ADDR_EXPR, + build_pointer_type_for_mode (type, SImode, false), + build (PLACEHOLDER_EXPR, type)))); switch (mech) { @@ -2520,8 +2519,13 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) field_list = chainon (field_list, make_descriptor_field - ("A0", build_pointer_type (inner_type), record_type, - build1 (ADDR_EXPR, build_pointer_type (inner_type), tem))); + ("A0", + build_pointer_type_for_mode (inner_type, SImode, false), + record_type, + build1 (ADDR_EXPR, + build_pointer_type_for_mode (inner_type, SImode, + false), + tem))); /* Next come the addressing coefficients. */ tem = size_int (1); -- 2.30.2