[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Fri, 14 May 2004 13:55:12 +0000 (15:55 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Fri, 14 May 2004 13:55:12 +0000 (15:55 +0200)
2004-05-14  Robert Dewar  <dewar@gnat.com>

* 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  <quinot@act-europe.fr>

* 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  <schonberg@gnat.com>

* 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  <miranda@gnat.com>

* 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  <kenner@vlsi1.ultra.nyu.edu>

* utils.c (build_vms_descriptor): Use SImode pointers.

2004-05-14  Vasiliy Fofanov  <fofanov@act-europe.fr>

* gnat_ugn.texi: Revised chapter "GNAT and Libraries".

2004-05-14  GNAT Script  <nobody@gnat.com>

* Make-lang.in: Makefile automatically updated

From-SVN: r81844

23 files changed:
gcc/ada/ChangeLog
gcc/ada/Make-lang.in
gcc/ada/checks.adb
gcc/ada/exp_aggr.adb
gcc/ada/exp_ch4.adb
gcc/ada/exp_ch7.adb
gcc/ada/gnat_ugn.texi
gcc/ada/lib-load.adb
gcc/ada/lib-writ.adb
gcc/ada/lib.adb
gcc/ada/lib.ads
gcc/ada/par-ch10.adb
gcc/ada/sem_ch10.adb
gcc/ada/sem_ch12.adb
gcc/ada/sem_ch3.adb
gcc/ada/sem_ch4.adb
gcc/ada/sem_ch6.adb
gcc/ada/sem_ch8.adb
gcc/ada/sem_elim.adb
gcc/ada/sem_util.adb
gcc/ada/sem_util.ads
gcc/ada/sprint.adb
gcc/ada/utils.c

index 7ba15df237370f95991b9932e13885b3502b0909..16d3d0a7225afa85a664183229f4f1bc630b3615 100644 (file)
@@ -1,3 +1,91 @@
+2004-05-14  Robert Dewar  <dewar@gnat.com>
+
+       * 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  <quinot@act-europe.fr>
+
+       * 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  <schonberg@gnat.com>
+
+       * 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  <miranda@gnat.com>
+
+       * 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  <kenner@vlsi1.ultra.nyu.edu>
+
+       * utils.c (build_vms_descriptor): Use SImode pointers.
+
+2004-05-14  Vasiliy Fofanov  <fofanov@act-europe.fr>
+
+       * gnat_ugn.texi: Revised chapter "GNAT and Libraries".
+
+2004-05-14  GNAT Script  <nobody@gnat.com>
+
+       * Make-lang.in: Makefile automatically updated
+
 2004-05-14  Arnaud Charlet  <charlet@act-europe.fr>
 
        Renaming of target specific files for clarity
index 0a6775a438f86724cd893fbee7a90ece8157c89f..1342a542da22ee9a80dc117e4c8357dd4d7b6b4b 100644 (file)
@@ -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 \
index 059730067e06257207a2e7187c211e32eef7f217..713ea26306caef740cefb642a8fd778365309f17 100644 (file)
@@ -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;
 
index 8dd7492a6318f5ab10453c797dd9e8236305e987..966b848931c21c5ffbc291c577ee89c12a140b18 100644 (file)
@@ -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;
 
index aec55719a8db7eaa6e217f503e1c01079612b870..4ae959a992d64658bdffe79f7078a5ae04c42dde 100644 (file)
@@ -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 (
index 287b4efc7922abbfe036d3f525c4835b11900739..426658564e2f8d8d818eeb070e60994a32e14684 100644 (file)
@@ -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);
index 5ae1a892124d010689cdfc6c6a81c851bd79fb1d..1a30c465a5531d49d6e860688c5bc8cf433f1358 100644 (file)
@@ -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<prefix>}
-switch. @code{gnatbind} will then generate the library elaboration
-procedure (named @code{<prefix>init}) and the run-time finalization
-procedure (named @code{<prefix>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 <other object files>
+   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 <other object files>
+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
index b294a84305f5a5452d3b50ca4080d5d530d6a1e6..03dcfe8cd732c0d07fb2df2187225c00cafeeee4 100644 (file)
@@ -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
index 1259bc890b7e52aa9f77edf3952e20847550bc41..7168e69c9a220115ec9f7d342f192eae0a6cc835 100644 (file)
@@ -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));
index e726c2d760ff043a31227a01009cc34a9202042c..d1e8781c9045246b38c7fcf4e2895862c52234e8 100644 (file)
@@ -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;
index d45ccfba74644f54b9a2cf58e59fb710036c67c9..e48f22457757fdcf3d7b1e246ed48900ff7aeb72 100644 (file)
@@ -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;
index d45e727e97ce95b7c8a1fe7c24e345b5d4d48902..d776635a778717567a831bcff49a0d48989427cb 100644 (file)
@@ -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;
index 9c0da7f97f74a06d789a3220d9a5e9dff30e7db6..4283ae0beb22ac7d12e0fa73a750e559b9535592 100644 (file)
@@ -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
index 69930b81a0488a7615387c562bed82d1b1e25079..7684845103a598aa5c20d9fae34ad5a1952f9a66 100644 (file)
@@ -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;
index a800768af5b0f0b0381af02616c50403a39bb672..88480d8332b5c82376ee76a29174110479bd4c17 100644 (file)
@@ -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,
index 4f9383142e5acba6b266af049ff325abb298a8e9..8722b77692df3c78ea1142c7062756dba62e0443 100644 (file)
@@ -2768,7 +2768,8 @@ package body Sem_Ch4 is
             <<Next_Comp>>
                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));
index 89512b51c7e49d5157dc05d42962b5034d91ab92..8e2cd6a8ea7d9492f20efdb2057c27612105acb9 100644 (file)
@@ -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);
index 03529634ae5e4f50ac142f472b9ce49872daf377..518179d85875901677bca4df161657eb3b0959b2 100644 (file)
@@ -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);
 
index cb07a921c87eb9f8ec77b2a0499d27695c25a693..f5200ca540607bdb344b6277df7040dab85cc758 100644 (file)
@@ -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;
 
    ----------------
index 263e701e11d3da0eb37d146336e8c8bd94276c52..9eb9af0b388a6492d4538e06e2950ce21498cea2 100644 (file)
@@ -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 --
    ----------------------
index d85c35c1e88f4cdcef633e906289c2491a39f5ee..a32ddc092397b2be17475ad1e8ea8c3838e53381 100644 (file)
@@ -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).
index 57b2fe0fdaf15bfbcb09212b4e22226cc3adfa73..5fe9e1c550e6fad53448c66f997a0abab674d319 100644 (file)
@@ -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;
index f84907d383b97222e6c8df81ddba9d6fd0f89ce7..6022dbfe75889d6e60136a2f0007de3bb44a64b6 100644 (file)
@@ -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);