[multiple changes]

2011-08-04  Emmanuel Briot  <briot@adacore.com>

	* prj-proc.adb, prj-nmsc.adb, prj-env.adb (Process_Declarative_Items):
	Add support for overriding the Project_Path in aggregate projects.

2011-08-04  Robert Dewar  <dewar@adacore.com>

	* a-cofove.ads: Minor reformatting.

2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Build_Adjust_Or_Finalize_Statements): Update the comment
	on the generated code.
	(Build_Finalize_Statements): Update the comment on the generated code.
	(Build_Initialize_Statements): Update the comment on the generated code.
	(Build_Object_Declarations): Add local variable Result. The object
	declarations are now built in sequence.
	* rtsfind.ads: Add RE_Exception_Occurrence_Access to tables RE_Id and
	RE_Unit_Table.

2011-08-04  Robert Dewar  <dewar@adacore.com>

	* checks.adb, alfa.adb, alfa.ads: Minor reformatting.

2011-08-04  Eric Botcazou  <ebotcazou@adacore.com>

	* einfo.ads (Elaboration_Entity): Document new definition and use.
	(Elaboration_Entity_Required): Adjust to above change.
	* exp_attr.adb (Expand_N_Attribute_Reference): Likewise.
	* exp_ch12.adb: And with and use for Snames.
	(Expand_N_Generic_Instantiation): Test 'Elaborated attribute.
	* exp_util.adb (Set_Elaboration_Flag): Likewise.
	* sem_attr.adb (Analyze_Attribute) <Check_Library_Unit>: Delete.
	<Check_Unit_Name>: Deal with N_Expanded_Name.
	<Attribute_Elaborated>: Extend to all unit names.
	* sem_elab.adb: And with and use for Uintp.
	(Check_Internal_Call_Continue): Adjust to Elaboration_Entity change.
	* sem_util.ads (Build_Elaboration_Entity): Adjust comment.
	* sem_util.adb (Build_Elaboration_Entity): Change type to Integer.
	* bindgen.adb (Gen_Elab_Externals_Ada): New local subprogram taken
	from Gen_Adainit_Ada.
	(Gen_Elab_Externals_C): Likewise, but taken from Gen_Adainit_C.
	(Gen_Adafinal_Ada): Remove redundant test.  In the non-main program
	case, do not call System.Standard_Library.Adafinal; instead call
	finalize_library if needed.
	(Gen_Adafinal_C): Likewise.
	(Gen_Adainit_Ada): Do not set SSL.Finalize_Library_Objects in the
	non-main program case.
	(Gen_Adainit_C): Generate a couple of external declarations here.
	In the main program case, set SSL.Finalize_Library_Objects.
	(Gen_Elab_Calls_Ada): Adjust to Elaboration_Entity change.
	(Gen_Elab_Calls_C): Likewise.
	(Gen_Finalize_Library_Ada): Likewise.  Skip SAL interface units.
	(Gen_Finalize_Library_C): Likewise.  Generate a full function.
	(Gen_Main_C): Put back call to Ada_Final and don't finalize library
	objects here.
	(Gen_Output_File_Ada): Generate pragma Linker_Destructor for Ada_Final
	if -a is specified.  Call Gen_Elab_Externals_Ada.  Move around call to
	Gen_Adafinal_Ada.
	(Gen_Output_File_C): Generate __attribute__((destructor)) for Ada_Final
	if -a is specified.  Call Gen_Elab_Externals_C.  Remove useless couple
	of external declarations.  Call Gen_Finalize_Library_C.

From-SVN: r177318

gcc/ada/ChangeLog

