public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc(refs/users/marxin/heads/slp-function-v2)] [Ada] Assertion_Policy (Ignore) ignores invariants
@ 2020-06-11 9:55 Martin Liska
0 siblings, 0 replies; only message in thread
From: Martin Liska @ 2020-06-11 9:55 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:5620a9cd825f48f2ffa123de7c35a69f1dcd975f
commit 5620a9cd825f48f2ffa123de7c35a69f1dcd975f
Author: Bob Duff <duff@adacore.com>
Date: Thu Jan 30 14:45:19 2020 -0500
[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:
---
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.
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-06-11 9:55 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-06-11 9:55 [gcc(refs/users/marxin/heads/slp-function-v2)] [Ada] Assertion_Policy (Ignore) ignores invariants Martin Liska
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).