diff options
| author | Arnaud Charlet <charlet@gcc.gnu.org> | 2017-04-25 11:46:05 +0200 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2017-04-25 11:46:05 +0200 |
| commit | f2a54683c6700df37ba3c0c99d7142fae89d59b1 (patch) | |
| tree | 7727a03334efb8986c0dca51a91c3a5e9c4a17e4 /gcc/ada/exp_intr.adb | |
| parent | 2df23f66e28fe9b4c9d533a650c9d65e20b4b1ba (diff) | |
| download | gcc-f2a54683c6700df37ba3c0c99d7142fae89d59b1.zip gcc-f2a54683c6700df37ba3c0c99d7142fae89d59b1.tar.gz gcc-f2a54683c6700df37ba3c0c99d7142fae89d59b1.tar.bz2 | |
[multiple changes]
2017-04-25 Bob Duff <duff@adacore.com>
* sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings):
Use Source_Index (Current_Sem_Unit) to find the correct casing.
* exp_prag.adb (Expand_Pragma_Check): Use Source_Index
(Current_Sem_Unit) to find the correct casing.
* par.adb (Par): Null out Current_Source_File, to ensure that
the above bugs won't rear their ugly heads again.
2017-04-25 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Find_Type): For an attribute reference
'Class, if prefix type is synchronized and previous errors
have suppressed the creation of the corresponding record type,
create a spurious class-wide for the synchonized type itself,
to catch other misuses of the attribute
2017-04-25 Steve Baird <baird@adacore.com>
* exp_ch6.adb (Expand_Simple_Function_Return): if CodePeer_Mode
is True, then don't generate the accessibility check for the
tag of a tagged result.
* exp_intr.adb (Expand_Dispatching_Constructor_Call):
if CodePeer_Mode is True, then don't generate the
tag checks for the result of call to an instance of
Ada.Tags.Generic_Dispatching_Constructor (i.e., both the "is a
descendant of" check and the accessibility check).
2017-04-25 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb: Code cleanups.
* a-strbou.ads: minor whitespace fix in Trim for bounded strings.
* sem_ch8.ads: Minor comment fix.
From-SVN: r247168
Diffstat (limited to 'gcc/ada/exp_intr.adb')
| -rw-r--r-- | gcc/ada/exp_intr.adb | 31 |
1 files changed, 17 insertions, 14 deletions
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 4363c75..fde0617 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -421,20 +421,22 @@ package body Exp_Intr is Result_Typ := Class_Wide_Type (Etype (Act_Constr)); -- Check that the accessibility level of the tag is no deeper than that - -- of the constructor function. + -- of the constructor function (unless CodePeer_Mode) - Insert_Action (N, - Make_Implicit_If_Statement (N, - Condition => - Make_Op_Gt (Loc, - Left_Opnd => - Build_Get_Access_Level (Loc, New_Copy_Tree (Tag_Arg)), - Right_Opnd => - Make_Integer_Literal (Loc, Scope_Depth (Act_Constr))), - - Then_Statements => New_List ( - Make_Raise_Statement (Loc, - New_Occurrence_Of (RTE (RE_Tag_Error), Loc))))); + if not CodePeer_Mode then + Insert_Action (N, + Make_Implicit_If_Statement (N, + Condition => + Make_Op_Gt (Loc, + Left_Opnd => + Build_Get_Access_Level (Loc, New_Copy_Tree (Tag_Arg)), + Right_Opnd => + Make_Integer_Literal (Loc, Scope_Depth (Act_Constr))), + + Then_Statements => New_List ( + Make_Raise_Statement (Loc, + New_Occurrence_Of (RTE (RE_Tag_Error), Loc))))); + end if; if Is_Interface (Etype (Act_Constr)) then @@ -505,10 +507,11 @@ package body Exp_Intr is -- Do not generate a run-time check on the built object if tag -- checks are suppressed for the result type or tagged type expansion - -- is disabled. + -- is disabled or if CodePeer_Mode. if Tag_Checks_Suppressed (Etype (Result_Typ)) or else not Tagged_Type_Expansion + or else CodePeer_Mode then null; |