@@ -1,3 +1,66 @@
+2011-08-04  Emmanuel Briot  <briot@adacore.com>
+
+	* prj-proc.adb, prj-nmsc.adb, prj-env.adb (Process_Declarative_Items):
+	Add support for overriding the Project_Path in aggregate projects.
+
+2011-08-04  Robert Dewar  <dewar@adacore.com>
+
+	* a-cofove.ads: Minor reformatting.
+
+2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch7.adb (Build_Adjust_Or_Finalize_Statements): Update the comment
+	on the generated code.
+	(Build_Finalize_Statements): Update the comment on the generated code.
+	(Build_Initialize_Statements): Update the comment on the generated code.
+	(Build_Object_Declarations): Add local variable Result. The object
+	declarations are now built in sequence.
+	* rtsfind.ads: Add RE_Exception_Occurrence_Access to tables RE_Id and
+	RE_Unit_Table.
+
+2011-08-04  Robert Dewar  <dewar@adacore.com>
+
+	* checks.adb, alfa.adb, alfa.ads: Minor reformatting.
+
+2011-08-04  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* einfo.ads (Elaboration_Entity): Document new definition and use.
+	(Elaboration_Entity_Required): Adjust to above change.
+	* exp_attr.adb (Expand_N_Attribute_Reference): Likewise.
+	* exp_ch12.adb: And with and use for Snames.
+	(Expand_N_Generic_Instantiation): Test 'Elaborated attribute.
+	* exp_util.adb (Set_Elaboration_Flag): Likewise.
+	* sem_attr.adb (Analyze_Attribute) <Check_Library_Unit>: Delete.
+	<Check_Unit_Name>: Deal with N_Expanded_Name.
+	<Attribute_Elaborated>: Extend to all unit names.
+	* sem_elab.adb: And with and use for Uintp.
+	(Check_Internal_Call_Continue): Adjust to Elaboration_Entity change.
+	* sem_util.ads (Build_Elaboration_Entity): Adjust comment.
+	* sem_util.adb (Build_Elaboration_Entity): Change type to Integer.
+	* bindgen.adb (Gen_Elab_Externals_Ada): New local subprogram taken
+	from Gen_Adainit_Ada.
+	(Gen_Elab_Externals_C): Likewise, but taken from Gen_Adainit_C.
+	(Gen_Adafinal_Ada): Remove redundant test.  In the non-main program
+	case, do not call System.Standard_Library.Adafinal; instead call
+	finalize_library if needed.
+	(Gen_Adafinal_C): Likewise.
+	(Gen_Adainit_Ada): Do not set SSL.Finalize_Library_Objects in the
+	non-main program case.
+	(Gen_Adainit_C): Generate a couple of external declarations here.
+	In the main program case, set SSL.Finalize_Library_Objects.
+	(Gen_Elab_Calls_Ada): Adjust to Elaboration_Entity change.
+	(Gen_Elab_Calls_C): Likewise.
+	(Gen_Finalize_Library_Ada): Likewise.  Skip SAL interface units.
+	(Gen_Finalize_Library_C): Likewise.  Generate a full function.
+	(Gen_Main_C): Put back call to Ada_Final and don't finalize library
+	objects here.
+	(Gen_Output_File_Ada): Generate pragma Linker_Destructor for Ada_Final
+	if -a is specified.  Call Gen_Elab_Externals_Ada.  Move around call to
+	Gen_Adafinal_Ada.
+	(Gen_Output_File_C): Generate __attribute__((destructor)) for Ada_Final
+	if -a is specified.  Call Gen_Elab_Externals_C.  Remove useless couple
+	of external declarations.  Call Gen_Finalize_Library_C.
+
 2011-08-04  Emmanuel Briot  <briot@adacore.com>
 
 	* prj.adb, prj.ads, makeutl.adb, makeutl.ads (Complete_Mains,

gcc/ada/a-cofove.ads

@@ -143,8 +143,9 @@ package Ada.Containers.Formal_Vectors is
      (Container : Vector;
       Index     : Index_Type) return Element_Type;
 
-   function Element (Container : Vector; Position : Cursor)
+   function Element
-                     return Element_Type;
+     (Container : Vector;
+      Position  : Cursor) return Element_Type;
 
    procedure Replace_Element
      (Container : in out Vector;
@@ -388,7 +389,7 @@ private
    for Vector'Read use Read;
 
    type Cursor is record
-      Valid : Boolean := True;
+      Valid : Boolean    := True;
       Index : Index_Type := Index_Type'First;
    end record;
 

gcc/ada/alfa.adb

@@ -144,17 +144,6 @@ package body ALFA is
       end loop;
    end dalfa;
 
-   ----------------
-   -- Initialize --
-   ----------------
-
-   procedure Initialize_ALFA_Tables is
-   begin
-      ALFA_File_Table.Init;
-      ALFA_Scope_Table.Init;
-      ALFA_Xref_Table.Init;
-   end Initialize_ALFA_Tables;
-
    -------------------------
    -- Get_Entity_For_Decl --
    -------------------------
@@ -223,6 +212,17 @@ package body ALFA is
       return E;
    end Get_Unique_Entity_For_Decl;
 
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize_ALFA_Tables is
+   begin
+      ALFA_File_Table.Init;
+      ALFA_Scope_Table.Init;
+      ALFA_Xref_Table.Init;
+   end Initialize_ALFA_Tables;
+
    -----------
    -- palfa --
    -----------

gcc/ada/alfa.ads

@@ -316,10 +316,6 @@ package ALFA is
    -- Subprograms --
    -----------------
 
-   procedure dalfa;
-   --  Debug routine to dump internal ALFA tables. This is a raw format dump
-   --  showing exactly what the tables contain.
-
    procedure Initialize_ALFA_Tables;
    --  Reset tables for a new compilation
 
@@ -330,6 +326,10 @@ package ALFA is
    --  Return the entity which represents declaration N, so that matching
    --  declaration and body have the same entity.
 
+   procedure dalfa;
+   --  Debug routine to dump internal ALFA tables. This is a raw format dump
+   --  showing exactly what the tables contain.
+
    procedure palfa;
    --  Debugging procedure to output contents of ALFA binary tables in the
    --  format in which they appear in an ALI file.

gcc/ada/bindgen.adb

@@ -72,6 +72,7 @@ package body Bindgen is
    --  unit unconditionally, which is unpleasand, especially for ZFP etc.)
 
    Lib_Final_Built : Boolean := False;
+   --  Flag indicating whether the finalize_library rountine has been built
 
    ----------------------------------
    -- Interface_State Pragma Table --
@@ -244,6 +245,12 @@ package body Bindgen is
    procedure Gen_Adafinal_C;
    --  Generate the Adafinal procedure (C code case)
 
+   procedure Gen_Elab_Externals_Ada;
+   --  Generate sequence of external declarations for elaboration (Ada)
+
+   procedure Gen_Elab_Externals_C;
+   --  Generate sequence of external declarations for elaboration (C)
+
    procedure Gen_Elab_Calls_Ada;
    --  Generate sequence of elaboration calls (Ada code case)
 
@@ -421,13 +428,15 @@ package body Bindgen is
    begin
       WBI ("   procedure " & Ada_Final_Name.all & " is");
 
-      --  Do nothing if finalization is disabled
+      if not Bind_Main_Program then
-
-      if Cumulative_Restrictions.Set (No_Finalization) then
          WBI ("   begin");
-         WBI ("      null;");
+         if Lib_Final_Built then
+            WBI ("      finalize_library;");
+         else
+            WBI ("      null;");
+         end if;
 
-      --  General case
+      --  Main program case
 
       elsif VM_Target = No_VM then
          WBI ("      procedure s_stalib_adafinal;");
@@ -455,7 +464,17 @@ package body Bindgen is
    procedure Gen_Adafinal_C is
    begin
       WBI ("void " & Ada_Final_Name.all & " (void) {");
-      WBI ("   system__standard_library__adafinal ();");
+
+      if not Bind_Main_Program then
+         if Lib_Final_Built then
+            WBI ("   finalize_library ();");
+         end if;
+
+      --  Main program case
+
+      else
+         WBI ("   system__standard_library__adafinal ();");
+      end if;
       WBI ("}");
       WBI ("");
    end Gen_Adafinal_C;
@@ -471,86 +490,6 @@ package body Bindgen is
    begin
       WBI ("   procedure " & Ada_Init_Name.all & " is");
 
-      --  Generate externals for elaboration entities
-
-      for E in Elab_Order.First .. Elab_Order.Last loop
-         declare
-            Unum : constant Unit_Id := Elab_Order.Table (E);
-            U    : Unit_Record renames Units.Table (Unum);
-
-         begin
-            --  Check for Elab_Entity to be set for this unit
-
-            if U.Set_Elab_Entity
-
-            --  Don't generate reference for stand alone library
-
-              and then not U.SAL_Interface
-
-            --  Don't generate reference for predefined file in No_Run_Time
-            --  mode, since we don't include the object files in this case
-
-              and then not
-                (No_Run_Time_Mode
-                   and then Is_Predefined_File_Name (U.Sfile))
-            then
-               Set_String ("      ");
-               Set_String ("E");
-               Set_Unit_Number (Unum);
-
-               case VM_Target is
-                  when No_VM | JVM_Target =>
-                     Set_String (" : Boolean; pragma Import (Ada, ");
-                  when CLI_Target =>
-                     Set_String (" : Boolean; pragma Import (CIL, ");
-               end case;
-
-               Set_String ("E");
-               Set_Unit_Number (Unum);
-               Set_String (", """);
-               Get_Name_String (U.Uname);
-
-               --  In the case of JGNAT we need to emit an Import name that
-               --  includes the class name (using '$' separators in the case
-               --  of a child unit name).
-
-               if VM_Target /= No_VM then
-                  for J in 1 .. Name_Len - 2 loop
-                     if VM_Target = CLI_Target
-                       or else Name_Buffer (J) /= '.'
-                     then
-                        Set_Char (Name_Buffer (J));
-                     else
-                        Set_String ("$");
-                     end if;
-                  end loop;
-
-                  if VM_Target /= CLI_Target or else U.Unit_Kind = 's' then
-                     Set_String (".");
-                  else
-                     Set_String ("_pkg.");
-                  end if;
-
-                  --  If the unit name is very long, then split the
-                  --  Import link name across lines using "&" (occurs
-                  --  in some C2 tests).
-
-                  if 2 * Name_Len + 60 > Hostparm.Max_Line_Length then
-                     Set_String (""" &");
-                     Write_Statement_Buffer;
-                     Set_String ("         """);
-                  end if;
-               end if;
-
-               Set_Unit_Name;
-               Set_String ("_E"");");
-               Write_Statement_Buffer;
-            end if;
-         end;
-      end loop;
-
-      Write_Statement_Buffer;
-
       --  If the standard library is suppressed, then the only global variables
       --  that might be needed (by the Ravenscar profile) are the priority and
       --  the processor for the environment task.
@@ -927,38 +866,39 @@ package body Bindgen is
          WBI ("      Initialize_Stack_Limit;");
       end if;
 
-      --  Attach Finalize_Library to the right soft link. Do it only when not
+      --  In the main program case, attach finalize_library to the soft link.
-      --  using a restricted run time, in which case tasks are
+      --  Do it only when not using a restricted run time, in which case tasks
-      --  non-terminating, so we do not want library-level finalization.
+      --  are non-terminating, so we do not want library-level finalization.
 
-      if not Configurable_Run_Time_On_Target then
+      if Bind_Main_Program
-         if not Suppress_Standard_Library_On_Target then
+        and then not Configurable_Run_Time_On_Target
-            WBI ("");
+        and then not Suppress_Standard_Library_On_Target
-
+      then
-            if VM_Target = No_VM then
+         WBI ("");
-               if Lib_Final_Built then
-                  Set_String ("      Finalize_Library_Objects := ");
-                  Set_String ("Finalize_Library'access;");
-               else
-                  Set_String ("      Finalize_Library_Objects := null;");
-               end if;
-
-            --  On VM targets use regular Ada to set the soft link
 
+         if VM_Target = No_VM then
+            if Lib_Final_Built then
+               Set_String ("      Finalize_Library_Objects := ");
+               Set_String ("finalize_library'access;");
             else
-               if Lib_Final_Built then
+               Set_String ("      Finalize_Library_Objects := null;");
-                  Set_String
-                    ("      System.Soft_Links.Finalize_Library_Objects");
-                  Set_String (" := Finalize_Library'access;");
-               else
-                  Set_String
-                    ("      System.Soft_Links.Finalize_Library_Objects");
-                  Set_String (" := null;");
-               end if;
             end if;
 
-            Write_Statement_Buffer;
+         --  On VM targets use regular Ada to set the soft link
+
+         else
+            if Lib_Final_Built then
+               Set_String
+                 ("      System.Soft_Links.Finalize_Library_Objects");
+               Set_String (" := finalize_library'access;");
+            else
+               Set_String
+                 ("      System.Soft_Links.Finalize_Library_Objects");
+               Set_String (" := null;");
+            end if;
          end if;
+
+         Write_Statement_Buffer;
       end if;
 
       --  Generate elaboration calls
@@ -1001,40 +941,6 @@ package body Bindgen is
       WBI ("void " & Ada_Init_Name.all & " (void)");
       WBI ("{");
 
-      --  Generate externals for elaboration entities
-
-      for E in Elab_Order.First .. Elab_Order.Last loop
-         declare
-            Unum : constant Unit_Id := Elab_Order.Table (E);
-            U    : Unit_Record renames Units.Table (Unum);
-
-         begin
-            --  Check for Elab entity to be set for this unit
-
-            if U.Set_Elab_Entity
-
-            --  Don't generate reference for stand alone library
-
-              and then not U.SAL_Interface
-
-            --  Don't generate reference for predefined file in No_Run_Time
-            --  mode, since we don't include the object files in this case
-
-              and then not
-                (No_Run_Time_Mode
-                   and then Is_Predefined_File_Name (U.Sfile))
-            then
-               Set_String ("   extern char ");
-               Get_Name_String (U.Uname);
-               Set_Unit_Name;
-               Set_String ("_E;");
-               Write_Statement_Buffer;
-            end if;
-         end;
-      end loop;
-
-      Write_Statement_Buffer;
-
       --  Standard library suppressed
 
       if Suppress_Standard_Library_On_Target then
@@ -1217,22 +1123,26 @@ package body Bindgen is
          Set_String (";");
          Write_Statement_Buffer;
 
+         --  Import entry point for elaboration time signal handler
+         --  installation, and indication of if it's been called previously.
+
+         WBI ("   extern int __gnat_handler_installed;");
          WBI ("");
 
          --  Install elaboration time signal handler
 
          WBI ("   if (__gnat_handler_installed == 0)");
-         WBI ("     {");
+         WBI ("      __gnat_install_handler ();");
-         WBI ("        __gnat_install_handler ();");
-         WBI ("     }");
 
-         --  Call feature enable/disable routine
+         --  Import entry point for environment feature enable/disable
+         --  routine, and indication that it's been called previously.
 
          if OpenVMS_On_Target then
+            WBI ("   extern int __gnat_features_set;");
+            WBI ("");
+
             WBI ("   if (__gnat_features_set == 0)");
-            WBI ("     {");
+            WBI ("      __gnat_set_features ();");
-            WBI ("        __gnat_set_features ();");
-            WBI ("     }");
          end if;
       end if;
 
@@ -1269,6 +1179,27 @@ package body Bindgen is
          Write_Statement_Buffer;
       end if;
 
+      --  In the main program case, attach finalize_library to the soft link.
+      --  Do it only when not using a restricted run time, in which case tasks
+      --  are non-terminating, so we do not want library-level finalization.
+
+      if Bind_Main_Program
+        and then not Configurable_Run_Time_On_Target
+        and then not Suppress_Standard_Library_On_Target
+      then
+         WBI ("");
+         WBI ("   extern void (*__gnat_finalize_library_objects)(void);");
+
+         if Lib_Final_Built then
+            Set_String ("   __gnat_finalize_library_objects = ");
+            Set_String ("&finalize_library;");
+         else
+            Set_String ("   __gnat_finalize_library_objects = 0;");
+         end if;
+
+         Write_Statement_Buffer;
+      end if;
+
       --  Generate elaboration calls
 
       WBI ("");
@@ -1277,6 +1208,130 @@ package body Bindgen is
       WBI ("");
    end Gen_Adainit_C;
 
+   ----------------------------
+   -- Gen_Elab_Externals_Ada --
+   ----------------------------
+
+   procedure Gen_Elab_Externals_Ada is
+   begin
+      for E in Elab_Order.First .. Elab_Order.Last loop
+         declare
+            Unum : constant Unit_Id := Elab_Order.Table (E);
+            U    : Unit_Record renames Units.Table (Unum);
+
+         begin
+            --  Check for Elab_Entity to be set for this unit
+
+            if U.Set_Elab_Entity
+
+            --  Don't generate reference for stand alone library
+
+              and then not U.SAL_Interface
+
+            --  Don't generate reference for predefined file in No_Run_Time
+            --  mode, since we don't include the object files in this case
+
+              and then not
+                (No_Run_Time_Mode
+                   and then Is_Predefined_File_Name (U.Sfile))
+            then
+               Set_String ("   ");
+               Set_String ("E");
+               Set_Unit_Number (Unum);
+
+               case VM_Target is
+                  when No_VM | JVM_Target =>
+                     Set_String (" : Integer; pragma Import (Ada, ");
+                  when CLI_Target =>
+                     Set_String (" : Integer; pragma Import (CIL, ");
+               end case;
+
+               Set_String ("E");
+               Set_Unit_Number (Unum);
+               Set_String (", """);
+               Get_Name_String (U.Uname);
+
+               --  In the case of JGNAT we need to emit an Import name that
+               --  includes the class name (using '$' separators in the case
+               --  of a child unit name).
+
+               if VM_Target /= No_VM then
+                  for J in 1 .. Name_Len - 2 loop
+                     if VM_Target = CLI_Target
+                       or else Name_Buffer (J) /= '.'
+                     then
+                        Set_Char (Name_Buffer (J));
+                     else
+                        Set_String ("$");
+                     end if;
+                  end loop;
+
+                  if VM_Target /= CLI_Target or else U.Unit_Kind = 's' then
+                     Set_String (".");
+                  else
+                     Set_String ("_pkg.");
+                  end if;
+
+                  --  If the unit name is very long, then split the
+                  --  Import link name across lines using "&" (occurs
+                  --  in some C2 tests).
+
+                  if 2 * Name_Len + 60 > Hostparm.Max_Line_Length then
+                     Set_String (""" &");
+                     Write_Statement_Buffer;
+                     Set_String ("         """);
+                  end if;
+               end if;
+
+               Set_Unit_Name;
+               Set_String ("_E"");");
+               Write_Statement_Buffer;
+            end if;
+         end;
+      end loop;
+
+      WBI ("");
+   end Gen_Elab_Externals_Ada;
+
+   --------------------------
+   -- Gen_Elab_Externals_C --
+   --------------------------
+
+   procedure Gen_Elab_Externals_C is
+   begin
+      for E in Elab_Order.First .. Elab_Order.Last loop
+         declare
+            Unum : constant Unit_Id := Elab_Order.Table (E);
+            U    : Unit_Record renames Units.Table (Unum);
+
+         begin
+            --  Check for Elab entity to be set for this unit
+
+            if U.Set_Elab_Entity
+
+            --  Don't generate reference for stand alone library
+
+              and then not U.SAL_Interface
+
+            --  Don't generate reference for predefined file in No_Run_Time
+            --  mode, since we don't include the object files in this case
+
+              and then not
+                (No_Run_Time_Mode
+                   and then Is_Predefined_File_Name (U.Sfile))
+            then
+               Set_String ("extern int ");
+               Get_Name_String (U.Uname);
+               Set_Unit_Name;
+               Set_String ("_E;");
+               Write_Statement_Buffer;
+            end if;
+         end;
+      end loop;
+
+      WBI ("");
+   end Gen_Elab_Externals_C;
+
    ------------------------
    -- Gen_Elab_Calls_Ada --
    ------------------------
@@ -1306,51 +1361,55 @@ package body Bindgen is
             if No_Run_Time_Mode and then Is_Predefined_File_Name (U.Sfile) then
                null;
 
+            --  Likewise if this is an interface to a stand alone library
+
+            elsif U.SAL_Interface then
+               null;
+
             --  Case of no elaboration code
 
             elsif U.No_Elab then
 
-               --  The only case in which we have to do something is if
+               --  The only case in which we have to do something is if this
-               --  this is a body, with a separate spec, where the separate
+               --  is a body, with a separate spec, where the separate spec
-               --  spec has an elaboration entity defined.
+               --  has an elaboration entity defined. In that case, this is
+               --  where we increment the elaboration entity.
 
-               --  In that case, this is where we set the elaboration entity
+               if U.Utype = Is_Body
-               --  to True, we do not need to test if this has already been
-               --  done, since it is quicker to set the flag than to test it.
-
-               if not U.SAL_Interface and then U.Utype = Is_Body
                  and then Units.Table (Unum_Spec).Set_Elab_Entity
                then
                   Set_String ("      E");
                   Set_Unit_Number (Unum_Spec);
-                  Set_String (" := True;");
+                  Set_String (" := E");
+                  Set_Unit_Number (Unum_Spec);
+                  Set_String (" + 1;");
                   Write_Statement_Buffer;
                end if;
 
             --  Here if elaboration code is present. If binding a library
             --  or if there is a non-Ada main subprogram then we generate:
 
-            --    if not uname_E then
+            --    if uname_E = 0 then
             --       uname'elab_[spec|body];
-            --       uname_E := True;
             --    end if;
+            --    uname_E := uname_E + 1;
 
             --  Otherwise, elaboration routines are called unconditionally:
 
             --    uname'elab_[spec|body];
-            --    uname_E := True;
+            --    uname_E := uname_E + 1;
 
-            --  The uname_E assignment is skipped if this is a separate spec,
+            --  The uname_E increment is skipped if this is a separate spec,
-            --  since the assignment will be done when we process the body.
+            --  since it will be done when we process the body.
 
-            elsif not U.SAL_Interface then
+            else
                if Force_Checking_Of_Elaboration_Flags or
                   Interface_Library_Unit or
                   (not Bind_Main_Program)
                then
-                  Set_String ("      if not E");
+                  Set_String ("      if E");
                   Set_Unit_Number (Unum_Spec);
-                  Set_String (" then");
+                  Set_String (" = 0 then");
                   Write_Statement_Buffer;
                   Set_String ("   ");
                end if;
@@ -1386,26 +1445,21 @@ package body Bindgen is
                Set_Char (';');
                Write_Statement_Buffer;
 
-               if U.Utype /= Is_Spec then
-                  if Force_Checking_Of_Elaboration_Flags or
-                     Interface_Library_Unit or
-                     (not Bind_Main_Program)
-                  then
-                     Set_String ("   ");
-                  end if;
-
-                  Set_String ("      E");
-                  Set_Unit_Number (Unum_Spec);
-                  Set_String (" := True;");
-                  Write_Statement_Buffer;
-               end if;
-
                if Force_Checking_Of_Elaboration_Flags or
                   Interface_Library_Unit or
                   (not Bind_Main_Program)
                then
                   WBI ("      end if;");
                end if;
+
+               if U.Utype /= Is_Spec then
+                  Set_String ("      E");
+                  Set_Unit_Number (Unum_Spec);
+                  Set_String (" := E");
+                  Set_Unit_Number (Unum_Spec);
+                  Set_String (" + 1;");
+                  Write_Statement_Buffer;
+               end if;
             end if;
          end;
       end loop;
@@ -1440,40 +1494,47 @@ package body Bindgen is
             if No_Run_Time_Mode and then Is_Predefined_File_Name (U.Sfile) then
                null;
 
+            --  Likewise if this is an interface to a stand alone library
+
+            elsif U.SAL_Interface then
+               null;
+
             --  Case of no elaboration code
 
             elsif U.No_Elab then
 
-               --  The only case in which we have to do something is if
+               --  The only case in which we have to do something is if this
-               --  this is a body, with a separate spec, where the separate
+               --  is a body, with a separate spec, where the separate spec
-               --  spec has an elaboration entity defined.
+               --  has an elaboration entity defined. In that case, this is
+               --  where we increment the elaboration entity.
 
-               --  In that case, this is where we set the elaboration entity
+               if U.Utype = Is_Body
-               --  to True, we do not need to test if this has already been
-               --  done, since it is quicker to set the flag than to test it.
-
-               if not U.SAL_Interface and then U.Utype = Is_Body
                  and then Units.Table (Unum_Spec).Set_Elab_Entity
                then
-                  Set_String ("   ");
                   Get_Name_String (U.Uname);
+
+                  Set_String ("   ");
                   Set_Unit_Name;
-                  Set_String ("_E = 1;");
+                  Set_String ("_E++;");
                   Write_Statement_Buffer;
                end if;
 
             --  Here if elaboration code is present. If binding a library
             --  or if there is a non-Ada main subprogram then we generate:
 
-            --    if (uname_E == 0) {
+            --    if (uname_E == 0)
             --       uname__elab[s|b] ();
-            --       uname_E++;
+            --    uname_E++;
-            --    }
 
-            --  The uname_E assignment is skipped if this is a separate spec,
+            --  Otherwise, elaboration routines are called unconditionally:
-            --  since the assignment will be done when we process the body.
 
-            elsif not U.SAL_Interface then
+            --    uname__elab[s|b] ();
+            --    uname_E++;
+
+            --  The uname_E increment is skipped if this is a separate spec,
+            --  since it will be done when we process the body.
+
+            else
                Get_Name_String (U.Uname);
 
                if Force_Checking_Of_Elaboration_Flags or
@@ -1482,7 +1543,7 @@ package body Bindgen is
                then
                   Set_String ("   if (");
                   Set_Unit_Name;
-                  Set_String ("_E == 0) {");
+                  Set_String ("_E == 0)");
                   Write_Statement_Buffer;
                   Set_String ("   ");
                end if;
@@ -1495,25 +1556,11 @@ package body Bindgen is
                Write_Statement_Buffer;
 
                if U.Utype /= Is_Spec then
-                  if Force_Checking_Of_Elaboration_Flags or
-                     Interface_Library_Unit or
-                     (not Bind_Main_Program)
-                  then
-                     Set_String ("   ");
-                  end if;
-
                   Set_String ("   ");
                   Set_Unit_Name;
                   Set_String ("_E++;");
                   Write_Statement_Buffer;
                end if;
-
-               if Force_Checking_Of_Elaboration_Flags or
-                  Interface_Library_Unit or
-                  (not Bind_Main_Program)
-               then
-                  WBI ("   }");
-               end if;
             end if;
          end;
       end loop;
@@ -1542,6 +1589,8 @@ package body Bindgen is
             Write_Statement_Buffer;
          end if;
       end loop;
+
+      WBI ("/* END ELABORATION DEFINITIONS */");
       WBI ("");
    end Gen_Elab_Defs_C;
 
@@ -1602,12 +1651,13 @@ package body Bindgen is
          if U.Unit_Kind = 'p'
            and then U.Has_Finalizer
            and then not U.Is_Generic
+           and then not U.SAL_Interface
            and then not U.No_Elab
          then
             if not Lib_Final_Built then
                Lib_Final_Built := True;
 
-               WBI ("   procedure Finalize_Library is");
+               WBI ("   procedure finalize_library is");
 
                --  The following flag is used to check for library-level
                --  exceptions raised during finalization. The symbol comes
@@ -1708,16 +1758,48 @@ package body Bindgen is
             Set_String (""");");
             Write_Statement_Buffer;
 
-            WBI ("      begin");
+            --  If binding a library or if there is a non-Ada main subprogram
+            --  then we generate:
 
-            --  Generate:
+            --    begin
+            --       uname_E := uname_E - 1;
+            --       if uname_E = 0 then
+            --          F<Count>;
+            --       end if;
+            --    end;
+
+            --  Otherwise, finalization routines are called unconditionally:
+
+            --    begin
+            --       uname_E := uname_E - 1;
             --       F<Count>;
             --    end;
 
+            WBI ("      begin");
+            Set_String ("         E");
+            Set_Unit_Number (Unum);
+            Set_String (" := E");
+            Set_Unit_Number (Unum);
+            Set_String (" - 1;");
+            Write_Statement_Buffer;
+
+            if Interface_Library_Unit or (not Bind_Main_Program) then
+               Set_String ("         if E");
+               Set_Unit_Number (Unum);
+               Set_String (" = 0 then");
+               Write_Statement_Buffer;
+               Set_String ("   ");
+            end if;
+
             Set_String ("         F");
             Set_Int    (Count);
             Set_Char   (';');
             Write_Statement_Buffer;
+
+            if Interface_Library_Unit or (not Bind_Main_Program) then
+               WBI ("         end if;");
+            end if;
+
             WBI ("      end;");
 
             Count := Count + 1;
@@ -1762,7 +1844,7 @@ package body Bindgen is
          end if;
 
          WBI ("      end if;");
-         WBI ("   end Finalize_Library;");
+         WBI ("   end finalize_library;");
          WBI ("");
       end if;
    end Gen_Finalize_Library_Ada;
@@ -1777,8 +1859,6 @@ package body Bindgen is
       Unum  : Unit_Id;
 
    begin
-      WBI ("   /* BEGIN FINALIZE */");
-
       for E in reverse Elab_Order.First .. Elab_Order.Last loop
          Unum := Elab_Order.Table (E);
          U    := Units.Table (Unum);
@@ -1788,9 +1868,14 @@ package body Bindgen is
          if U.Unit_Kind = 'p'
            and then U.Has_Finalizer
            and then not U.Is_Generic
+           and then not U.SAL_Interface
            and then not U.No_Elab
          then
-            Set_String ("   ");
+            if not Lib_Final_Built then
+               Lib_Final_Built := True;
+
+               WBI ("static void finalize_library(void) {");
+            end if;
 
             --  Dealing with package bodies is a little complicated. In such
             --  cases we must retrieve the package spec since it contains the
@@ -1803,6 +1888,34 @@ package body Bindgen is
                Uspec := U;
             end if;
 
+            Get_Name_String (Uspec.Uname);
+
+            --  If binding a library or if there is a non-Ada main subprogram
+            --  then we generate:
+
+            --    uname_E--;
+            --    if (uname_E == 0)
+            --       uname__finalize[S|B] ();
+
+            --  Otherwise, finalization routines are called unconditionally:
+
+            --    uname_E--;
+            --    uname__finalize[S|B] ();
+
+            Set_String ("   ");
+            Set_Unit_Name;
+            Set_String ("_E--;");
+            Write_Statement_Buffer;
+
+            if Interface_Library_Unit or (not Bind_Main_Program) then
+               Set_String ("   if (");
+               Set_Unit_Name;
+               Set_String ("_E == 0)");
+               Write_Statement_Buffer;
+               Set_String ("   ");
+            end if;
+
+            Set_String ("   ");
             Get_Name_String (Uspec.Uname);
             Set_Unit_Name;
             Set_String ("__finalize");
@@ -1826,8 +1939,10 @@ package body Bindgen is
          end if;
       end loop;
 
-      WBI ("   /* END FINALIZE */");
+      if Lib_Final_Built then
-      WBI ("");
+         WBI ("}");
+         WBI ("");
+      end if;
    end Gen_Finalize_Library_C;
 
    ---------------------------------
@@ -2124,15 +2239,10 @@ package body Bindgen is
    ----------------
 
    procedure Gen_Main_C is
-      Needs_Library_Finalization : constant Boolean :=
-                                     not Configurable_Run_Time_On_Target
-                                       and then Has_Finalizer;
-      --  For restricted run-time libraries (ZFP and Ravenscar) tasks are
-      --  non-terminating, so we do not want library-level finalization.
-
    begin
       if Exit_Status_Supported_On_Target then
          WBI ("#include <stdlib.h>");
+         WBI ("");
          Set_String ("int ");
       else
          Set_String ("void ");
@@ -2190,7 +2300,7 @@ package body Bindgen is
          WBI ("   gnat_argc = argc;");
          WBI ("   gnat_argv = argv;");
          WBI ("   gnat_envp = envp;");
-         WBI (" ");
+         WBI ("");
 
       --  If configurable run-time, then nothing to do, since in this case
       --  the gnat_argc/argv/envp variables are entirely suppressed.
@@ -2239,7 +2349,6 @@ package body Bindgen is
 
       if not No_Main_Subprogram then
          WBI ("   __gnat_break_start ();");
-         WBI (" ");
 
          --  Output main program name
 
@@ -2266,10 +2375,8 @@ package body Bindgen is
 
       --  Call adafinal if finalization active
 
-      if not Cumulative_Restrictions.Set (No_Finalization)
+      if not Cumulative_Restrictions.Set (No_Finalization) then
-        and then Needs_Library_Finalization
+         WBI ("   " & Ada_Final_Name.all & " ();");
-      then
-         Gen_Finalize_Library_C;
       end if;
 
       --  Outputs the dynamic stack measurement if needed
@@ -2798,29 +2905,29 @@ package body Bindgen is
             """__gnat_ada_main_program_name"");");
       end if;
 
-      if not Cumulative_Restrictions.Set (No_Finalization) then
-         WBI ("");
-         WBI ("   procedure " & Ada_Final_Name.all & ";");
-         WBI ("   pragma Export (C, " & Ada_Final_Name.all & ", """ &
-              Ada_Final_Name.all & """);");
-      end if;
-
       WBI ("");
       WBI ("   procedure " & Ada_Init_Name.all & ";");
       WBI ("   pragma Export (C, " & Ada_Init_Name.all & ", """ &
            Ada_Init_Name.all & """);");
 
       --  If -a has been specified use pragma Linker_Constructor for the init
-      --  procedure. No need to use a similar pragma for the final procedure as
+      --  procedure and pragma Linker_Destructor for the final procedure.
-      --  global finalization will occur when the executable finishes execution
-      --  and for plugins (shared stand-alone libraries that can be
-      --  "unloaded"), finalization should not occur automatically, otherwise
-      --  the main executable may not continue to work properly.
 
       if Use_Pragma_Linker_Constructor then
          WBI ("   pragma Linker_Constructor (" & Ada_Init_Name.all & ");");
       end if;
 
+      if not Cumulative_Restrictions.Set (No_Finalization) then
+         WBI ("");
+         WBI ("   procedure " & Ada_Final_Name.all & ";");
+         WBI ("   pragma Export (C, " & Ada_Final_Name.all & ", """ &
+              Ada_Final_Name.all & """);");
+
+         if Use_Pragma_Linker_Constructor then
+            WBI ("   pragma Linker_Destructor (" & Ada_Final_Name.all & ");");
+         end if;
+      end if;
+
       if Bind_Main_Program and then VM_Target = No_VM then
 
          --  If we have the standard library, then Break_Start is defined
@@ -2933,6 +3040,10 @@ package body Bindgen is
       WBI ("");
       WBI ("package body " & Ada_Main & " is");
       WBI ("   pragma Warnings (Off);");
+      WBI ("");
+
+      --  Generate externals for elaboration entities
+      Gen_Elab_Externals_Ada;
 
       if not Suppress_Standard_Library_On_Target then
 
@@ -2964,11 +3075,11 @@ package body Bindgen is
       --  Generate the adafinal routine unless there is no finalization to do
 
       if not Cumulative_Restrictions.Set (No_Finalization) then
-         Gen_Adafinal_Ada;
-
          if Needs_Library_Finalization then
             Gen_Finalize_Library_Ada;
          end if;
+
+         Gen_Adafinal_Ada;
       end if;
 
       Gen_Adainit_Ada;
@@ -3019,14 +3130,8 @@ package body Bindgen is
 
       Resolve_Binder_Options;
 
-      WBI ("extern void " & Ada_Final_Name.all & " (void);");
-
       --  If -a has been specified use __attribute__((constructor)) for the
-      --  init procedure. No need to use a similar featute for the final
+      --  init procedure and __attribute__((destructor)) for the final one.
-      --  procedure as global finalization will occur when the executable
-      --  finishes execution and for plugins (shared stand-alone libraries that
-      --  can be "unloaded"), finalization should not occur automatically,
-      --  otherwise the main executable may not continue to work properly.
 
       if Use_Pragma_Linker_Constructor then
          WBI ("extern void " & Ada_Init_Name.all &
@@ -3035,6 +3140,15 @@ package body Bindgen is
          WBI ("extern void " & Ada_Init_Name.all & " (void);");
       end if;
 
+      if not Cumulative_Restrictions.Set (No_Finalization) then
+         if Use_Pragma_Linker_Constructor then
+            WBI ("extern void " & Ada_Final_Name.all &
+                 " (void) __attribute__((destructor));");
+         else
+            WBI ("extern void " & Ada_Final_Name.all & " (void);");
+         end if;
+      end if;
+
       WBI ("extern void system__standard_library__adafinal (void);");
 
       if not No_Main_Subprogram then
@@ -3099,29 +3213,15 @@ package body Bindgen is
 
       WBI ("");
 
+      --  Generate externals for elaboration entities
+      Gen_Elab_Externals_C;
+
       Gen_Elab_Defs_C;
 
       if Needs_Library_Finalization then
          Gen_Finalize_Library_Defs_C;
       end if;
 
-      --  Imported variables used only when we have a runtime
-
-      if not Suppress_Standard_Library_On_Target then
-
-         --  Track elaboration/finalization phase
-
-         WBI ("extern int  __gnat_handler_installed;");
-         WBI ("");
-
-         --  Track feature enable/disable on VMS
-
-         if OpenVMS_On_Target then
-            WBI ("extern int  __gnat_features_set;");
-            WBI ("");
-         end if;
-      end if;
-
       --  Write argv/argc exit status stuff if main program case
 
       if Bind_Main_Program then
@@ -3174,8 +3274,8 @@ package body Bindgen is
       --  (for the debugger to get initial control) is defined in this file.
 
       if Suppress_Standard_Library_On_Target then
-         WBI ("");
          WBI ("void __gnat_break_start (void) {}");
+         WBI ("");
       end if;
 
       --  Generate the __gnat_version and __gnat_ada_main_program_name info
@@ -3184,7 +3284,6 @@ package body Bindgen is
       --  when a C program uses 2 Ada libraries)
 
       if Bind_Main_Program then
-         WBI ("");
          WBI ("char __gnat_version[] = """ & Ver_Prefix &
                                    Gnat_Version_String & """;");
 
@@ -3193,12 +3292,16 @@ package body Bindgen is
          Set_Main_Program_Name;
          Set_String (""";");
          Write_Statement_Buffer;
+         WBI ("");
       end if;
 
-      --  Generate the adafinal routine. In no runtime mode, this is not
+      --  Generate the adafinal routine unless there is no finalization to do
-      --  needed, since there is no finalization to do.
 
       if not Cumulative_Restrictions.Set (No_Finalization) then
+         if Needs_Library_Finalization then
+            Gen_Finalize_Library_C;
+         end if;
+
          Gen_Adafinal_C;
       end if;
 

gcc/ada/checks.adb

@@ -3463,7 +3463,7 @@ package body Checks is
 
       if Enable_Overflow_Checks
         and then not Is_Entity_Name (N)
-        and then  (Lor < Lo or else Hir > Hi)
+        and then (Lor < Lo or else Hir > Hi)
       then
          OK := False;
          return;

gcc/ada/einfo.ads

@@ -934,32 +934,34 @@ package Einfo is
 --       to the spec as possible.
 
 --    Elaboration_Entity (Node13)
---       Present in generic and non-generic package and subprogram
+--       Present in generic and non-generic package and subprogram entities.
---       entities. This is a boolean entity associated with the unit that
+--       This is a counter associated with the unit that is initially set to
---       is initially set to False, and is set True when the unit is
+--       zero, is incremented when an elaboration request for the unit is
---       elaborated. This is used for two purposes. First, it is used to
+--       made, and is decremented when a finalization request for the unit
---       implement required access before elaboration checks (the flag
+--       is made. This is used for three purposes. First, it is used to
---       must be true to call a subprogram at elaboration time). Second,
+--       implement access before elaboration checks (the counter must be
---       it is used to guard against repeated execution of the generated
+--       non-zero to call a subprogram at elaboration time). Second, it is
---       elaboration code.
+--       used to guard against repeated execution of the elaboration code.
+--       Third, it is used to ensure that the finalization code is executed
+--       only after all clients have requested it.
 --
---       Note that we always allocate this flag, and set this field, but
+--       Note that we always allocate this counter, and set this field, but
 --       we do not always actually use it. It is only used if it is needed
---       for access-before-elaboration use (see Elaboration_Entity_Required
+--       for access before elaboration use (see Elaboration_Entity_Required
 --       flag) or if either the spec or the body has elaboration code. If
 --       neither of these two conditions holds, then the entity is still
 --       allocated (since we don't know early enough whether or not there
 --       is elaboration code), but is simply not used for any purpose.
 
 --    Elaboration_Entity_Required (Flag174)
---       Present in generics and non-generic package and subprogram
+--       Present in generic and non-generic package and subprogram entities.
---       entities. Set only if Elaboration_Entity is non-Empty to indicate
+--       Set only if Elaboration_Entity is non-Empty to indicate that the
---       that the boolean is required to be set even if there is no other
+--       counter is required to be non-zero even if there is no other
---       elaboration code. This occurs when the Elaboration_Entity flag
+--       elaboration code. This occurs when the Elaboration_Entity counter
---       is used for required access-before-elaboration checking. If the
+--       is used for access before elaboration checks. If the counter is
---       flag is only for preventing multiple execution of the elaboration
+--       only used to prevent multiple execution of the elaboration code,
---       code, then if there is no other elaboration code, obviously there
+--       then if there is no other elaboration code, obviously there is no
---       is no need to set the flag.
+--       need to set the flag.
 
 --    Enclosing_Scope (Node18)
 --       Present in labels. Denotes the innermost enclosing construct that

gcc/ada/exp_attr.adb

@@ -1916,7 +1916,12 @@ package body Exp_Attr is
       begin
          if Present (Elaboration_Entity (Ent)) then
             Rewrite (N,
-              New_Occurrence_Of (Elaboration_Entity (Ent), Loc));
+              Make_Op_Ne (Loc,
+                Left_Opnd =>
+                  New_Occurrence_Of (Elaboration_Entity (Ent), Loc),
+                Right_Opnd =>
+                  Make_Integer_Literal (Loc, Uint_0)));
+            Analyze_And_Resolve (N, Typ);
          else
             Rewrite (N, New_Occurrence_Of (Standard_True, Loc));
          end if;

gcc/ada/exp_ch12.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -29,6 +29,7 @@ with Einfo;    use Einfo;
 with Exp_Util; use Exp_Util;
 with Nmake;    use Nmake;
 with Sinfo;    use Sinfo;
+with Snames;   use Snames;
 with Stand;    use Stand;
 with Tbuild;   use Tbuild;
 
@@ -59,7 +60,9 @@ package body Exp_Ch12 is
              Condition =>
                Make_Op_Not (Loc,
                  Right_Opnd =>
-                   New_Occurrence_Of (Elaboration_Entity (Ent), Loc)),
+                   Make_Attribute_Reference (Loc,
+                     Attribute_Name => Name_Elaborated,
+                     Prefix => New_Occurrence_Of (Ent, Loc))),
              Reason => PE_Access_Before_Elaboration));
       end if;
    end Expand_N_Generic_Instantiation;

