[multiple changes]

2012-10-01  Ed Schonberg  <schonberg@adacore.com>

	* checks.adb (Apply_Predicate_Check): If the predicate is a
	static one and the operand is static, evaluate the predicate at
	compile time.
	* sem_eval.ads, sem_eval.adb (Eval_Static_Predicate_Check): new
	procedure, to evaluate a static predicate check whenever possible.
	* sem_res.adb (Resolve_Type_Conversion): Apply predicate check
	on the conversion if the target type has predicates.

2012-10-01  Vincent Pucci  <pucci@adacore.com>

	* sem_dim.adb (Has_Symbols): Complain if parameter Symbol has been
	provided by the user in the dimension output call.

From-SVN: r191921

6 files changed, 124 insertions, 6 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 56d54d5..cfade45 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2012-10-01  Ed Schonberg  <schonberg@adacore.com>
+
+	* checks.adb (Apply_Predicate_Check): If the predicate is a
+	static one and the operand is static, evaluate the predicate at
+	compile time.
+	* sem_eval.ads, sem_eval.adb (Eval_Static_Predicate_Check): new
+	procedure, to evaluate a static predicate check whenever possible.
+	* sem_res.adb (Resolve_Type_Conversion): Apply predicate check
+	on the conversion if the target type has predicates.
+
+2012-10-01  Vincent Pucci  <pucci@adacore.com>
+
+	* sem_dim.adb (Has_Symbols): Complain if parameter Symbol has been
+	provided by the user in the dimension output call.
+
 2012-10-01  Robert Dewar  <dewar@adacore.com>
 
 	* checks.adb (Apply_Divide_Checks): New name for
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 3cbec96..12c2b6a 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -2337,6 +2337,23 @@ package body Checks is
                  (Sloc (N), Reason => SE_Infinite_Recursion));
 
          else
+
+            --  If the predicate is a static predicate and the operand is
+            --  static, the predicate must be evaluated statically. If the
+            --  evaluation fails this is a static constraint error.
+
+            if Is_OK_Static_Expression (N) then
+               if  Present (Static_Predicate (Typ)) then
+                  if Eval_Static_Predicate_Check (N, Typ) then
+                     return;
+                  else
+                     Error_Msg_NE
+                       ("static expression fails static predicate check on&",
+                          N, Typ);
+                  end if;
+               end if;
+            end if;
+
             Insert_Action (N,
               Make_Predicate_Check (Typ, Duplicate_Subexpr (N)));
          end if;
diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index d752607..4902ae3 100644
--- a/gcc/ada/sem_dim.adb
+++ b/gcc/ada/sem_dim.adb
@@ -2703,7 +2703,8 @@ package body Sem_Dim is
       -----------------
 
       function Has_Symbols return Boolean is
-         Actual : Node_Id;
+         Actual     : Node_Id;
+         Actual_Str : Node_Id;
 
       begin
          Actual := First (Actuals);
@@ -2711,16 +2712,49 @@ package body Sem_Dim is
          --  Look for a symbols parameter association in the list of actuals
 
          while Present (Actual) loop
-            if Nkind (Actual) = N_Parameter_Association
+            --  Positional parameter association case when the actual is a
+            --  string literal.
+
+            if Nkind (Actual) = N_String_Literal then
+               Actual_Str := Actual;
+
+            --  Named parameter association case when the selector name is
+            --  Symbol.
+
+            elsif Nkind (Actual) = N_Parameter_Association
               and then Chars (Selector_Name (Actual)) = Name_Symbol
             then
+               Actual_Str := Explicit_Actual_Parameter (Actual);
+
+            --  Ignore all other cases
+
+            else
+               Actual_Str := Empty;
+            end if;
+
+            if Present (Actual_Str) then
                --  Return True if the actual comes from source or if the string
                --  of symbols doesn't have the default value (i.e. it is "").
 
-               return Comes_From_Source (Actual)
-                 or else
-                   String_Length
-                     (Strval (Explicit_Actual_Parameter (Actual))) /= 0;
+               if Comes_From_Source (Actual)
+                 or else String_Length (Strval (Actual_Str)) /= 0
+               then
+                  --  Complain only if the actual comes from source or if it
+                  --  hasn't been fully analyzed yet.
+
+                  if Comes_From_Source (Actual)
+                    or else not Analyzed (Actual)
+                  then
+                     Error_Msg_N ("Symbol parameter should not be provided",
+                                  Actual);
+                     Error_Msg_N ("\reserved for compiler use only", Actual);
+                  end if;
+
+                  return True;
+
+               else
+                  return False;
+               end if;
             end if;
 
             Next (Actual);
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 888f3b2..933211a 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -3249,6 +3249,37 @@ package body Sem_Eval is
       end if;
    end Eval_Slice;
 
+   ---------------------------------
+   -- Eval_Static_Predicate_Check --
+   ---------------------------------
+
+   function Eval_Static_Predicate_Check
+     (N   : Node_Id;
+      Typ : Entity_Id) return Boolean
+   is
+      Loc  : constant Source_Ptr := Sloc (N);
+      Pred : constant List_Id := Static_Predicate (Typ);
+      Test : Node_Id;
+   begin
+      if No (Pred) then
+         return True;
+      end if;
+
+      --  The static predicate is a list of alternatives in the proper format
+      --  for an Ada 2012 membership test. If the argument is a literal, the
+      --  membership test can be evaluated statically. The caller transforms
+      --  a result of False into a static contraint error.
+
+      Test := Make_In (Loc,
+         Left_Opnd    => New_Copy_Tree (N),
+         Right_Opnd   => Empty,
+         Alternatives => Pred);
+      Analyze_And_Resolve (Test, Standard_Boolean);
+
+      return Nkind (Test) = N_Identifier
+        and then Entity (Test) = Standard_True;
+   end Eval_Static_Predicate_Check;
+
    -------------------------
    -- Eval_String_Literal --
    -------------------------
diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads
index a2f69fe..787e6d3 100644
--- a/gcc/ada/sem_eval.ads
+++ b/gcc/ada/sem_eval.ads
@@ -317,6 +317,11 @@ package Sem_Eval is
    procedure Eval_Unary_Op               (N : Node_Id);
    procedure Eval_Unchecked_Conversion   (N : Node_Id);
 
+   function Eval_Static_Predicate_Check
+     (N  : Node_Id;
+     Typ : Entity_Id) return Boolean;
+   --  Evaluate a static predicate check applied to a scalar literal.
+
    procedure Fold_Str (N : Node_Id; Val : String_Id; Static : Boolean);
    --  Rewrite N with a new N_String_Literal node as the result of the compile
    --  time evaluation of the node N. Val is the resulting string value from
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index ee25ef1..d2baee4 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -9713,6 +9713,22 @@ package body Sem_Res is
             end if;
          end;
       end if;
+
+      --  Ada 2012: if target type has predicates, the result requires a
+      --  predicate check. If the context is a call to another predicate
+      --  check we must prevent infinite recursion.
+
+      if Has_Predicates (Target_Typ) then
+         if Nkind (Parent (N)) = N_Function_Call
+           and then Present (Name (Parent (N)))
+           and then Has_Predicates (Entity (Name (Parent (N))))
+         then
+            null;
+
+         else
+            Apply_Predicate_Check (N, Target_Typ);
+         end if;
+      end if;
    end Resolve_Type_Conversion;
 
    ----------------------