diff options
author | Thomas Quinot <quinot@adacore.com> | 2013-01-02 11:55:20 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-01-02 12:55:20 +0100 |
commit | 0469274e2e486a6e0f0beabdd85f53c9f1b4b7b9 (patch) | |
tree | 6026078bf7293c7249725048d7762ab21c2b2c47 | |
parent | ca1ffed0e8ac8c0eddaf04b73e05a1af1e0dff32 (diff) | |
download | gcc-0469274e2e486a6e0f0beabdd85f53c9f1b4b7b9.zip gcc-0469274e2e486a6e0f0beabdd85f53c9f1b4b7b9.tar.gz gcc-0469274e2e486a6e0f0beabdd85f53c9f1b4b7b9.tar.bz2 |
exp_intr.adb (Expand_Dispatching_Constructor_Call): Remove side effects from Tag_Arg early...
2013-01-02 Thomas Quinot <quinot@adacore.com>
* exp_intr.adb (Expand_Dispatching_Constructor_Call): Remove
side effects from Tag_Arg early, doing it too late may cause a
crash due to inconsistent Parent link.
* sem_ch8.adb, einfo.ads: Minor reformatting.
From-SVN: r194803
-rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/ada/einfo.ads | 10 | ||||
-rw-r--r-- | gcc/ada/exp_intr.adb | 28 | ||||
-rw-r--r-- | gcc/ada/sem_ch8.adb | 2 |
4 files changed, 28 insertions, 19 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index eaa7d6a..fa4cb07 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * exp_intr.adb (Expand_Dispatching_Constructor_Call): Remove + side effects from Tag_Arg early, doing it too late may cause a + crash due to inconsistent Parent link. + * sem_ch8.adb, einfo.ads: Minor reformatting. + 2013-01-02 Robert Dewar <dewar@adacore.com> * einfo.ads, einfo.adb (Has_Independent_Components): New flag. diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 1da43d8..1b412e5 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -902,11 +902,11 @@ package Einfo is -- DTC_Entity (Node16) -- Defined in function and procedure entities. Set to Empty unless -- the subprogram is dispatching in which case it references the --- Dispatch Table pointer Component. That is to say the component _tag --- for regular Ada tagged types, for CPP_Class types and their --- descendants this field points to the component entity in the record --- that is the Vtable pointer for the Vtable containing the entry that --- references the subprogram. +-- Dispatch Table pointer Component. For regular Ada tagged this, this +-- is the _Tag component. For CPP_Class types and their descendants, +-- this points to the component entity in the record that holds the +-- Vtable pointer for the Vtable containing the entry referencing the +-- subprogram. -- DT_Entry_Count (Uint15) -- Defined in E_Component entities. Only used for component marked diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index c3389dd..b2c24c8 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -210,6 +210,15 @@ package body Exp_Intr is Result_Typ : Entity_Id; begin + -- Remove side effects from tag argument early, before rewriting + -- the dispatching constructor call, as Remove_Side_Effects relies + -- on Tag_Arg's Parent link properly attached to the tree (once the + -- call is rewritten, the Parent is inconsistent as it points to the + -- rewritten node, which is not the syntactic parent of the Tag_Arg + -- anymore). + + Remove_Side_Effects (Tag_Arg); + -- The subprogram is the third actual in the instantiation, and is -- retrieved from the corresponding renaming declaration. However, -- freeze nodes may appear before, so we retrieve the declaration @@ -223,15 +232,10 @@ package body Exp_Intr is Act_Constr := Entity (Name (Act_Rename)); Result_Typ := Class_Wide_Type (Etype (Act_Constr)); - -- Ada 2005 (AI-251): If the result is an interface type, the function - -- returns a class-wide interface type (otherwise the resulting object - -- would be abstract!) - if Is_Interface (Etype (Act_Constr)) then - Set_Etype (Act_Constr, Result_Typ); - -- If the result type is not parent of Tag_Arg then we need to - -- locate the tag of the secondary dispatch table. + -- If the result type is not known to be a parent of Tag_Arg then we + -- need to locate the tag of the secondary dispatch table. if not Is_Ancestor (Etype (Result_Typ), Etype (Tag_Arg), Use_Full_View => True) @@ -255,7 +259,7 @@ package body Exp_Intr is New_Reference_To (RTE (RE_Tag), Loc), Expression => Make_Function_Call (Loc, - Name => Fname, + Name => Fname, Parameter_Associations => New_List ( Relocate_Node (Tag_Arg), New_Reference_To @@ -283,9 +287,7 @@ package body Exp_Intr is Set_Controlling_Argument (Cnstr_Call, New_Occurrence_Of (Defining_Identifier (Iface_Tag), Loc)); else - Remove_Side_Effects (Tag_Arg); - Set_Controlling_Argument (Cnstr_Call, - Relocate_Node (Tag_Arg)); + Set_Controlling_Argument (Cnstr_Call, Relocate_Node (Tag_Arg)); end if; -- Rewrite and analyze the call to the instance as a class-wide @@ -314,7 +316,7 @@ package body Exp_Intr is elsif not Is_Interface (Result_Typ) then declare - Obj_Tag_Node : Node_Id := Duplicate_Subexpr (Tag_Arg); + Obj_Tag_Node : Node_Id := New_Copy_Tree (Tag_Arg); CW_Test_Node : Node_Id; begin @@ -348,7 +350,7 @@ package body Exp_Intr is Name => New_Occurrence_Of (RTE (RE_IW_Membership), Loc), Parameter_Associations => New_List ( Make_Attribute_Reference (Loc, - Prefix => Duplicate_Subexpr (Tag_Arg), + Prefix => New_Copy_Tree (Tag_Arg), Attribute_Name => Name_Address), New_Reference_To ( diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index c02a4c3..4437a16 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -1906,7 +1906,7 @@ package body Sem_Ch8 is end loop; New_S := Analyze_Subprogram_Specification (Spec); - Result := Find_Renamed_Entity (N, Name (N), New_S, Is_Actual); + Result := Find_Renamed_Entity (N, Name (N), New_S, Is_Actual); end if; if Result /= Any_Id then |