gcc/ada/exp_ch7.adb

@@ -2897,6 +2897,7 @@ package body Exp_Ch7 is
    is
       A_Expr : Node_Id;
       E_Decl : Node_Id;
+      Result : List_Id;
 
    begin
       if Restriction_Active (No_Exception_Propagation) then
@@ -2907,36 +2908,86 @@ package body Exp_Ch7 is
       pragma Assert (Present (E_Id));
       pragma Assert (Present (Raised_Id));
 
-      --  Generate:
+      Result := New_List;
-      --    Exception_Identity (Get_Current_Excep.all.all) =
+
-      --      Standard'Abort_Signal'Identity;
+      --  In certain scenarios, finalization can be triggered by an abort. If
+      --  the finalization itself fails and raises an exception, the resulting
+      --  Program_Error must be supressed and replaced by an abort signal. In
+      --  order to detect this scenario, save the state of entry into the
+      --  finalization code.
 
       if Abort_Allowed then
-         A_Expr :=
+         declare
-           Make_Op_Eq (Loc,
+            Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'E');
-             Left_Opnd =>
+
-               Make_Function_Call (Loc,
+         begin
-                 Name =>
+            --  Generate:
-                   New_Reference_To (RTE (RE_Exception_Identity), Loc),
+            --    Temp : constant Exception_Occurrence_Access :=
-               Parameter_Associations => New_List (
+            --             Get_Current_Excep.all;
-                 Make_Explicit_Dereference (Loc,
+
-                   Prefix =>
+            Append_To (Result,
-                     Make_Function_Call (Loc,
+              Make_Object_Declaration (Loc,
-                       Name =>
+                Defining_Identifier => Temp_Id,
-                         Make_Explicit_Dereference (Loc,
+                Constant_Present => True,
-                           Prefix =>
+                Object_Definition =>
-                             New_Reference_To
+                  New_Reference_To (RTE (RE_Exception_Occurrence_Access), Loc),
-                               (RTE (RE_Get_Current_Excep), Loc)))))),
+                Expression =>
+                  Make_Function_Call (Loc,
+                    Name =>
+                      Make_Explicit_Dereference (Loc,
+                        Prefix =>
+                          New_Reference_To
+                            (RTE (RE_Get_Current_Excep), Loc)))));
+
+            --  Generate:
+            --    Temp /= null
+            --      and then Exception_Identity (Temp.all) =
+            --                 Standard'Abort_Signal'Identity;
+
+            A_Expr :=
+              Make_And_Then (Loc,
+                Left_Opnd =>
+                  Make_Op_Ne (Loc,
+                    Left_Opnd =>
+                      New_Reference_To (Temp_Id, Loc),
+                    Right_Opnd =>
+                      Make_Null (Loc)),
+
+                Right_Opnd =>
+                  Make_Op_Eq (Loc,
+                    Left_Opnd =>
+                      Make_Function_Call (Loc,
+                        Name =>
+                          New_Reference_To (RTE (RE_Exception_Identity), Loc),
+                        Parameter_Associations => New_List (
+                          Make_Explicit_Dereference (Loc,
+                            Prefix =>
+                              New_Reference_To (Temp_Id, Loc)))),
+
+                    Right_Opnd =>
+                      Make_Attribute_Reference (Loc,
+                        Prefix =>
+                          New_Reference_To (Stand.Abort_Signal, Loc),
+                        Attribute_Name => Name_Identity)));
+         end;
+
+      --  No abort
 
