diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-10-07 12:45:48 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-10-07 12:45:48 +0000 |
| commit | afac521699b38b93a4085feb43efa30bc58c5d8b (patch) | |
| tree | b5d98752418158a359ebc8106e255270aba2aff9 /gcc/ada/exp_ch5.adb | |
| parent | 26e182d2e080cfccf7a2a11e9f675fb4c757948c (diff) | |
| download | gcc-afac521699b38b93a4085feb43efa30bc58c5d8b.tar.gz | |
2010-10-07 Robert Dewar <dewar@adacore.com>
* par-ch3.adb, par-ch6.adb, par-ch7.adb, par-ch9.adb, par-ch10.adb: Add
Pexp to Pf_Rec constants
(P_Subprogram): Expression is always enclosed in parentheses
* par.adb (Pf_Rec): add Pexp flag for parametrized expression
* sinfo.ads (N_Parametrized_Expression): Expression must be in parens
2010-10-07 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Specification): Implement Ada2012
checks on functions that return an abstract type or have a controlling
result whose designated type is an abstract type.
(Check_Private_Overriding): Implement Ada2012 checks on functions
declared in the private part, if an abstract type is involved.
* sem_ch12.adb (Analyze_Generic_Subprogram_Declaration): In Ada2012,
reject a generic function that returns an abstract type.
* exp_ch5.adb (Expand_Simple_Function_Return): in Ada2012, if a
function has a controlling access result, check that the tag of the
return value matches the designated type of the return expression.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165100 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/exp_ch5.adb')
| -rw-r--r-- | gcc/ada/exp_ch5.adb | 23 |
1 files changed, 23 insertions, 0 deletions
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 9c1c96cef00..647f08819f8 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -4246,6 +4246,29 @@ package body Exp_Ch5 is Scope_Depth (Enclosing_Dynamic_Scope (Scope_Id)))), Reason => PE_Accessibility_Check_Failed)); end; + + -- AI05-0073 : if function has a controlling access result, check that + -- the tag of the return value matches the designated type. + + elsif Ekind (R_Type) = E_Anonymous_Access_Type + and then Has_Controlling_Result (Scope_Id) + and then Ada_Version >= Ada_12 + then + Insert_Action (Exp, + 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)); end if; -- If we are returning an object that may not be bit-aligned, then copy |