exp_prag.adb (Expand_Pragma_Check): Ignore pragma if Is_Ignored set.

2013-09-10  Robert Dewar  <dewar@adacore.com>

	* exp_prag.adb (Expand_Pragma_Check): Ignore pragma if Is_Ignored set.
	* sem_ch13.adb (Make_Aitem_Pragma): Set Is_Checked if needed.
	* sem_prag.adb (Check_Kind): Moved from spec (Analyze_Pragma):
	Make sure Is_Ignored/Is_Checked are set right (Analyze_Pragma,
	case Check): Ditto (Check_Applicable_Policy): Handle
	Statement_Assertion case Throughout, set and check the Is_Checked
	flag as appropriate.
	* sem_prag.ads (Check_Kind): Moved to body.
	* sinfo.ads, sinfo.adb (Is_Checked): New flag.

From-SVN: r202457

gcc/ada/ChangeLog

 2013-09-10  Robert Dewar  <dewar@adacore.com>
 
+	* exp_prag.adb (Expand_Pragma_Check): Ignore pragma if Is_Ignored set.
+	* sem_ch13.adb (Make_Aitem_Pragma): Set Is_Checked if needed.
+	* sem_prag.adb (Check_Kind): Moved from spec (Analyze_Pragma):
+	Make sure Is_Ignored/Is_Checked are set right (Analyze_Pragma,
+	case Check): Ditto (Check_Applicable_Policy): Handle
+	Statement_Assertion case Throughout, set and check the Is_Checked
+	flag as appropriate.
+	* sem_prag.ads (Check_Kind): Moved to body.
+	* sinfo.ads, sinfo.adb (Is_Checked): New flag.
+
+2013-09-10  Robert Dewar  <dewar@adacore.com>
+
 	* aspects.ads (Delay_Type): New type (Aspect_Delay): New table.
 	* einfo.adb (Has_Delayed_Rep_Aspects): New flag
 	(May_Inherit_Delayed_Rep_Aspects): New flag (Rep_Clause): Removed

gcc/ada/exp_prag.adb

@@ -287,10 +287,13 @@ package body Exp_Prag is
       Msg  : Node_Id;
 
    begin
-      --  We already know that this check is enabled, because otherwise the
-      --  semantic pass dealt with rewriting the assertion (see Sem_Prag)
+      --  Nothing to do if pragma is ignored
 
-      --  Since this check is enabled, we rewrite the pragma into a
+      if Is_Ignored (N) then
+         return;
+      end if;
+
+      --  Since this check is active, we rewrite the pragma into a
       --  corresponding if statement, and then analyze the statement
 
       --  The normal case expansion transforms:

gcc/ada/sem_ch13.adb

@@ -1377,6 +1377,8 @@ package body Sem_Ch13 is
 
                if Is_Ignored (Aspect) then
                   Set_Is_Ignored (Aitem);
+               elsif Is_Checked (Aspect) then
+                  Set_Is_Checked (Aspect);
                end if;
 
                Set_Corresponding_Aspect (Aitem, Aspect);

gcc/ada/sem_prag.ads

@@ -63,25 +63,6 @@ package Sem_Prag is
    --  expressions in the pragma as "spec expressions" (see section in Sem
    --  "Handling of Default and Per-Object Expressions...").
 
-   function Check_Kind (Nam : Name_Id) return Name_Id;
-   --  This function is used in connection with pragmas Assert, Check,
-   --  and assertion aspects and pragmas, to determine if Check pragmas
-   --  (or corresponding assertion aspects or pragmas) are currently active
-   --  as determined by the presence of -gnata on the command line (which
-   --  sets the default), and the appearance of pragmas Check_Policy and
-   --  Assertion_Policy as configuration pragmas either in a configuration
-   --  pragma file, or at the start of the current unit, or locally given
-   --  Check_Policy and Assertion_Policy pragmas that are currently active.
-   --
-   --  The value returned is one of the names Check, Ignore, Disable (On
-   --  returns Check, and Off returns Ignore).
-   --
-   --  Note: for assertion kinds Pre'Class, Post'Class, Invariant'Class,
-   --  and Type_Invariant'Class, the name passed is Name_uPre, Name_uPost,
-   --  Name_uInvariant, or Name_uType_Invariant, which corresponds to _Pre,
-   --  _Post, _Invariant, or _Type_Invariant, which are special names used
-   --  in identifiers to represent these attribute references.
-
    procedure Check_Applicable_Policy (N : Node_Id);
    --  N is either an N_Aspect or an N_Pragma node. There are two cases. If
    --  the name of the aspect or pragma is not one of those recognized as