-             Right_Opnd =>
-               Make_Attribute_Reference (Loc,
-                 Prefix =>
-                   New_Reference_To (Stand.Abort_Signal, Loc),
-                 Attribute_Name => Name_Identity));
       else
          A_Expr := New_Reference_To (Standard_False, Loc);
       end if;
 
+      --  Generate:
+      --    Abort_Id : constant Boolean := <A_Expr>;
+
+      Append_To (Result,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Abort_Id,
+          Constant_Present => True,
+          Object_Definition =>
+            New_Reference_To (Standard_Boolean, Loc),
+          Expression => A_Expr));
+
       --  Generate:
       --    E_Id : Exception_Occurrence;
 
@@ -2947,30 +2998,20 @@ package body Exp_Ch7 is
             New_Reference_To (RTE (RE_Exception_Occurrence), Loc));
       Set_No_Initialization (E_Decl);
 
-      return
+      Append_To (Result, E_Decl);
-        New_List (
 
-         --  Abort_Id
+      --  Generate:
+      --    Raised_Id : Boolean := False;
 
-          Make_Object_Declaration (Loc,
+      Append_To (Result,
-            Defining_Identifier => Abort_Id,
+        Make_Object_Declaration (Loc,
-            Constant_Present => True,
+          Defining_Identifier => Raised_Id,
-            Object_Definition =>
+          Object_Definition =>
-              New_Reference_To (Standard_Boolean, Loc),
+            New_Reference_To (Standard_Boolean, Loc),
-            Expression => A_Expr),
+          Expression =>
+            New_Reference_To (Standard_False, Loc)));
 
-         --  E_Id
+      return Result;
-
-          E_Decl,
-
-         --  Raised_Id
-
-          Make_Object_Declaration (Loc,
-            Defining_Identifier => Raised_Id,
-            Object_Definition =>
-              New_Reference_To (Standard_Boolean, Loc),
-            Expression =>
-              New_Reference_To (Standard_False, Loc)));
    end Build_Object_Declarations;
 
    ---------------------------
