From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1851) id DC084389367A; Thu, 11 Jun 2020 09:55:11 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org DC084389367A DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1591869311; bh=g0c5+QnOVa/oL31p1xG/sgbH8vV/3JLVRxg9QKkaxpg=; h=From:To:Subject:Date:From; b=F+hefoI4fud+/u7/5uUec22XsQglsjpN2UGSZm8O5dfgoITOlGJhD4DlYnyghQNpP 4aLFymz4fNUBTfntROQAA6UKnfWtFXw1x7vDD5Z5+EnAvFILuAdwh4ULs8ilvnuKu+ e5alOfHcpoxZoEAZuhzDyHVpOBOE0H1HBpm6N3SY= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: Martin Liska To: gcc-cvs@gcc.gnu.org Subject: [gcc(refs/users/marxin/heads/slp-function-v2)] [Ada] Assertion_Policy (Ignore) ignores invariants X-Act-Checkin: gcc X-Git-Author: Bob Duff X-Git-Refname: refs/users/marxin/heads/slp-function-v2 X-Git-Oldrev: 6c8e70fe86da1b52160aa380f30cbb1bf644c407 X-Git-Newrev: 5620a9cd825f48f2ffa123de7c35a69f1dcd975f Message-Id: <20200611095511.DC084389367A@sourceware.org> Date: Thu, 11 Jun 2020 09:55:11 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 11 Jun 2020 09:55:12 -0000 https://gcc.gnu.org/g:5620a9cd825f48f2ffa123de7c35a69f1dcd975f commit 5620a9cd825f48f2ffa123de7c35a69f1dcd975f Author: Bob Duff Date: Thu Jan 30 14:45:19 2020 -0500 [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. Diff: --- 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.