sem_case.adb, [...] (Bad_Predicated_Subtype_Use): Change order of parameters.

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

	* sem_case.adb, sem_attr.adb (Bad_Predicated_Subtype_Use): Change order
	of parameters.
	* sem_ch13.adb (Build_Predicate_Function): Don't give inheritance
	messages for generic actual subtypes.
	* sem_ch9.adb, sem_res.adb, sem_util.adb, sem_util.ads, sem_ch3.adb
	(Bad_Predicated_Subtype_Use): Use this procedure.

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

	* sem_ch5.adb: Minor reformatting.

From-SVN: r165829

gcc/ada/ChangeLog

 2010-10-22  Robert Dewar  <dewar@adacore.com>
 
+	* sem_case.adb, sem_attr.adb (Bad_Predicated_Subtype_Use): Change order
+	of parameters.
+	* sem_ch13.adb (Build_Predicate_Function): Don't give inheritance
+	messages for generic actual subtypes.
+	* sem_ch9.adb, sem_res.adb, sem_util.adb, sem_util.ads, sem_ch3.adb
+	(Bad_Predicated_Subtype_Use): Use this procedure.
+
+2010-10-22  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch5.adb: Minor reformatting.
+
+2010-10-22  Robert Dewar  <dewar@adacore.com>
+
 	* a-except-2005.adb (Rmsg_18): New message text.
 	* a-except.adb (Rmsg_18): New message text.
 	* atree.adb (List25): New function

gcc/ada/sem_attr.adb

@@ -842,7 +842,7 @@ package body Sem_Attr is
          if Comes_From_Source (N) then
             Error_Msg_Name_1 := Aname;
             Bad_Predicated_Subtype_Use
-              (P_Type, N, "type& has predicates, attribute % not allowed");
+              ("type& has predicates, attribute % not allowed", N, P_Type);
          end if;
       end Bad_Attribute_For_Predicate;
 

gcc/ada/sem_case.adb

@@ -866,9 +866,8 @@ package body Sem_Case is
                              or else No (Static_Predicate (E))
                            then
                               Bad_Predicated_Subtype_Use
-                                (E, N,
-                                 "cannot use subtype&  with non-static "
-                                 & "predicate as case alternative");
+                                ("cannot use subtype&  with non-static "
+                                 & "predicate as case alternative", N, E);
 
                               --  Static predicate case
 

gcc/ada/sem_ch13.adb

@@ -3888,9 +3888,13 @@ package body Sem_Ch13 is
                    Right_Opnd => Exp);
             end if;
 
-            --  Output info message on inheritance if required
+            --  Output info message on inheritance if required. Note we do not
+            --  give this information for generic actual types, since it is
+            --  unwelcome noise in that case in instantiations.
 
-            if Opt.List_Inherited_Aspects then
+            if Opt.List_Inherited_Aspects
+              and then not Is_Generic_Actual_Type (Typ)
+            then
                Error_Msg_Sloc := Sloc (Predicate_Function (T));
                Error_Msg_Node_2 := T;
                Error_Msg_N ("?info: & inherits predicate from & #", Typ);
@@ -4087,9 +4091,10 @@ package body Sem_Ch13 is
 
             function Hi_Val (N : Node_Id) return Uint is
             begin
-               if Nkind (N) = N_Identifier then
+               if Is_Static_Expression (N) then
                   return Expr_Value (N);
                else
+                  pragma Assert (Nkind (N) = N_Range);
                   return Expr_Value (High_Bound (N));
                end if;
             end Hi_Val;
@@ -4100,9 +4105,10 @@ package body Sem_Ch13 is
 
             function Lo_Val (N : Node_Id) return Uint is
             begin
-               if Nkind (N) = N_Identifier then
+               if Is_Static_Expression (N) then
                   return Expr_Value (N);
                else
+                  pragma Assert (Nkind (N) = N_Range);
                   return Expr_Value (Low_Bound (N));
                end if;
             end Lo_Val;
