+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
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
-- 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;
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 ();");
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 (';');
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
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
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
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);
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;
projects / gcc.git / commitdiff