@@ -4600,9 +4641,12 @@ package body Exp_Ch7 is
       --  controlled elements. Generate:
 
       --    declare
+      --       Temp   : constant Exception_Occurrence_Access :=
+      --                  Get_Current_Excep.all;
       --       Abort  : constant Boolean :=
-      --                  Exception_Identity (Get_Current_Excep.all) =
+      --                  Temp /= null
-      --                    Standard'Abort_Signal'Identity;
+      --                    and then Exception_Identity (Temp_Id.all) =
+      --                               Standard'Abort_Signal'Identity;
       --         <or>
       --       Abort  : constant Boolean := False;  --  no abort
 
@@ -4653,9 +4697,12 @@ package body Exp_Ch7 is
       --             exception
       --                when others =>
       --                   declare
+      --                      Temp   : constant Exception_Occurrence_Access :=
+      --                                 Get_Current_Excep.all;
       --                      Abort  : constant Boolean :=
-      --                        Exception_Identity (Get_Current_Excep.all) =
+      --                        Temp /= null
-      --                          Standard'Abort_Signal'Identity;
+      --                          and then Exception_Identity (Temp_Id.all) =
+      --                                     Standard'Abort_Signal'Identity;
       --                        <or>
       --                      Abort  : constant Boolean := False; --  no abort
       --                      E      : Exception_Occurence;