@@ -4124,19 +4130,19 @@ package body Sem_Ch13 is
                   SHi := Hi_Val (N);
                end if;
 
-            --  Identifier case
-
-            else pragma Assert (Nkind (N) = N_Identifier);
-
             --  Static expression case
 
-               if Is_Static_Expression (N) then
+            elsif Is_Static_Expression (N) then
                SLo := Lo_Val (N);
                SHi := Hi_Val (N);
 
+            --  Identifier (other than static expression) case
+
+            else pragma Assert (Nkind (N) = N_Identifier);
+
                --  Type case
 
-               elsif Is_Type (Entity (N)) then
+               if Is_Type (Entity (N)) then
 
                   --  If type has static predicates, process them recursively
 

gcc/ada/sem_ch3.adb

@@ -4429,11 +4429,9 @@ package body Sem_Ch3 is
 
          --  Check error of subtype with predicate for index type
 
-         if Has_Predicates (Etype (Index)) then
-            Error_Msg_NE
+         Bad_Predicated_Subtype_Use
            ("subtype& has predicate, not allowed as index subtype",
             Index, Etype (Index));
-         end if;
 
          --  Move to next index
 
@@ -11402,9 +11400,9 @@ package body Sem_Ch3 is
 
             --  Check error of subtype with predicate in index constraint
 
