[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

4 files changed, 51 insertions, 18 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index accc3ee..0b4871c 100644
--- 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 f18632a..7a1e0b8 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 f1d12cb..18e9708 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 c23e9ee..f38dd67 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);