[multiple changes]

2011-08-04  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Expand_Composite_Equality): code cleanup: use component
	type in all cases to compute list of primitive operations, because full
	view may be an itype that is not attached to the list of declarations.

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

	* bindgen.adb (Gen_Adafinal_Ada): Generate an early return if the
	library has already been finalized.
	(Gen_Adafinal_C): Likewise.
	(Gen_Adainit_Ada): Generate an early return if the library has
	already been elaborated.
	(Gen_Adainit_C): Likewise.
	(Gen_Output_File_Ada): Generate an elaboration flag.
	(Gen_Output_File_C): Likewise.

From-SVN: r177331

gcc/ada/ChangeLog

+2011-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch4.adb (Expand_Composite_Equality): code cleanup: use component
+	type in all cases to compute list of primitive operations, because full
+	view may be an itype that is not attached to the list of declarations.
+
+2011-08-04  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* bindgen.adb (Gen_Adafinal_Ada): Generate an early return if the
+	library has already been finalized.
+	(Gen_Adafinal_C): Likewise.
+	(Gen_Adainit_Ada): Generate an early return if the library has
+	already been elaborated.
+	(Gen_Adainit_C): Likewise.
+	(Gen_Output_File_Ada): Generate an elaboration flag.
+	(Gen_Output_File_C): Likewise.
+
 2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* exp_ch4.adb (Expand_Allocator_Expression): Disable the generation of

gcc/ada/bindgen.adb

@@ -428,8 +428,20 @@ package body Bindgen is
    begin
       WBI ("   procedure " & Ada_Final_Name.all & " is");
 
+      if Bind_Main_Program and then VM_Target = No_VM then
+         WBI ("      procedure s_stalib_adafinal;");
+         Set_String ("      pragma Import (C, s_stalib_adafinal, ");
+         Set_String ("""system__standard_library__adafinal"");");
+         Write_Statement_Buffer;
+      end if;
+
+      WBI ("   begin");
+      WBI ("      if not Is_Elaborated then");
+      WBI ("         return;");
+      WBI ("      end if;");
+      WBI ("      Is_Elaborated := False;");
+
       if not Bind_Main_Program then
-         WBI ("   begin");
          if Lib_Final_Built then
             WBI ("      finalize_library;");
          else
@@ -439,17 +451,12 @@ package body Bindgen is
       --  Main program case
 
       elsif VM_Target = No_VM then
-         WBI ("      procedure s_stalib_adafinal;");
-         WBI ("      pragma Import (C, s_stalib_adafinal, " &
-              """system__standard_library__adafinal"");");
-         WBI ("   begin");
          WBI ("      s_stalib_adafinal;");
 
       --  Pragma Import C cannot be used on virtual machine targets, therefore
       --  call the runtime finalization routine directly.
 
       else
-         WBI ("   begin");
          WBI ("      System.Standard_Library.Adafinal;");
       end if;
 
@@ -465,6 +472,10 @@ package body Bindgen is
    begin
       WBI ("void " & Ada_Final_Name.all & " (void) {");
 
+      WBI ("   if (!is_elaborated)");
+      WBI ("      return;");
+      WBI ("   is_elaborated = 0;");
+
       if not Bind_Main_Program then
          if Lib_Final_Built then
             WBI ("   finalize_library ();");
@@ -685,6 +696,11 @@ package body Bindgen is
 
          WBI ("   begin");
 
+         WBI ("      if Is_Elaborated then");
+         WBI ("         return;");
+         WBI ("      end if;");
+         WBI ("      Is_Elaborated := True;");
+
          Set_String ("      Main_Priority := ");
          Set_Int    (Main_Priority);
          Set_Char   (';');
@@ -941,6 +957,10 @@ package body Bindgen is
       WBI ("void " & Ada_Init_Name.all & " (void)");
       WBI ("{");
 
+      WBI ("   if (is_elaborated)");
+      WBI ("      return;");
+      WBI ("   is_elaborated = 1;");
+
       --  Standard library suppressed
 
       if Suppress_Standard_Library_On_Target then
@@ -3077,6 +3097,9 @@ package body Bindgen is
          WBI ("");
       end if;
 
+      WBI ("   Is_Elaborated : Boolean := False;");
+      WBI ("");
+
       --  Generate the adafinal routine unless there is no finalization to do
 
       if not Cumulative_Restrictions.Set (No_Finalization) then
