diff options
| author | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-07-17 09:06:05 +0200 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-07-17 09:06:05 +0200 |
| commit | 6ccdd977051143e03a166c8994fd2519a0a7c5f0 (patch) | |
| tree | dd35b52cbac27c89ca657433aaa69fd67c3ae3ba /gcc/ada/sem_ch13.adb | |
| parent | d8941160a5f0af2e44cb349af43aed8c795b91ea (diff) | |
| download | gcc-6ccdd977051143e03a166c8994fd2519a0a7c5f0.zip gcc-6ccdd977051143e03a166c8994fd2519a0a7c5f0.tar.gz gcc-6ccdd977051143e03a166c8994fd2519a0a7c5f0.tar.bz2 | |
[multiple changes]
2014-07-17 Bob Duff <duff@adacore.com>
* gnat_ugn.texi: Improve documentation of Unrestricted_Access.
2014-07-17 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb (Build_Invariant_Procedure): Add variable Nam
(Add_Invariants): Set Nam to Name_Type_Invariant if from aspect.
2014-07-17 Thomas Quinot <quinot@adacore.com>
* exp_pakd.adb (Create_Packed_Array_Type.Install_PAT): For a
non-bit-packed array, propagate Reverse_Storage_Order to the
packed array type.
2014-07-17 Javier Miranda <miranda@adacore.com>
* exp_disp.adb: Fix comment.
* exp_pakd.adb: Minor reformatting.
From-SVN: r212736
Diffstat (limited to 'gcc/ada/sem_ch13.adb')
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 30 |
1 files changed, 24 insertions, 6 deletions
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 2381f5c..be28f94 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -6218,6 +6218,11 @@ package body Sem_Ch13 is PDecl : Node_Id; PBody : Node_Id; + Nam : Name_Id; + -- Name for Check pragma, usually Invariant, but might be Type_Invariant + -- if we come from a Type_Invariant aspect, we make sure to build the + -- Check pragma with the right name, so that Check_Policy works right. + Visible_Decls : constant List_Id := Visible_Declarations (N); Private_Decls : constant List_Id := Private_Declarations (N); @@ -6372,6 +6377,10 @@ package body Sem_Ch13 is -- Loop to find corresponding aspect, note that this -- must be present given the pragma is marked delayed. + -- Note: in practice Next_Rep_Item (Ritem) is Empty so + -- this loop does nothing. Furthermore, why isn't this + -- simply Corresponding_Aspect ??? + Aitem := Next_Rep_Item (Ritem); while Present (Aitem) loop if Nkind (Aitem) = N_Aspect_Specification @@ -6399,7 +6408,7 @@ package body Sem_Ch13 is -- analyze the original expression in the aspect specification -- because it is part of the original tree. - if ASIS_Mode then + if ASIS_Mode and then From_Aspect_Specification (Ritem) then declare Inv : constant Node_Id := Expression (Corresponding_Aspect (Ritem)); @@ -6409,13 +6418,22 @@ package body Sem_Ch13 is end; end if; + -- Get name to be used for Check pragma + + if not From_Aspect_Specification (Ritem) then + Nam := Name_Invariant; + else + Nam := Chars (Identifier (Corresponding_Aspect (Ritem))); + end if; + -- Build first two arguments for Check pragma - Assoc := New_List ( - Make_Pragma_Argument_Association (Loc, - Expression => Make_Identifier (Loc, Name_Invariant)), - Make_Pragma_Argument_Association (Loc, - Expression => Exp)); + Assoc := + New_List ( + Make_Pragma_Argument_Association (Loc, + Expression => Make_Identifier (Loc, Chars => Nam)), + Make_Pragma_Argument_Association (Loc, + Expression => Exp)); -- Add message if present in Invariant pragma |