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
+            --  Static expression case
 
-            else pragma Assert (Nkind (N) = N_Identifier);
+            elsif Is_Static_Expression (N) then
+               SLo := Lo_Val (N);
+               SHi := Hi_Val (N);
 
-               --  Static expression case
+            --  Identifier (other than static expression) case
 
-               if Is_Static_Expression (N) then
-                  SLo := Lo_Val (N);
-                  SHi := Hi_Val (N);
+            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
-              ("subtype& has predicate, not allowed as index subtype",
-               Index, Etype (Index));
-         end if;
+         Bad_Predicated_Subtype_Use
+           ("subtype& has predicate, not allowed as index subtype",
+            Index, Etype (Index));
 
          --  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_ch9.adb

@@ -894,11 +894,9 @@ package body Sem_Ch9 is
 
          --  Check subtype with predicate in entry family
 
-         if Has_Predicates (Etype (D_Sdef)) then
-            Error_Msg_NE
-              ("subtype& has predicate, not allowed in entry family",
-               D_Sdef, Etype (D_Sdef));
-         end if;
+         Bad_Predicated_Subtype_Use
+           ("subtype& has predicate, not allowed in entry family",
+            D_Sdef, Etype (D_Sdef));
       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;