gcc/ada/sinfo.adb

@@ -1732,6 +1732,15 @@ package body Sinfo is
       return Flag16 (N);
    end Is_Boolean_Aspect;
 
+   function Is_Checked
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Aspect_Specification
+        or else NT (N).Nkind = N_Pragma);
+      return Flag11 (N);
+   end Is_Checked;
+
    function Is_Component_Left_Opnd
       (N : Node_Id) return Boolean is
    begin
@@ -4840,6 +4849,15 @@ package body Sinfo is
       Set_Flag16 (N, Val);
    end Set_Is_Boolean_Aspect;
 
+   procedure Set_Is_Checked
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Aspect_Specification
+        or else NT (N).Nkind = N_Pragma);
+      Set_Flag11 (N, Val);
+   end Set_Is_Checked;
+
    procedure Set_Is_Component_Left_Opnd
       (N : Node_Id; Val : Boolean := True) is
    begin

gcc/ada/sinfo.ads

@@ -1269,6 +1269,15 @@ package Sinfo is
    --    Present in N_Aspect_Specification node. Set if the aspect is for a
    --    boolean aspect (i.e. Aspect_Id is in Boolean_Aspect subtype).
 
+   --  Is_Checked (Flag11-Sem)
+   --    Present in N_Aspect_Specification and N_Pragma nodes. Set for an
+   --    assertion aspect or pragma, or check pragma for an assertion, that
+   --    is to be checked at run - time. If either Is_Checked or Is_Ignored
+   --    is set (they cannot both be set), then this means that the status of
+   --    the pragma has been checked at the appropriate point and should not
+   --    be further modified (in some cases these flags are copied when a
+   --    pragma is rewritten).
+
    --  Is_Component_Left_Opnd  (Flag13-Sem)
    --  Is_Component_Right_Opnd (Flag14-Sem)
    --    Present in concatenation nodes, to indicate that the corresponding
@@ -2116,6 +2125,7 @@ package Sinfo is
       --  Is_Delayed_Aspect (Flag14-Sem)
       --  Is_Disabled (Flag15-Sem)
       --  Is_Ignored (Flag9-Sem)
+      --  Is_Checked (Flag11-Sem)
       --  Import_Interface_Present (Flag16-Sem)
       --  Split_PPC (Flag17) set if corresponding aspect had Split_PPC set
 
@@ -6763,6 +6773,7 @@ package Sinfo is
       --  Next_Rep_Item (Node5-Sem)
       --  Split_PPC (Flag17) Set if split pre/post attribute
       --  Is_Boolean_Aspect (Flag16-Sem)
+      --  Is_Checked (Flag11-Sem)
       --  Is_Delayed_Aspect (Flag14-Sem)
       --  Is_Disabled (Flag15-Sem)
       --  Is_Ignored (Flag9-Sem)
@@ -8725,6 +8736,9 @@ package Sinfo is
    function Is_Boolean_Aspect
      (N : Node_Id) return Boolean;    -- Flag16
 
+   function Is_Checked
+     (N : Node_Id) return Boolean;    -- Flag11
+
    function Is_Component_Left_Opnd
      (N : Node_Id) return Boolean;    -- Flag13
 
@@ -9715,6 +9729,9 @@ package Sinfo is
    procedure Set_Is_Boolean_Aspect
      (N : Node_Id; Val : Boolean := True);    -- Flag16
 
+   procedure Set_Is_Checked
+     (N : Node_Id; Val : Boolean := True);    -- Flag11
+
    procedure Set_Is_Component_Left_Opnd
      (N : Node_Id; Val : Boolean := True);    -- Flag13
 
@@ -12100,6 +12117,7 @@ package Sinfo is
    pragma Inline (Is_Accessibility_Actual);
    pragma Inline (Is_Asynchronous_Call_Block);
    pragma Inline (Is_Boolean_Aspect);
+   pragma Inline (Is_Checked);
    pragma Inline (Is_Component_Left_Opnd);
    pragma Inline (Is_Component_Right_Opnd);
    pragma Inline (Is_Controlling_Actual);
@@ -12425,6 +12443,7 @@ package Sinfo is
    pragma Inline (Set_Is_Accessibility_Actual);
    pragma Inline (Set_Is_Asynchronous_Call_Block);
    pragma Inline (Set_Is_Boolean_Aspect);
+   pragma Inline (Set_Is_Checked);
    pragma Inline (Set_Is_Component_Left_Opnd);
    pragma Inline (Set_Is_Component_Right_Opnd);
    pragma Inline (Set_Is_Controlling_Actual);