diff options
| author | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-10-11 10:23:31 +0200 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-10-11 10:23:31 +0200 |
| commit | 9694c03951602dd1216838de82dc1c2de54d2754 (patch) | |
| tree | 683b8604bef46a8c1128c9c36abfc63a9c1e98cb /gcc/ada/exp_ch5.adb | |
| parent | 0144fd18d746179a058011b4339dd852a2805dda (diff) | |
| download | gcc-9694c03951602dd1216838de82dc1c2de54d2754.zip gcc-9694c03951602dd1216838de82dc1c2de54d2754.tar.gz gcc-9694c03951602dd1216838de82dc1c2de54d2754.tar.bz2 | |
[multiple changes]
2010-10-11 Robert Dewar <dewar@adacore.com>
* a-textio.adb: Minor reformatting
2010-10-11 Robert Dewar <dewar@adacore.com>
* a-suesen.ads, a-suenst.ads,
a-suesen.adb, a-suenst.adb,
a-suewse.adb, a-suewst.adb,
a-suewse.ads, a-suewst.ads,
a-suezse.ads, a-suezst.ads,
a-suezse.adb, a-suezst.adb: New name for string encoding packages.
* impunit.adb: New names for string encoding units
* Makefile.rtl: New names for string encoding units
* rtsfind.ads: Minor code reorganization.
2010-10-11 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb: Code clean up.
2010-10-11 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Check_Limited_Return): Specialize warning on limited
returns when in a generic context.
(Analyze_Function_Return): ditto.
From-SVN: r165276
Diffstat (limited to 'gcc/ada/exp_ch5.adb')
| -rw-r--r-- | gcc/ada/exp_ch5.adb | 39 |
1 files changed, 24 insertions, 15 deletions
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index f53ac1f..a28c5ab 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -3151,8 +3151,11 @@ package body Exp_Ch5 is else -- We're about to drop Return_Object_Declarations on the floor, so -- we need to insert it, in case it got expanded into useful code. + -- Remove side effects from expression, which may be duplicated in + -- subsequent checks (see Expand_Simple_Function_Return). Insert_List_Before (N, Return_Object_Declarations (N)); + Remove_Side_Effects (Exp); -- Build simple_return_statement that returns the expression directly @@ -4248,29 +4251,35 @@ package body Exp_Ch5 is end; -- AI05-0073: If function has a controlling access result, check that - -- the tag of the return value matches the designated type. + -- the tag of the return value, if it is not null, matches designated + -- type of return type. -- The "or else True" needs commenting here ??? elsif Ekind (R_Type) = E_Anonymous_Access_Type and then Has_Controlling_Result (Scope_Id) - and then (Ada_Version >= Ada_12 or else True) then - Insert_Action (Exp, + Insert_Action (N, Make_Raise_Constraint_Error (Loc, Condition => - Make_Op_Ne (Loc, - Left_Opnd => - Make_Selected_Component (Loc, - Prefix => Duplicate_Subexpr (Exp), - Selector_Name => - Make_Identifier (Loc, Chars => Name_uTag)), - Right_Opnd => - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Designated_Type (R_Type), Loc), - Attribute_Name => Name_Tag)), - Reason => CE_Tag_Check_Failed)); + Make_And_Then (Loc, + Left_Opnd => + Make_Op_Ne (Loc, + Left_Opnd => Exp, + Right_Opnd => Make_Null (Loc)), + Right_Opnd => Make_Op_Ne (Loc, + Left_Opnd => + Make_Selected_Component (Loc, + Prefix => Duplicate_Subexpr (Exp), + Selector_Name => + Make_Identifier (Loc, Chars => Name_uTag)), + Right_Opnd => + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (Designated_Type (R_Type), Loc), + Attribute_Name => Name_Tag))), + Reason => CE_Tag_Check_Failed), + Suppress => All_Checks); end if; -- If we are returning an object that may not be bit-aligned, then copy |