[Ada] Assertion_Policy (Ignore) ignores invariants

2020-06-05  Bob Duff  <duff@adacore.com>

gcc/ada/

	* einfo.adb, einfo.ads, exp_util.adb: Remove Invariants_Ignored
	flag.
	* sem_prag.adb (Invariant): Instead of setting a flag to be
	checked elsewhere, remove the pragma as soon as it is analyzed
	and checked for legality.

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 5c2b47bcffbf48b52c2a30b7742e15034b2cc445..45afabb17039a33a906ce33ca87385b3520ce954 100644 (file)
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -629,8 +629,8 @@ package body Einfo is
    --    Is_Activation_Record            Flag305
    --    Needs_Activation_Record         Flag306
    --    Is_Loop_Parameter               Flag307
-   --    Invariants_Ignored              Flag308
 
+   --    (unused)                        Flag308
    --    (unused)                        Flag309
 
    --  Note: Flag310-317 are defined in atree.ads/adb, but not yet in atree.h
@@ -2077,12 +2077,6 @@ package body Einfo is
       return Node21 (Id);
    end Interface_Name;
 
-   function Invariants_Ignored (Id : E) return B is
-   begin
-      pragma Assert (Is_Type (Id));
-      return Flag308 (Id);
-   end Invariants_Ignored;
-
    function Is_Abstract_Subprogram (Id : E) return B is
    begin
       pragma Assert (Is_Overloadable (Id));
@@ -5284,12 +5278,6 @@ package body Einfo is
       Set_Node21 (Id, V);
    end Set_Interface_Name;
 
-   procedure Set_Invariants_Ignored (Id : E; V : B := True) is
-   begin
-      pragma Assert (Is_Type (Id));
-      Set_Flag308 (Id, V);
-   end Set_Invariants_Ignored;
-
    procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True) is
    begin
       pragma Assert (Is_Overloadable (Id));
@@ -9797,7 +9785,6 @@ package body Einfo is
       W ("In_Package_Body",                 Flag48  (Id));
       W ("In_Private_Part",                 Flag45  (Id));
       W ("In_Use",                          Flag8   (Id));
-      W ("Invariants_Ignored",              Flag308 (Id));
       W ("Is_Abstract_Subprogram",          Flag19  (Id));
       W ("Is_Abstract_Type",                Flag146 (Id));
       W ("Is_Access_Constant",              Flag69  (Id));

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 810a112ca280791d8a78a58fb021787e6b993209..ae6d13fb7ea631b970597e2a245695d57bafd54f 100644 (file)
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2269,11 +2269,6 @@ package Einfo is
 --       implemented by a tagged type that are not already implemented by the
 --       ancestors (Ada 2005: AI-251).
 
---    Invariants_Ignored (Flag308)
---       Defined on all types. Indicates whether the type declaration is in
---       a context where Assertion_Policy is Ignore, in which case no checks
---       (static or dynamic) must be generated for objects of the type.
-
 --    Invariant_Procedure (synthesized)
 --       Defined in types and subtypes. Set for private types and their full
 --       views if one or more [class-wide] invariants apply to the type, or
@@ -7289,7 +7284,6 @@ package Einfo is
    function Interface_Alias                     (Id : E) return E;
    function Interface_Name                      (Id : E) return N;
    function Interfaces                          (Id : E) return L;
-   function Invariants_Ignored                  (Id : E) return B;
    function Is_Abstract_Subprogram              (Id : E) return B;
    function Is_Abstract_Type                    (Id : E) return B;
    function Is_Access_Constant                  (Id : E) return B;
@@ -7993,7 +7987,6 @@ package Einfo is
    procedure Set_Interface_Alias                 (Id : E; V : E);
    procedure Set_Interface_Name                  (Id : E; V : N);
    procedure Set_Interfaces                      (Id : E; V : L);
-   procedure Set_Invariants_Ignored              (Id : E; V : B := True);
    procedure Set_Is_Abstract_Subprogram          (Id : E; V : B := True);
    procedure Set_Is_Abstract_Type                (Id : E; V : B := True);
    procedure Set_Is_Access_Constant              (Id : E; V : B := True);
@@ -8826,7 +8819,6 @@ package Einfo is
    pragma Inline (Interface_Alias);
    pragma Inline (Interface_Name);
    pragma Inline (Interfaces);
-   pragma Inline (Invariants_Ignored);
    pragma Inline (Is_Abstract_Subprogram);
    pragma Inline (Is_Abstract_Type);
    pragma Inline (Is_Access_Constant);
@@ -9364,7 +9356,6 @@ package Einfo is
    pragma Inline (Set_Interface_Alias);
    pragma Inline (Set_Interface_Name);
    pragma Inline (Set_Interfaces);
-   pragma Inline (Set_Invariants_Ignored);
    pragma Inline (Set_Is_Abstract_Subprogram);
    pragma Inline (Set_Is_Abstract_Type);
    pragma Inline (Set_Is_Access_Constant);

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index af7a705251175c92b8ff77190c40a5cb1b6f8636..dd28a5b1e1f1f0d42aea526a3af422f04de3c8da 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -9331,16 +9331,10 @@ package body Exp_Util is
       Proc_Id := Invariant_Procedure (Typ);
       pragma Assert (Present (Proc_Id));
 
-      --  Ignore the invariant if that policy is in effect
-
-      if Invariants_Ignored (Typ) then
-         return Make_Null_Statement (Loc);
-      else
-         return
-           Make_Procedure_Call_Statement (Loc,
-             Name                   => New_Occurrence_Of (Proc_Id, Loc),
-             Parameter_Associations => New_List (Relocate_Node (Expr)));
-      end if;
+      return
+        Make_Procedure_Call_Statement (Loc,
+          Name                   => New_Occurrence_Of (Proc_Id, Loc),
+          Parameter_Associations => New_List (Relocate_Node (Expr)));
    end Make_Invariant_Call;
 
    ------------------------

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 0c42b53eebdcdeff6da790f3042774ddb042d9d5..419538d7c68ee5a829a94430b8fb66c5ac9c8b09 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -18316,6 +18316,20 @@ package body Sem_Prag is
                return;
             end if;
 
+            --  If invariants should be ignored, delete the pragma and then
+            --  return. We do this here, after checking for errors, and before
+            --  generating anything that has a run-time effect.
+
+            if Present (Check_Policy_List)
+              and then
+                (Policy_In_Effect (Name_Invariant) = Name_Ignore
+                   and then
+                 Policy_In_Effect (Name_Type_Invariant) = Name_Ignore)
+            then
+               Rewrite (N, Make_Null_Statement (Loc));
+               return;
+            end if;
+
             --  A pragma that applies to a Ghost entity becomes Ghost for the
             --  purposes of legality checks and removal of ignored Ghost code.
 
@@ -18326,15 +18340,6 @@ package body Sem_Prag is
 
             Set_Has_Own_Invariants (Typ);
 
-            --  Set the Invariants_Ignored flag if that policy is in effect
-
-            Set_Invariants_Ignored (Typ,
-              Present (Check_Policy_List)
-                and then
-                  (Policy_In_Effect (Name_Invariant) = Name_Ignore
-                     and then
-                   Policy_In_Effect (Name_Type_Invariant) = Name_Ignore));
-
             --  If the invariant is class-wide, then it can be inherited by
             --  derived or interface implementing types. The type is said to
             --  have "inheritable" invariants.