public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc(refs/users/guojiufu/heads/guojiufu-branch)] [Ada] Implement predicate checks on qualified expressions (AI12-0100)
@ 2020-06-10 3:44 Jiu Fu Guo
0 siblings, 0 replies; only message in thread
From: Jiu Fu Guo @ 2020-06-10 3:44 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:24eda9e701253cc482c0c70a102fcad103aa1591
commit 24eda9e701253cc482c0c70a102fcad103aa1591
Author: Gary Dismukes <dismukes@adacore.com>
Date: Mon Feb 17 01:31:57 2020 -0500
[Ada] Implement predicate checks on qualified expressions (AI12-0100)
2020-06-08 Gary Dismukes <dismukes@adacore.com>
gcc/ada/
* checks.adb (Apply_Predicate_Check): Refine test for being in a
subprogram body to account for no Corresponding_Body case,
avoiding blowups arising due to other changes here.
* exp_ch4.adb (Expand_N_Qualified_Expression): Apply predicate
checks, if any, after constraint checks are applied.
* sem_eval.ads (Check_Expression_Against_Static_Predicate): Add
Check_Failure_Is_Error formal for conditionalizing warning vs.
error messages.
* sem_eval.adb (Check_Expression_Against_Static_Predicate):
Issue an error message rather than a warning when the new
Check_Failure_Is_Error formal is True. In the nonstatic or
Dynamic_Predicate case where the predicate is known to fail,
emit the check to ensure that folded cases get checks applied.
* sem_res.adb (Resolve_Qualified_Expression): Call
Check_Expression_Against_Static_Predicate, passing True for
Check_Failure_Is_Error, to ensure we reject static predicate
violations. Remove code that was conditionally calling
Apply_Predicate_Check, which is no longer needed, and that check
procedure shouldn't be called from a resolution routine in any
case. Also remove associated comment about preventing infinite
recursion and consistency with Resolve_Type_Conversion, since
that handling was already similarly removed from
Resolve_Type_Convesion at some point.
(Resolve_Type_Conversion): Add passing of True for
Check_Failure_Is_Error parameter on call to
Check_Expression_Against_Static_Predicate, to ensure that static
conversion cases that violate a predicate are rejected as
errors.
Diff:
---
gcc/ada/checks.adb | 8 +++++++-
gcc/ada/exp_ch4.adb | 4 ++++
gcc/ada/sem_eval.adb | 40 ++++++++++++++++++++++++++++++----------
gcc/ada/sem_eval.ads | 17 ++++++++++-------
gcc/ada/sem_res.adb | 32 ++++++++++----------------------
5 files changed, 61 insertions(+), 40 deletions(-)
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 744c8a41e33..945c7d30c6b 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -2789,7 +2789,13 @@ package body Checks is
begin
while Present (P) loop
if Nkind (P) = N_Subprogram_Body
- and then Corresponding_Spec (P) = Scope (Entity (N))
+ and then
+ ((Present (Corresponding_Spec (P))
+ and then
+ Corresponding_Spec (P) = Scope (Entity (N)))
+ or else
+ Defining_Unit_Name (Specification (P)) =
+ Scope (Entity (N)))
then
In_Body := True;
exit;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 8d6ddd7cd4c..8631ded4ea9 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -10424,6 +10424,10 @@ package body Exp_Ch4 is
Apply_Constraint_Check (Operand, Target_Type, No_Sliding => True);
+ -- Apply possible predicate check
+
+ Apply_Predicate_Check (Operand, Target_Type);
+
if Do_Range_Check (Operand) then
Generate_Range_Check (Operand, Target_Type, CE_Range_Check_Failed);
end if;
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index d4a3ff86e6a..2fab4bb9a6f 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -324,8 +324,9 @@ package body Sem_Eval is
-----------------------------------------------
procedure Check_Expression_Against_Static_Predicate
- (Expr : Node_Id;
- Typ : Entity_Id)
+ (Expr : Node_Id;
+ Typ : Entity_Id;
+ Static_Failure_Is_Error : Boolean := False)
is
begin
-- Nothing to do if expression is not known at compile time, or the
@@ -383,18 +384,28 @@ package body Sem_Eval is
-- Here we know that the predicate will fail
-- Special case of static expression failing a predicate (other than one
- -- that was explicitly specified with a Dynamic_Predicate aspect). This
- -- is the case where the expression is no longer considered static.
+ -- that was explicitly specified with a Dynamic_Predicate aspect). If
+ -- the expression comes from a qualified_expression or type_conversion
+ -- this is an error (Static_Failure_Is_Error); otherwise we only issue
+ -- a warning and the expression is no longer considered static.
if Is_Static_Expression (Expr)
and then not Has_Dynamic_Predicate_Aspect (Typ)
then
- Error_Msg_NE
- ("??static expression fails static predicate check on &",
- Expr, Typ);
- Error_Msg_N
- ("\??expression is no longer considered static", Expr);
- Set_Is_Static_Expression (Expr, False);
+ if Static_Failure_Is_Error then
+ Error_Msg_NE
+ ("static expression fails static predicate check on &",
+ Expr, Typ);
+
+ else
+ Error_Msg_NE
+ ("??static expression fails static predicate check on &",
+ Expr, Typ);
+ Error_Msg_N
+ ("\??expression is no longer considered static", Expr);
+
+ Set_Is_Static_Expression (Expr, False);
+ end if;
-- In all other cases, this is just a warning that a test will fail.
-- It does not matter if the expression is static or not, or if the
@@ -403,6 +414,15 @@ package body Sem_Eval is
else
Error_Msg_NE
("??expression fails predicate check on &", Expr, Typ);
+
+ -- Force a check here, which is potentially a redundant check, but
+ -- this ensures a check will be done in cases where the expression
+ -- is folded, and since this is definitely a failure, extra checks
+ -- are OK.
+
+ Insert_Action (Expr,
+ Make_Predicate_Check
+ (Typ, Duplicate_Subexpr (Expr)), Suppress => All_Checks);
end if;
end Check_Expression_Against_Static_Predicate;
diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads
index ba84e54868b..984a75f952d 100644
--- a/gcc/ada/sem_eval.ads
+++ b/gcc/ada/sem_eval.ads
@@ -125,15 +125,18 @@ package Sem_Eval is
-----------------
procedure Check_Expression_Against_Static_Predicate
- (Expr : Node_Id;
- Typ : Entity_Id);
+ (Expr : Node_Id;
+ Typ : Entity_Id;
+ Static_Failure_Is_Error : Boolean := False);
-- Determine whether an arbitrary expression satisfies the static predicate
-- of a type. The routine does nothing if Expr is not known at compile time
- -- or Typ lacks a static predicate, otherwise it may emit a warning if the
- -- expression is prohibited by the predicate. If the expression is a static
- -- expression and it fails a predicate that was not explicitly stated to be
- -- a dynamic predicate, then an additional warning is given, and the flag
- -- Is_Static_Expression is reset on Expr.
+ -- or Typ lacks a static predicate; otherwise it may emit a warning if the
+ -- expression is prohibited by the predicate, or if Static_Failure_Is_Error
+ -- is True then an error will be flagged. If the expression is a static
+ -- expression, it fails a predicate that was not explicitly stated to be
+ -- a dynamic predicate, and Static_Failure_Is_Error is False, then an
+ -- additional warning is given, and the flag Is_Static_Expression is reset
+ -- on Expr.
procedure Check_Non_Static_Context (N : Node_Id);
-- Deals with the special check required for a static expression that
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 83cd20d7d9a..0856c893562 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -10008,27 +10008,13 @@ package body Sem_Res is
Apply_Scalar_Range_Check (Expr, Typ);
end if;
- -- Finally, check whether a predicate applies to the target type. This
- -- comes from AI12-0100. As for type conversions, check the enclosing
- -- context to prevent an infinite expansion.
+ -- AI12-0100: Once the qualified expression is resolved, check whether
+ -- operand statisfies a static predicate of the target subtype, if any.
+ -- In the static expression case, a predicate check failure is an error.
if Has_Predicates (Target_Typ) then
- if Nkind (Parent (N)) = N_Function_Call
- and then Present (Name (Parent (N)))
- and then (Is_Predicate_Function (Entity (Name (Parent (N))))
- or else
- Is_Predicate_Function_M (Entity (Name (Parent (N)))))
- then
- null;
-
- -- In the case of a qualified expression in an allocator, the check
- -- is applied when expanding the allocator, so avoid redundant check.
-
- elsif Nkind (N) = N_Qualified_Expression
- and then Nkind (Parent (N)) /= N_Allocator
- then
- Apply_Predicate_Check (N, Target_Typ);
- end if;
+ Check_Expression_Against_Static_Predicate
+ (N, Target_Typ, Static_Failure_Is_Error => True);
end if;
end Resolve_Qualified_Expression;
@@ -11553,11 +11539,13 @@ package body Sem_Res is
end;
end if;
- -- Ada 2012: once the type conversion is resolved, check whether the
- -- operand statisfies the static predicate of the target type.
+ -- Ada 2012: Once the type conversion is resolved, check whether the
+ -- operand statisfies a static predicate of the target subtype, if any.
+ -- In the static expression case, a predicate check failure is an error.
if Has_Predicates (Target_Typ) then
- Check_Expression_Against_Static_Predicate (N, Target_Typ);
+ Check_Expression_Against_Static_Predicate
+ (N, Target_Typ, Static_Failure_Is_Error => True);
end if;
-- If at this stage we have a real to integer conversion, make sure that
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-06-10 3:44 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-06-10 3:44 [gcc(refs/users/guojiufu/heads/guojiufu-branch)] [Ada] Implement predicate checks on qualified expressions (AI12-0100) Jiu Fu Guo
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).