@@ -3300,6 +3323,9 @@ package body Bindgen is
          WBI ("");
       end if;
 
+      WBI ("static char is_elaborated = 0;");
+      WBI ("");
+
       --  Generate the adafinal routine unless there is no finalization to do
 
       if not Cumulative_Restrictions.Set (No_Finalization) then

gcc/ada/exp_ch4.adb

@@ -2103,6 +2103,54 @@ package body Exp_Ch4 is
       Prim      : Elmt_Id;
       Eq_Op     : Entity_Id;
 
+      function Find_Primitive_Eq return Node_Id;
+      --  AI05-0123: Locate primitive equality for type if it exists, and
+      --  build the corresponding call. If operation is abstract, replace
+      --  call with an explicit raise. Return Empty if there is no primitive.
+
+      -----------------------
+      -- Find_Primitive_Eq --
+      -----------------------
+
+      function Find_Primitive_Eq return Node_Id is
+         Prim_E : Elmt_Id;
+         Prim   : Node_Id;
+
+      begin
+         Prim_E := First_Elmt (Collect_Primitive_Operations (Typ));
+         while Present (Prim_E) loop
+            Prim := Node (Prim_E);
+
+            --  Locate primitive equality with the right signature
+
+            if Chars (Prim) = Name_Op_Eq
+              and then Etype (First_Formal (Prim)) =
+                         Etype (Next_Formal (First_Formal (Prim)))
+              and then Etype (Prim) = Standard_Boolean
+            then
+               if Is_Abstract_Subprogram (Prim) then
+                  return
+                    Make_Raise_Program_Error (Loc,
+                      Reason => PE_Explicit_Raise);
+
+               else
+                  return
+                    Make_Function_Call (Loc,
+                      Name => New_Reference_To (Prim, Loc),
+                      Parameter_Associations => New_List (Lhs, Rhs));
+               end if;
+            end if;
+
+            Next_Elmt (Prim_E);
+         end loop;
+
+         --  If not found, predefined operation will be used
+
+         return Empty;
+      end Find_Primitive_Eq;
+
+   --  Start of processing for Expand_Composite_Equality
+
    begin
       if Is_Private_Type (Typ) then
          Full_Type := Underlying_Type (Typ);
@@ -2324,43 +2372,22 @@ package body Exp_Ch4 is
          elsif Ada_Version >= Ada_2012 then
 
             --  if no TSS has been created for the type, check whether there is
-            --  a primitive equality declared for it. If it is abstract replace
-            --  the call with an explicit raise (AI05-0123).
+            --  a primitive equality declared for it.
 
             declare
-               Prim : Elmt_Id;
+               Ada_2012_Op : constant Node_Id := Find_Primitive_Eq;
 
             begin
-               Prim := First_Elmt (Collect_Primitive_Operations (Full_Type));
-               while Present (Prim) loop
+               if Present (Ada_2012_Op) then
+                  return Ada_2012_Op;
+               else
 
-                  --  Locate primitive equality with the right signature
+               --  Use predefined equality if no user-defined primitive exists
 
-                  if Chars (Node (Prim)) = Name_Op_Eq
-                    and then Etype (First_Formal (Node (Prim))) =
-                               Etype (Next_Formal (First_Formal (Node (Prim))))
-                    and then Etype (Node (Prim)) = Standard_Boolean
-                  then
-                     if Is_Abstract_Subprogram (Node (Prim)) then
-                        return
-                          Make_Raise_Program_Error (Loc,
-                            Reason => PE_Explicit_Raise);
-                     else
-                        return
-                          Make_Function_Call (Loc,
-                            Name => New_Reference_To (Node (Prim), Loc),
-                            Parameter_Associations => New_List (Lhs, Rhs));
-                     end if;
-                  end if;
-
-                  Next_Elmt (Prim);
-               end loop;
+                  return Make_Op_Eq (Loc, Lhs, Rhs);
+               end if;
             end;
 
-            --  Use predefined equality iff no user-defined primitive exists
-
-            return Make_Op_Eq (Loc, Lhs, Rhs);
-
          else
             return Expand_Record_Equality (Nod, Full_Type, Lhs, Rhs, Bodies);
          end if;