[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
This commit is contained in:
Arnaud Charlet
parent
f65df6093b
commit
7efc3f2d9e
|
|
@ -1,3 +1,20 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
Loading…
Reference in New Issue