-            elsif Has_Predicates (Entity (S)) then
-               Error_Msg_NE
-                 ("subtype& has predicate, not allowed in index consraint",
+            else
+               Bad_Predicated_Subtype_Use
+                 ("subtype& has predicate, not allowed in index constraint",
                   S, Entity (S));
             end if;
 

gcc/ada/sem_ch5.adb

@@ -1734,8 +1734,10 @@ package body Sem_Ch5 is
 
       if No (N) then
          return;
+      end if;
+
+      --  Iteration scheme is present
 
-      else
       declare
          Cond : constant Node_Id := Condition (N);
 
@@ -1768,9 +1770,9 @@ package body Sem_Ch5 is
 
                Generate_Reference (Id, N, ' ');
 
-                  --  Check for case of loop variable hiding a local
-                  --  variable (used later on to give a nice warning
-                  --  if the hidden variable is never assigned).
+               --  Check for the case of loop variable hiding a local variable
+               --  (used later on to give a nice warning if the hidden variable
+               --  is never assigned).
 
                declare
                   H : constant Entity_Id := Homonym (Id);
@@ -1785,13 +1787,16 @@ package body Sem_Ch5 is
                   end if;
                end;
 
-                  --  Now analyze the subtype definition. If it is
-                  --  a range, create temporaries for bounds.
+               --  Now analyze the subtype definition. If it is a range, create
+               --  temporaries for bounds.
 
                if Nkind (DS) = N_Range
                  and then Expander_Active
                then
                   Process_Bounds (DS);
+
+               --  Not a range or expander not active (is that right???)
+
                else
                   Analyze (DS);
 
@@ -1868,10 +1873,9 @@ package body Sem_Ch5 is
                   end if;
                end;
 
-                  --  Check for null or possibly null range and issue warning.
-                  --  We suppress such messages in generic templates and
-                  --  instances, because in practice they tend to be dubious
-                  --  in these cases.
+               --  Check for null or possibly null range and issue warning. We
+               --  suppress such messages in generic templates and instances,
+               --  because in practice they tend to be dubious in these cases.
 
                if Nkind (DS) = N_Range and then Comes_From_Source (N) then
                   declare
@@ -1884,10 +1888,10 @@ package body Sem_Ch5 is
                      if Compile_Time_Compare
                           (L, H, Assume_Valid => True) = GT
                      then
-                           --  Suppress the warning if inside a generic
-                           --  template or instance, since in practice they
-                           --  tend to be dubious in these cases since they can
-                           --  result from intended parametrization.
+                        --  Suppress the warning if inside a generic template
+                        --  or instance, since in practice they tend to be
+                        --  dubious in these cases since they can result from
+                        --  intended parametrization.
 
                         if not Inside_A_Generic
                           and then not In_Instance
@@ -1899,8 +1903,7 @@ package body Sem_Ch5 is
                                 (L, H, Assume_Valid => False) = GT
                            then
                               Error_Msg_N
-                                   ("?loop range is null, "
-                                    & "loop will not execute",
+                                ("?loop range is null, loop will not execute",
                                  DS);
 
                               --  Since we know the range of the loop is
@@ -1959,7 +1962,6 @@ package body Sem_Ch5 is
             end;
          end if;
       end;
-      end if;
    end Analyze_Iteration_Scheme;
 
    -------------------------------------

gcc/ada/sem_ch9.adb

@@ -894,12 +894,10 @@ package body Sem_Ch9 is
 
          --  Check subtype with predicate in entry family
 
-         if Has_Predicates (Etype (D_Sdef)) then
-            Error_Msg_NE
+         Bad_Predicated_Subtype_Use
            ("subtype& has predicate, not allowed in entry family",
             D_Sdef, Etype (D_Sdef));
       end if;
-      end if;
 
       --  Decorate Def_Id
 

gcc/ada/sem_res.adb

@@ -8481,7 +8481,7 @@ package body Sem_Res is
       --  Check bad use of type with predicates
 
       if Has_Predicates (Etype (Drange)) then
-         Error_Msg_NE
+         Bad_Predicated_Subtype_Use
            ("subtype& has predicate, not allowed in slice",
             Drange, Etype (Drange));
 

gcc/ada/sem_util.adb

@@ -334,21 +334,21 @@ package body Sem_Util is
    --------------------------------
 
    procedure Bad_Predicated_Subtype_Use
-     (Typ : Entity_Id;
+     (Msg : String;
       N   : Node_Id;
-      Msg : String)
+      Typ : Entity_Id)
    is
    begin
       if Has_Predicates (Typ) then
          if Is_Generic_Actual_Type (Typ) then
-            Error_Msg_F (Msg & '?', Typ);
-            Error_Msg_F ("\Program_Error will be raised at run time?", Typ);
+            Error_Msg_FE (Msg & '?', N, Typ);
+            Error_Msg_F ("\Program_Error will be raised at run time?", N);
             Insert_Action (N,
               Make_Raise_Program_Error (Sloc (N),
                 Reason => PE_Bad_Predicated_Generic_Type));
 
          else
-            Error_Msg_F (Msg, Typ);
+            Error_Msg_FE (Msg, N, Typ);
          end if;
       end if;
    end Bad_Predicated_Subtype_Use;

gcc/ada/sem_util.ads

@@ -94,18 +94,19 @@ package Sem_Util is
    --  whether an error or warning is given.
 
    procedure Bad_Predicated_Subtype_Use
-     (Typ : Entity_Id;
+     (Msg : String;
       N   : Node_Id;
-      Msg : String);
+      Typ : Entity_Id);
    --  This is called when Typ, a predicated subtype, is used in a context
-   --  which does not allow the use of a predicated subtype. Msg will be
-   --  passed to Error_Msg_F to output an appropriate message. The caller
-   --  should set up any insertions other than the & for the type itself.
-   --  Note that if Typ is a generic actual type, then the message will be
-   --  output as a warning, and a raise Program_Error is inserted using
-   --  Insert_Action with node N as the insertion point. Node N also supplies
-   --  the source location for construction of the raise node. If Typ is NOT a
-   --  type with predicates this call has no effect.
+   --  which does not allow the use of a predicated subtype. Msg is passed
+   --  to Error_Msg_FE to output an appropriate message using N as the
+   --  location, and Typ as the entity. The caller must set up any insertions
+   --  other than the & for the type itself. Note that if Typ is a generic
+   --  actual type, then the message will be output as a warning, and a
+   --  raise Program_Error is inserted using Insert_Action with node N as
+   --  the insertion point. Node N also supplies the source location for
+   --  construction of the raise node. If Typ is NOT a type with predicates
+   --  this call has no effect.
 
    function Build_Actual_Subtype
      (T : Entity_Id;