diff options
| author | Justin Squirek <squirek@adacore.com> | 2017-01-12 13:55:59 +0000 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2017-01-12 14:55:59 +0100 |
| commit | 00420f7430267c2df25b71edcb401e4df443ac01 (patch) | |
| tree | 29adc3bf91d500fb8bdbe3f98a57710b40cb5187 | |
| parent | 0691440320ef57149c7a4ac056696e558d215af4 (diff) | |
| download | gcc-00420f7430267c2df25b71edcb401e4df443ac01.zip gcc-00420f7430267c2df25b71edcb401e4df443ac01.tar.gz gcc-00420f7430267c2df25b71edcb401e4df443ac01.tar.bz2 | |
sem_prag.adb (Analyze_Pragma): Add appropriate calls to Resolve_Suppressible in the pragma Assertion_Policy case.
2017-01-12 Justin Squirek <squirek@adacore.com>
* sem_prag.adb (Analyze_Pragma): Add appropriate calls to
Resolve_Suppressible in the pragma Assertion_Policy case.
(Resolve_Suppressible): Created this function to factor out
common code used to resolve Suppress to either Ignore or Check
* snames.ads-tmpl: Add name for Suppressible.
From-SVN: r244362
| -rw-r--r-- | gcc/ada/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 46 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 1 |
3 files changed, 50 insertions, 5 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ce59afb..a7d230b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2017-01-12 Justin Squirek <squirek@adacore.com> + + * sem_prag.adb (Analyze_Pragma): Add appropriate calls to + Resolve_Suppressible in the pragma Assertion_Policy case. + (Resolve_Suppressible): Created this function to factor out + common code used to resolve Suppress to either Ignore or Check + * snames.ads-tmpl: Add name for Suppressible. + 2017-01-12 Gary Dismukes <dismukes@adacore.com> * exp_ch9.adb, s-secsta.adb, snames.ads-tmpl, exp_ch3.adb: Minor diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 031e00c..58dd3e8 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -11812,7 +11812,7 @@ package body Sem_Prag is -- identically named aspects and pragmas, depending on the specified -- policy identifier: - -- POLICY_IDENTIFIER ::= Check | Disable | Ignore + -- POLICY_IDENTIFIER ::= Check | Disable | Ignore | Suppressible -- Note: Check and Ignore are language-defined. Disable is a GNAT -- implementation-defined addition that results in totally ignoring @@ -11828,6 +11828,38 @@ package body Sem_Prag is -- processing is required here. when Pragma_Assertion_Policy => Assertion_Policy : declare + + procedure Resolve_Suppressible (Policy : Node_Id); + -- Converts the assertion policy 'Suppressible' to either Check or + -- ignore based on whether checks are suppressed via -gnatp or ??? + + -------------------------- + -- Resolve_Suppressible -- + -------------------------- + + procedure Resolve_Suppressible (Policy : Node_Id) is + Nam : Name_Id; + ARG : constant Node_Id := Get_Pragma_Arg (Policy); + + begin + if Chars (Expression (Policy)) = Name_Suppressible then + + -- Rewrite the policy argument node to either Ignore or + -- Check. This is done because the argument is referenced + -- directly later during analysis. + + if Suppress_Checks then + Nam := Name_Ignore; + else + Nam := Name_Check; + end if; + + Rewrite (ARG, Make_Identifier (Sloc (ARG), Nam)); + end if; + end Resolve_Suppressible; + + -- Local variables + Arg : Node_Id; Kind : Name_Id; LocP : Source_Ptr; @@ -11856,8 +11888,10 @@ package body Sem_Prag is and then (Nkind (Arg1) /= N_Pragma_Argument_Association or else Chars (Arg1) = No_Name) then - Check_Arg_Is_One_Of - (Arg1, Name_Check, Name_Disable, Name_Ignore); + Check_Arg_Is_One_Of (Arg1, + Name_Check, Name_Disable, Name_Ignore, Name_Suppressible); + + Resolve_Suppressible (Arg1); -- Treat one argument Assertion_Policy as equivalent to: @@ -11911,8 +11945,10 @@ package body Sem_Prag is ("invalid assertion kind for pragma%", Arg); end if; - Check_Arg_Is_One_Of - (Arg, Name_Check, Name_Disable, Name_Ignore); + Check_Arg_Is_One_Of (Arg, + Name_Check, Name_Disable, Name_Ignore, Name_Suppressible); + + Resolve_Suppressible (Arg); if Kind = Name_Ghost then diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index ebb7f68..5941beb 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -818,6 +818,7 @@ package Snames is Name_Strict : constant Name_Id := N + $; Name_Subunit_File_Name : constant Name_Id := N + $; Name_Suppressed : constant Name_Id := N + $; + Name_Suppressible : constant Name_Id := N + $; Name_Synchronous : constant Name_Id := N + $; Name_Task_Stack_Size_Default : constant Name_Id := N + $; Name_Task_Type : constant Name_Id := N + $; |