From 6ef13c4ff90e51d13162fd8328d873ae03e6b2b4 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 11 Jul 2019 08:02:35 +0000 Subject: [PATCH] [Ada] Remove redundant predicate checks This patch removes redundant dynamic predicate checks generated by type conversions in various contexts. The patch also recognizes additional such checks that can be evaluated statically when applied to constant values. No simple test available. 2019-07-11 Ed Schonberg gcc/ada/ * exp_ch4.adb (Expand_N_Type_Conversion): If a predicate check is generated, analyze it with range check suppressed, because that check has been previously applied. * exp_ch5.adb (Expand_N_Assignment_Statement): If the RHS is a type conversion to the type of the LHS, do not apply a predicate check to the RHS because it will have been generated already during its expansion. * exp_ch6.adb (Can_Fold_Predicate_Call): Extend processing to handle a predicate check on a constant entity whose value is static. From-SVN: r273395 --- gcc/ada/ChangeLog | 13 +++++++++++++ gcc/ada/exp_ch4.adb | 7 +++++-- gcc/ada/exp_ch5.adb | 20 +++++++++++++------- gcc/ada/exp_ch6.adb | 29 ++++++++++++++++++++--------- 4 files changed, 51 insertions(+), 18 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index accc3eea959..0b4871c2d26 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2019-07-11 Ed Schonberg + + * exp_ch4.adb (Expand_N_Type_Conversion): If a predicate check + is generated, analyze it with range check suppressed, because + that check has been previously applied. + * exp_ch5.adb (Expand_N_Assignment_Statement): If the RHS is a + type conversion to the type of the LHS, do not apply a predicate + check to the RHS because it will have been generated already + during its expansion. + * exp_ch6.adb (Can_Fold_Predicate_Call): Extend processing to + handle a predicate check on a constant entity whose value is + static. + 2019-07-11 Hristian Kirtchev * bindo.adb: Remove the documentation of switch -d_N because it diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index f18632a55db..7a1e0b88325 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -12050,10 +12050,13 @@ package body Exp_Ch4 is begin -- Avoid infinite recursion on the subsequent expansion of - -- of the copy of the original type conversion. + -- of the copy of the original type conversion. When needed, + -- a range check has already been applied to the expression. Set_Comes_From_Source (New_Expr, False); - Insert_Action (N, Make_Predicate_Check (Target_Type, New_Expr)); + Insert_Action (N, + Make_Predicate_Check (Target_Type, New_Expr), + Suppress => Range_Check); end; end if; end Expand_N_Type_Conversion; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index f1d12cbb50b..18e9708cf7f 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -2021,15 +2021,21 @@ package body Exp_Ch5 is if not Suppress_Assignment_Checks (N) then - -- First deal with generation of range check if required + -- First deal with generation of range check if required, + -- and then predicate checks if the type carries a predicate. + -- If the Rhs is an expression these tests may have been applied + -- already. This is the case if the RHS is a type conversion. + -- Other such redundant checks could be removed ??? + + if Nkind (Rhs) /= N_Type_Conversion + or else Entity (Subtype_Mark (Rhs)) /= Typ + then + if Do_Range_Check (Rhs) then + Generate_Range_Check (Rhs, Typ, CE_Range_Check_Failed); + end if; - if Do_Range_Check (Rhs) then - Generate_Range_Check (Rhs, Typ, CE_Range_Check_Failed); + Apply_Predicate_Check (Rhs, Typ); end if; - - -- Then generate predicate check if required - - Apply_Predicate_Check (Rhs, Typ); end if; -- Check for a special case where a high level transformation is diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index c23e9eede69..f38dd671b6d 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2479,8 +2479,7 @@ package body Exp_Ch6 is ----------------------------- function Can_Fold_Predicate_Call (P : Entity_Id) return Boolean is - Actual : constant Node_Id := - First (Parameter_Associations (Call_Node)); + Actual : Node_Id; function May_Fold (N : Node_Id) return Traverse_Result; -- The predicate expression is foldable if it only contains operators @@ -2533,10 +2532,11 @@ package body Exp_Ch6 is function Try_Fold is new Traverse_Func (May_Fold); - -- Local variables + -- Other lLocal variables - Subt : constant Entity_Id := Etype (First_Entity (P)); - Pred : Node_Id; + Subt : constant Entity_Id := Etype (First_Entity (P)); + Aspect : Node_Id; + Pred : Node_Id; -- Start of processing for Can_Fold_Predicate_Call @@ -2545,8 +2545,21 @@ package body Exp_Ch6 is -- has a Dynamic_Predicate aspect. For CodePeer we preserve the -- function call. - if Nkind (Actual) /= N_Integer_Literal + Actual := First (Parameter_Associations (Call_Node)); + Aspect := Find_Aspect (Subt, Aspect_Dynamic_Predicate); + + -- If actual is a declared constant, retrieve its value + + if Is_Entity_Name (Actual) + and then Ekind (Entity (Actual)) = E_Constant + then + Actual := Constant_Value (Entity (Actual)); + end if; + + if No (Actual) + or else Nkind (Actual) /= N_Integer_Literal or else not Has_Dynamic_Predicate_Aspect (Subt) + or else No (Aspect) or else CodePeer_Mode then return False; @@ -2554,9 +2567,7 @@ package body Exp_Ch6 is -- Retrieve the analyzed expression for the predicate - Pred := - New_Copy_Tree - (Expression (Find_Aspect (Subt, Aspect_Dynamic_Predicate))); + Pred := New_Copy_Tree (Expression (Aspect)); if Try_Fold (Pred) = OK then Rewrite (Call_Node, Pred); -- 2.30.2