@@ -5513,9 +5560,12 @@ package body Exp_Ch7 is
       --  may have discriminants and contain variant parts. Generate:
 
       --    declare
+      --       Temp   : constant Exception_Occurrence_Access :=
+      --                  Get_Current_Excep.all;
       --       Abort  : constant Boolean :=
-      --                  Exception_Identity (Get_Current_Excep.all) =
+      --                  Temp /= null
-      --                    Standard'Abort_Signal'Identity;
+      --                    and then Exception_Identity (Temp_Id.all) =
+      --                               Standard'Abort_Signal'Identity;
       --         <or>
       --       Abort  : constant Boolean := False;  --  no abort
       --       E      : Exception_Occurence;

gcc/ada/exp_util.adb

@@ -6634,7 +6634,7 @@ package body Exp_Util is
             Asn :=
               Make_Assignment_Statement (Loc,
                 Name       => New_Occurrence_Of (Ent, Loc),
-                Expression => New_Occurrence_Of (Standard_True, Loc));
+                Expression => Make_Integer_Literal (Loc, Uint_1));
 
             if Nkind (Parent (N)) = N_Subunit then
                Insert_After (Corresponding_Stub (Parent (N)), Asn);

gcc/ada/prj-env.adb

@@ -1840,6 +1840,11 @@ package body Prj.Env is
          Self.Path := new String'(Tmp.all & Path_Separator & Path);
          Free (Tmp);
       end if;
