diff options
Diffstat (limited to 'gcc/ada/exp_util.adb')
| -rw-r--r-- | gcc/ada/exp_util.adb | 95 |
1 files changed, 63 insertions, 32 deletions
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 335ba10c9db..b43bd16edd1 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -3940,27 +3940,30 @@ package body Exp_Util is return True; end Is_All_Null_Statements; - --------------------------------------------- - -- Is_Displacement_Of_Ctrl_Function_Result -- - --------------------------------------------- + -------------------------------------------------- + -- Is_Displacement_Of_Object_Or_Function_Result -- + -------------------------------------------------- - function Is_Displacement_Of_Ctrl_Function_Result + function Is_Displacement_Of_Object_Or_Function_Result (Obj_Id : Entity_Id) return Boolean is - function Initialized_By_Ctrl_Function (N : Node_Id) return Boolean; - -- Determine whether object declaration N is initialized by a controlled - -- function call. + function Is_Controlled_Function_Call (N : Node_Id) return Boolean; + -- Determine whether a particular node denotes a controlled function + -- call. function Is_Displace_Call (N : Node_Id) return Boolean; -- Determine whether a particular node is a call to Ada.Tags.Displace. -- The call might be nested within other actions such as conversions. - ---------------------------------- - -- Initialized_By_Ctrl_Function -- - ---------------------------------- + function Is_Source_Object (N : Node_Id) return Boolean; + -- Determine whether a particular node denotes a source object + + --------------------------------- + -- Is_Controlled_Function_Call -- + --------------------------------- - function Initialized_By_Ctrl_Function (N : Node_Id) return Boolean is - Expr : Node_Id := Original_Node (Expression (N)); + function Is_Controlled_Function_Call (N : Node_Id) return Boolean is + Expr : Node_Id := Original_Node (N); begin if Nkind (Expr) = N_Function_Call then @@ -3977,7 +3980,7 @@ package body Exp_Util is Nkind_In (Expr, N_Expanded_Name, N_Identifier) and then Ekind (Entity (Expr)) = E_Function and then Needs_Finalization (Etype (Entity (Expr))); - end Initialized_By_Ctrl_Function; + end Is_Controlled_Function_Call; ---------------------- -- Is_Displace_Call -- @@ -4004,39 +4007,66 @@ package body Exp_Util is end loop; return - Nkind (Call) = N_Function_Call + Present (Call) + and then Nkind (Call) = N_Function_Call and then Is_RTE (Entity (Name (Call)), RE_Displace); end Is_Displace_Call; + ---------------------- + -- Is_Source_Object -- + ---------------------- + + function Is_Source_Object (N : Node_Id) return Boolean is + begin + return + Present (N) + and then Nkind (N) in N_Has_Entity + and then Is_Object (Entity (N)) + and then Comes_From_Source (N); + end Is_Source_Object; + -- Local variables Decl : constant Node_Id := Parent (Obj_Id); Obj_Typ : constant Entity_Id := Base_Type (Etype (Obj_Id)); Orig_Decl : constant Node_Id := Original_Node (Decl); - -- Start of processing for Is_Displacement_Of_Ctrl_Function_Result + -- Start of processing for Is_Displacement_Of_Object_Or_Function_Result begin - -- Detect the following case: + -- Case 1: - -- Obj : Class_Wide_Type := Function_Call (...); + -- Obj : CW_Type := Function_Call (...); - -- which is rewritten into: + -- rewritten into: - -- Temp : ... := Function_Call (...)'reference; - -- Obj : Class_Wide_Type renames (... Ada.Tags.Displace (Temp)); + -- Tmp : ... := Function_Call (...)'reference; + -- Obj : CW_Type renames (... Ada.Tags.Displace (Tmp)); - -- when the return type of the function and the class-wide type require + -- where the return type of the function and the class-wide type require + -- dispatch table pointer displacement. + + -- Case 2: + + -- Obj : CW_Type := Src_Obj; + + -- rewritten into: + + -- Obj : CW_Type renames (... Ada.Tags.Displace (Src_Obj)); + + -- where the type of the source object and the class-wide type require -- dispatch table pointer displacement. return Nkind (Decl) = N_Object_Renaming_Declaration and then Nkind (Orig_Decl) = N_Object_Declaration and then Comes_From_Source (Orig_Decl) - and then Initialized_By_Ctrl_Function (Orig_Decl) and then Is_Class_Wide_Type (Obj_Typ) - and then Is_Displace_Call (Renamed_Object (Obj_Id)); - end Is_Displacement_Of_Ctrl_Function_Result; + and then Is_Displace_Call (Renamed_Object (Obj_Id)) + and then + (Is_Controlled_Function_Call (Expression (Orig_Decl)) + or else Is_Source_Object (Expression (Orig_Decl))); + end Is_Displacement_Of_Object_Or_Function_Result; ------------------------------ -- Is_Finalizable_Transient -- @@ -7189,17 +7219,18 @@ package body Exp_Util is then return True; - -- Detect a case where a source object has been initialized by a - -- controlled function call which was later rewritten as a class- - -- wide conversion of Ada.Tags.Displace. + -- Detect a case where a source object has been initialized by + -- a controlled function call or another object which was later + -- rewritten as a class-wide conversion of Ada.Tags.Displace. - -- Obj : Class_Wide_Type := Function_Call (...); + -- Obj1 : CW_Type := Src_Obj; + -- Obj2 : CW_Type := Function_Call (...); - -- Temp : ... := Function_Call (...)'reference; - -- Obj : Class_Wide_Type renames - -- (... Ada.Tags.Displace (Temp)); + -- Obj1 : CW_Type renames (... Ada.Tags.Displace (Src_Obj)); + -- Tmp : ... := Function_Call (...)'reference; + -- Obj2 : CW_Type renames (... Ada.Tags.Displace (Tmp)); - elsif Is_Displacement_Of_Ctrl_Function_Result (Obj_Id) then + elsif Is_Displacement_Of_Object_Or_Function_Result (Obj_Id) then return True; end if; |