[multiple changes]

2010-10-22  Ben Brosgol  <brosgol@adacore.com>

	* gnat_rm.texi: Add chapter on Ada 2012 support.

2010-10-22  Robert Dewar  <dewar@adacore.com>

	* sem_ch12.adb: Minor reformatting.

2010-10-22  Thomas Quinot  <quinot@adacore.com>

	* exp_dist.adb: Mark missing case of nested package when expanding
	stubs.

2010-10-22  Ed Schonberg  <schonberg@adacore.com>

	* par-ch10.adb: Discard incomplete with_clause.

2010-10-22  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Enable_Range_Check): Remove code suppressing range check
	if static predicate present, not needed.
	* exp_attr.adb (Expand_Pred_Succ): Check Suppress_Assignment_Checks flag
	* exp_ch3.adb (Expand_N_Object_Declaration): Check
	Suppress_Assignment_Checks flag.
	* exp_ch4.adb (Expand_N_In): Make some corrections for proper handling
	of ranges when predicates are present.
	* exp_ch5.adb (Expand_Predicated_Loop): New procedure
	(Expand_N_Assignment_Statement): Check Suppress_Assignment_Checks flag
	(Expand_N_Loop_Statement): Handle loops over predicated types
	* sem_case.adb (Analyze_Choices): Remove extra blank in error message.
	* sem_ch13.adb (Build_Predicate_Function.Add_Call): Suppress info
	message for inheritance if within a generic instance, not useful there!
	(Build_Static_Predicate): Optimize test in predicate function
	based on static ranges determined.
	* sem_ch5.adb (Analyze_Iteration_Scheme): Error for loop through
	subtype with non-static predicate.
	* sinfo.ads, sinfo.adb (Suppress_Assignment_Checks): New flag.

From-SVN: r165834

1 files changed, 53 insertions, 44 deletions

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 4450a1e..086e403 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4398,23 +4398,17 @@ package body Exp_Ch4 is
 
       procedure Substitute_Valid_Check is
       begin
-         --  Don't do this for type with predicates, since we don't care in
-         --  this case if it gets optimized away, the critical test is the
-         --  call to the predicate function
-
-         if not Has_Predicates (Ltyp) then
-            Rewrite (N,
-              Make_Attribute_Reference (Loc,
-                Prefix         => Relocate_Node (Lop),
-                Attribute_Name => Name_Valid));
+         Rewrite (N,
+           Make_Attribute_Reference (Loc,
+             Prefix         => Relocate_Node (Lop),
+             Attribute_Name => Name_Valid));
 
-            Analyze_And_Resolve (N, Restyp);
+         Analyze_And_Resolve (N, Restyp);
 
-            Error_Msg_N ("?explicit membership test may be optimized away", N);
-            Error_Msg_N -- CODEFIX
-              ("\?use ''Valid attribute instead", N);
-            return;
-         end if;
+         Error_Msg_N ("?explicit membership test may be optimized away", N);
+         Error_Msg_N -- CODEFIX
+           ("\?use ''Valid attribute instead", N);
+         return;
       end Substitute_Valid_Check;
 
    --  Start of processing for Expand_N_In
@@ -4437,7 +4431,9 @@ package body Exp_Ch4 is
       --  subtype. This is suspicious usage and we replace it with a 'Valid
       --  test and give a warning. For floating point types however, this is a
       --  standard way to check for finite numbers, and using 'Valid would
-      --  typically be a pessimization.
+      --  typically be a pessimization. Also skip this test for predicated
+      --  types, since it is perfectly reasonable to check if a value meets
+      --  its predicate.
 
       if Is_Scalar_Type (Ltyp)
         and then not Is_Floating_Point_Type (Ltyp)
@@ -4445,7 +4441,8 @@ package body Exp_Ch4 is
         and then Ltyp = Entity (Rop)
         and then Comes_From_Source (N)
         and then VM_Target = No_VM
-        and then No (Predicate_Function (Rtyp))
+        and then not (Is_Discrete_Type (Ltyp)
+                       and then Present (Predicate_Function (Ltyp)))
       then
          Substitute_Valid_Check;
          return;
@@ -4688,22 +4685,25 @@ package body Exp_Ch4 is
             --  type if they come from the original type definition. Also this
             --  way we get all the processing above for an explicit range.
 
-            --  Don't do this for a type with predicates, since we would lose
-            --  the predicate from this rewriting (test goes to base type).
+               --  Don't do this for predicated types, since in this case we
+               --  want to check the predicate!
 
-            elsif Is_Scalar_Type (Typ) and then not Has_Predicates (Typ) then
-               Rewrite (Rop,
-                 Make_Range (Loc,
-                   Low_Bound =>
-                     Make_Attribute_Reference (Loc,
-                       Attribute_Name => Name_First,
-                       Prefix => New_Reference_To (Typ, Loc)),
+            elsif Is_Scalar_Type (Typ) then
+               if No (Predicate_Function (Typ)) then
+                  Rewrite (Rop,
+                    Make_Range (Loc,
+                      Low_Bound =>
+                        Make_Attribute_Reference (Loc,
+                          Attribute_Name => Name_First,
+                          Prefix => New_Reference_To (Typ, Loc)),
+
+                      High_Bound =>
+                        Make_Attribute_Reference (Loc,
+                          Attribute_Name => Name_Last,
+                          Prefix => New_Reference_To (Typ, Loc))));
+                  Analyze_And_Resolve (N, Restyp);
+               end if;
 
-                   High_Bound =>
-                     Make_Attribute_Reference (Loc,
-                       Attribute_Name => Name_Last,
-                       Prefix => New_Reference_To (Typ, Loc))));
-               Analyze_And_Resolve (N, Restyp);
                goto Leave;
 
             --  Ada 2005 (AI-216): Program_Error is raised when evaluating
@@ -4843,24 +4843,33 @@ package body Exp_Ch4 is
 
    <<Leave>>
 
-      --  If a predicate is present, then we do the predicate test
+      --  If a predicate is present, then we do the predicate test, but we
+      --  most certainly want to omit this if we are within the predicate
+      --  function itself, since otherwise we have an infinite recursion!
 
-      if Present (Predicate_Function (Rtyp)) then
-         Rewrite (N,
-           Make_And_Then (Loc,
-             Left_Opnd  => Relocate_Node (N),
-             Right_Opnd => Make_Predicate_Call (Rtyp, Lop)));
+      declare
+         PFunc : constant Entity_Id := Predicate_Function (Rtyp);
 
-         --  Analyze new expression, mark left operand as analyzed to
-         --  avoid infinite recursion adding predicate calls.
+      begin
+         if Present (PFunc)
+           and then Current_Scope /= PFunc
+         then
+            Rewrite (N,
+              Make_And_Then (Loc,
+                Left_Opnd  => Relocate_Node (N),
+                Right_Opnd => Make_Predicate_Call (Rtyp, Lop)));
 
-         Set_Analyzed (Left_Opnd (N));
-         Analyze_And_Resolve (N, Standard_Boolean);
+            --  Analyze new expression, mark left operand as analyzed to
+            --  avoid infinite recursion adding predicate calls.
 
-         --  All done, skip attempt at compile time determination of result
+            Set_Analyzed (Left_Opnd (N));
+            Analyze_And_Resolve (N, Standard_Boolean);
 
-         return;
-      end if;
+            --  All done, skip attempt at compile time determination of result
+
+            return;
+         end if;
+      end;
    end Expand_N_In;
 
    --------------------------------