+
+      if Current_Verbosity = High then
+         Debug_Output ("Adding directories to Project_Path: """
+                       & Path & '"');
+      end if;
    end Add_Directories;
 
    --------------------

gcc/ada/prj-nmsc.adb

@@ -930,7 +930,9 @@ package body Prj.Nmsc is
 
       Project_Path_For_Aggregate : Prj.Env.Project_Search_Path;
 
-      procedure Found_Project_File (Path : Path_Information; Rank : Natural);
+      procedure Found_Project_File
+        (Path  : Path_Information;
+         Rank  : Natural);
       --  Called for each project file aggregated by Project
 
       procedure Expand_Project_Files is
@@ -942,7 +944,10 @@ package body Prj.Nmsc is
       -- Found_Project_File --
       ------------------------
 
-      procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
+      procedure Found_Project_File
+        (Path  : Path_Information;
+         Rank  : Natural)
+      is
          pragma Unreferenced (Rank);
       begin
          if Path.Name /= Project.Path.Name then
@@ -5041,8 +5046,8 @@ package body Prj.Nmsc is
       Remove_Source_Dirs : Boolean := False;
 
       procedure Add_To_Or_Remove_From_Source_Dirs
-        (Path : Path_Information;
+        (Path  : Path_Information;
-         Rank : Natural);
+         Rank  : Natural);
       --  When Removed = False, the directory Path_Id to the list of
       --  source_dirs if not already in the list. When Removed = True,
       --  removed directory Path_Id if in the list.
@@ -5055,8 +5060,8 @@ package body Prj.Nmsc is
       ---------------------------------------
 
       procedure Add_To_Or_Remove_From_Source_Dirs
-        (Path : Path_Information;
+        (Path  : Path_Information;
-         Rank : Natural)
+         Rank  : Natural)
       is
          List       : String_List_Id;
          Prev       : String_List_Id;
@@ -5310,9 +5315,9 @@ package body Prj.Nmsc is
 
          Remove_Source_Dirs := False;
          Add_To_Or_Remove_From_Source_Dirs
-           (Path => (Name         => Project.Directory.Name,
+           (Path  => (Name         => Project.Directory.Name,
-                     Display_Name => Project.Directory.Display_Name),
+                      Display_Name => Project.Directory.Display_Name),
-            Rank => 1);
+            Rank  => 1);
 
       else
          Remove_Source_Dirs := False;

gcc/ada/prj-proc.adb

