[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  <schonberg@adacore.com>

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index accc3eea9592db5c84c828cfba87bda4e58eabd0..0b4871c2d26adeb6df759a27e488e0758675ca4d 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2019-07-11  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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  <kirtchev@adacore.com>
 
        * 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 f18632a55dbf4354370b9765b1563a44a0e32a59..7a1e0b88325566ec34c01b7ebd20f4b7ee3ca8ef 100644 (file)
--- 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 f1d12cbb50b7029986ec7d3017f3dd7b5996f542..18e9708cf7fc3934d5a5ccea302e3e93bd6a9c81 100644 (file)
--- 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 c23e9eede69a76e980f081b56dc447522cd7a4b3..f38dd671b6d9b13d5829ed681d5d7f363711614b 100644 (file)
--- 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);