From: Gary Dismukes Date: Mon, 17 Feb 2020 06:31:57 +0000 (-0500) Subject: [Ada] Implement predicate checks on qualified expressions (AI12-0100) X-Git-Tag: upstream/12.2.0~15907 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=24eda9e701253cc482c0c70a102fcad103aa1591;p=platform%2Fupstream%2Fgcc.git [Ada] Implement predicate checks on qualified expressions (AI12-0100) 2020-06-08 Gary Dismukes 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 --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 744c8a4..945c7d3 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 8d6ddd7..8631ded 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 d4a3ff8..2fab4bb 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 ba84e54..984a75f 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 83cd20d..0856c89 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