@@ -28,6 +28,7 @@ with Opt;      use Opt;
 with Osint;    use Osint;
 with Output;   use Output;
 with Prj.Attr; use Prj.Attr;
+with Prj.Env;
 with Prj.Err;  use Prj.Err;
 with Prj.Ext;  use Prj.Ext;
 with Prj.Nmsc; use Prj.Nmsc;
@@ -1971,10 +1972,6 @@ package body Prj.Proc is
                      & Get_Name_String (Index_Name) & ")", New_Value.Value);
                end if;
             end if;
-
-         elsif Name = Snames.Name_Project_Path then
-            Debug_Output
-              ("Defined project path");
          end if;
       end Process_Expression_For_Associative_Array;
 
@@ -1987,11 +1984,10 @@ package body Prj.Proc is
          New_Value    : Variable_Value)
       is
          Name : constant Name_Id := Name_Of (Current_Item, Node_Tree);
-         Var  : Variable_Id := No_Variable;
-
          Is_Attribute : constant Boolean :=
                           Kind_Of (Current_Item, Node_Tree) =
                             N_Attribute_Declaration;
+         Var  : Variable_Id := No_Variable;
 
       begin
          --  First, find the list where to find the variable or attribute.
@@ -2056,6 +2052,29 @@ package body Prj.Proc is
          else
             Shared.Variable_Elements.Table (Var).Value := New_Value;
          end if;
+
+         if Name = Snames.Name_Project_Path then
+            if In_Tree.Is_Root_Tree then
+               declare
+                  Val : String_List_Id := New_Value.Values;
+               begin
+                  while Val /= Nil_String loop
+                     Prj.Env.Add_Directories
+                       (Child_Env.Project_Path,
+                        Get_Name_String
+                          (Shared.String_Elements.Table (Val).Value));
+                     Val := Shared.String_Elements.Table (Val).Next;
+                  end loop;
+               end;
+
+            else
+               if Current_Verbosity = High then
+                  Debug_Output
+                    ("'for Project_Path' has no effect except in"
+                     & " root aggregate");
+               end if;
+            end if;
+         end if;
       end Process_Expression_Variable_Decl;
 
       ------------------------

gcc/ada/rtsfind.ads

@@ -504,6 +504,7 @@ package Rtsfind is
      RE_Exception_Message,               -- Ada.Exceptions
      RE_Exception_Name_Simple,           -- Ada.Exceptions
      RE_Exception_Occurrence,            -- Ada.Exceptions
+     RE_Exception_Occurrence_Access,     -- Ada.Exceptions
      RE_Null_Id,                         -- Ada.Exceptions
      RE_Null_Occurrence,                 -- Ada.Exceptions
      RE_Poll,                            -- Ada.Exceptions
@@ -1682,6 +1683,7 @@ package Rtsfind is
      RE_Exception_Message                => Ada_Exceptions,
      RE_Exception_Name_Simple            => Ada_Exceptions,
      RE_Exception_Occurrence             => Ada_Exceptions,
+     RE_Exception_Occurrence_Access      => Ada_Exceptions,
      RE_Null_Id                          => Ada_Exceptions,
      RE_Null_Occurrence                  => Ada_Exceptions,
      RE_Poll                             => Ada_Exceptions,

gcc/ada/sem_attr.adb

@@ -295,9 +295,6 @@ package body Sem_Attr is
       procedure Check_Integer_Type;
       --  Verify that prefix of attribute N is an integer type
 
-      procedure Check_Library_Unit;
-      --  Verify that prefix of attribute N is a library unit
-
       procedure Check_Modular_Integer_Type;
       --  Verify that prefix of attribute N is a modular integer type
 
@@ -344,8 +341,8 @@ package body Sem_Attr is
       --  itself of the form of a library unit name. Note that this is
       --  quite different from Check_Program_Unit, since it only checks
       --  the syntactic form of the name, not the semantic identity. This
-      --  is because it is used with attributes (Elab_Body, Elab_Spec, and
+      --  is because it is used with attributes (Elab_Body, Elab_Spec,
-      --  UET_Address) which can refer to non-visible unit.
+      --  UET_Address and Elaborated) which can refer to non-visible unit.
 
       procedure Error_Attr (Msg : String; Error_Node : Node_Id);
       pragma No_Return (Error_Attr);
@@ -1302,17 +1299,6 @@ package body Sem_Attr is
          end if;
       end Check_Integer_Type;
 
-      ------------------------
-      -- Check_Library_Unit --
-      ------------------------
-
-      procedure Check_Library_Unit is
-      begin
-         if not Is_Compilation_Unit (Entity (P)) then
-            Error_Attr_P ("prefix of % attribute must be library unit");
-         end if;
-      end Check_Library_Unit;
-
       --------------------------------
       -- Check_Modular_Integer_Type --
       --------------------------------
@@ -1761,7 +1747,9 @@ package body Sem_Attr is
          if Nkind (Nod) = N_Identifier then
             return;
 
-         elsif Nkind (Nod) = N_Selected_Component then
+         elsif Nkind (Nod) = N_Selected_Component
+           or else Nkind (Nod) = N_Expanded_Name
+         then
             Check_Unit_Name (Prefix (Nod));
 
             if Nkind (Selector_Name (Nod)) = N_Identifier then
@@ -3003,7 +2991,7 @@ package body Sem_Attr is
 
       when Attribute_Elaborated =>
          Check_E0;
-         Check_Library_Unit;
+         Check_Unit_Name (P);
          Set_Etype (N, Standard_Boolean);
 
       ----------

gcc/ada/sem_elab.adb

@@ -55,6 +55,7 @@ with Snames;   use Snames;
 with Stand;    use Stand;
 with Table;
 with Tbuild;   use Tbuild;
+with Uintp;    use Uintp;
 with Uname;    use Uname;
 
 package body Sem_Elab is
@@ -2156,8 +2157,8 @@ package body Sem_Elab is
                     Make_Object_Declaration (Loce,
                       Defining_Identifier => Ent,
                       Object_Definition =>
-                        New_Occurrence_Of (Standard_Boolean, Loce),
+                        New_Occurrence_Of (Standard_Integer, Loce),
-                      Expression => New_Occurrence_Of (Standard_False, Loce)));
+                      Expression => Make_Integer_Literal (Loc, Uint_0)));
 
                   --  Set elaboration flag at the point of the body
 
@@ -2176,10 +2177,12 @@ package body Sem_Elab is
                end;
             end if;
 
-            --  Generate check of the elaboration Boolean
+            --  Generate check of the elaboration counter
 
             Insert_Elab_Check (N,
-              New_Occurrence_Of (Elaboration_Entity (E), Loc));
+               Make_Attribute_Reference (Loc,
+                 Attribute_Name => Name_Elaborated,
+                 Prefix => New_Occurrence_Of (E, Loc)));
          end if;
 
          --  Generate the warning
@@ -2419,7 +2422,7 @@ package body Sem_Elab is
                 not Restriction_Active (No_Entry_Calls_In_Elaboration_Code)
             then
                --  Runtime elaboration check required. Generate check of the
-               --  elaboration Boolean for the unit containing the entity.
+               --  elaboration counter for the unit containing the entity.
 
                Insert_Elab_Check (N,
                  Make_Attribute_Reference (Loc,

gcc/ada/sem_util.adb

@@ -964,9 +964,9 @@ package body Sem_Util is
          Make_Object_Declaration (Loc,
            Defining_Identifier => Elab_Ent,
            Object_Definition   =>
-             New_Occurrence_Of (Standard_Boolean, Loc),
+             New_Occurrence_Of (Standard_Integer, Loc),
            Expression          =>
-             New_Occurrence_Of (Standard_False, Loc));
+             Make_Integer_Literal (Loc, Uint_0));
 
       Push_Scope (Standard_Standard);
       Add_Global_Declaration (Decl);

gcc/ada/sem_util.ads

@@ -136,7 +136,7 @@ package Sem_Util is
    --  discriminants, and build actual subtype for it if so.
 
    procedure Build_Elaboration_Entity (N : Node_Id; Spec_Id : Entity_Id);
-   --  Given a compilation unit node N, allocate an elaboration boolean for
+   --  Given a compilation unit node N, allocate an elaboration counter for
    --  the compilation unit, and install it in the Elaboration_Entity field
    --  of Spec_Id, the entity for the compilation unit.