sem_prag.adb (Analyze_Pragma): Add appropriate calls to Resolve_Suppressible in the...

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ce59afba66b9a3334cf38b249dcf8e03d8ad05a4..a7d230b094cfdf6575855561075bee93080bf7fe 100644 (file)
--- 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 031e00cbe02ad616d301a0acb3d128149b514d78..58dd3e8079a92108458a8712034499a7b62e1f45 100644 (file)
--- 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 ebb7f680b76d3b995eedecddd4b086e3c417473b..5941beb3317cf4d93f272ed5ead7baa0f10aa3a9 100644 (file)
--- 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 + $;