From 5620a9cd825f48f2ffa123de7c35a69f1dcd975f Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 30 Jan 2020 14:45:19 -0500 Subject: [PATCH] [Ada] Assertion_Policy (Ignore) ignores invariants 2020-06-05 Bob Duff 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. --- gcc/ada/einfo.adb | 15 +-------------- gcc/ada/einfo.ads | 9 --------- gcc/ada/exp_util.adb | 14 ++++---------- gcc/ada/sem_prag.adb | 23 ++++++++++++++--------- 4 files changed, 19 insertions(+), 42 deletions(-) diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 5c2b47bcffb..45afabb1703 100644 --- 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 810a112ca28..ae6d13fb7ea 100644 --- 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 af7a7052511..dd28a5b1e1f 100644 --- 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 0c42b53eebd..419538d7c68 100644 --- 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. -- 2.30.2