[multiple changes]

2016-04-18  Hristian Kirtchev  <kirtchev@adacore.com>

	* namet.adb, namet.ads, exp_unst.adb: Minor reformatting.

2016-04-18  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_eval.adb (Choice_Matches): Check the expression
	against the predicate values when the choice denotes a
	subtype with a static predicate.
	(Eval_Membership_Op): Code cleanup. Remove the suspicious guard which
	tests for predicates.
	(Is_OK_Static_Subtype): A subtype with a dynamic predicate
	is not static.	(Is_Static_Subtype): A subtype with a dynamic
	predicate is not static.
	* sem_eval.ads (Is_OK_Static_Subtype): Update the comment on usage.
	(Is_Static_Subtype): Update the comment on usage.

2016-04-18  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Input_Item): Allow
	generic formals to appear as initialization items.

2016-04-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_Stream_TSS_Definition,
	Has_Good_Profile): Additional error message to indicate that
	the second parameter of the subprogram must be a first subtype.

2016-04-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper, Is_Inline_Pragma):
	Use the pragma lookahead that determines whether a subprogram
	is to be inlined, when some level of backend optimization is
	required.
	* sem_ch12.ads, sem_ch12.adb (Add_Pending_Instantiation): Factorize
	code used to create an instance body when needed for inlining.
	* exp_ch6.adb (Expand_Call): When a call is to be inlined, and the
	call appears within an instantiation that is not a compilation
	unit, add a pending instantiation for the enclosing instance,
	so the backend can inline in turn the calls contained in the
	inlined body.

From-SVN: r235124

12 files changed, 347 insertions, 233 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 96cac54..143a6a1 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,45 @@
+2016-04-18  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* namet.adb, namet.ads, exp_unst.adb: Minor reformatting.
+
+2016-04-18  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_eval.adb (Choice_Matches): Check the expression
+	against the predicate values when the choice denotes a
+	subtype with a static predicate.
+	(Eval_Membership_Op): Code cleanup. Remove the suspicious guard which
+	tests for predicates.
+	(Is_OK_Static_Subtype): A subtype with a dynamic predicate
+	is not static.	(Is_Static_Subtype): A subtype with a dynamic
+	predicate is not static.
+	* sem_eval.ads (Is_OK_Static_Subtype): Update the comment on usage.
+	(Is_Static_Subtype): Update the comment on usage.
+
+2016-04-18  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Analyze_Input_Item): Allow
+	generic formals to appear as initialization items.
+
+2016-04-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Analyze_Stream_TSS_Definition,
+	Has_Good_Profile): Additional error message to indicate that
+	the second parameter of the subprogram must be a first subtype.
+
+2016-04-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Analyze_Subprogram_Body_Helper, Is_Inline_Pragma):
+	Use the pragma lookahead that determines whether a subprogram
+	is to be inlined, when some level of backend optimization is
+	required.
+	* sem_ch12.ads, sem_ch12.adb (Add_Pending_Instantiation): Factorize
+	code used to create an instance body when needed for inlining.
+	* exp_ch6.adb (Expand_Call): When a call is to be inlined, and the
+	call appears within an instantiation that is not a compilation
+	unit, add a pending instantiation for the enclosing instance,
+	so the backend can inline in turn the calls contained in the
+	inlined body.
+
 2016-04-18  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_prag.adb (Build_Pragma_Check_Equivalent): The mapping
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index bdde498..a72bbe1 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -59,6 +59,7 @@ with Sem;       use Sem;
 with Sem_Aux;   use Sem_Aux;
 with Sem_Ch6;   use Sem_Ch6;
 with Sem_Ch8;   use Sem_Ch8;
+with Sem_Ch12;  use Sem_Ch12;
 with Sem_Ch13;  use Sem_Ch13;
 with Sem_Dim;   use Sem_Dim;
 with Sem_Disp;  use Sem_Disp;
@@ -3898,6 +3899,50 @@ package body Exp_Ch6 is
          then
             Add_Inlined_Body (Subp, Call_Node);
 
+            --  If the inlined call appears within an instantiation and some
+            --  level of optimization is required, ensure that the enclosing
+            --  instance body is available so that the back-end can actually
+            --  perform the inlining.
+
+            if In_Instance
+               and then Comes_From_Source (Subp)
+               and then Optimization_Level > 0
+            then
+               declare
+                  Inst : Entity_Id;
+                  Decl : Node_Id;
+
+               begin
+                  Inst := Scope (Subp);
+
+                  --  Find enclosing instance.
+
+                  while Present (Inst) and then Inst /= Standard_Standard loop
+                     exit when Is_Generic_Instance (Inst);
+                     Inst := Scope (Inst);
+                  end loop;
+
+                  if Present (Inst) and then Is_Generic_Instance (Inst) then
+                     Set_Is_Inlined (Inst);
+                     Decl := Unit_Declaration_Node (Inst);
+
+                     --  Do not add a pending instantiation if the body exits
+                     --  already, or if the instance is a compilation unit, or
+                     --  the instance node is missing.
+
+                     if Present (Corresponding_Body (Decl))
+                       or else Nkind (Parent (Decl)) = N_Compilation_Unit
+                       or else No (Next (Decl))
+                     then
+                        null;
+
+                     else
+                        Add_Pending_Instantiation (Next (Decl), Decl);
+                     end if;
+                  end if;
+               end;
+            end if;
+
          --  Front end expansion of simple functions returning unconstrained
          --  types (see Check_And_Split_Unconstrained_Function). Note that the
          --  case of a simple renaming (Body_To_Inline in N_Entity above, see
diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index fbc6a7b..eed26e6 100644
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -243,9 +243,10 @@ package body Exp_Unst is
          loop
             if No (C) then
                return Chars (Ent);
+
             elsif Chars (Defining_Identifier (C)) = Chars (Ent) then
-               return Name_Find
-                        (Get_Name_String (Chars (Ent)) & Img_Pos (Index));
+               return
+                 Name_Find (Get_Name_String (Chars (Ent)) & Img_Pos (Index));
             else
                Next (C);
             end if;
diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb
index 20359f6..4ba68df 100644
--- a/gcc/ada/namet.adb
+++ b/gcc/ada/namet.adb
@@ -140,6 +140,7 @@ package body Namet is
    procedure Append (Buf : in out Bounded_String; Id : Name_Id) is
       pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
       S : constant Int := Name_Entries.Table (Id).Name_Chars_Index;
+
    begin
       for J in 1 .. Natural (Name_Entries.Table (Id).Name_Len) loop
          Append (Buf, Name_Chars.Table (S + Int (J)));
@@ -420,7 +421,9 @@ package body Namet is
    ----------------------------------
 
    procedure Append_Decoded_With_Brackets
-     (Buf : in out Bounded_String; Id : Name_Id) is
+     (Buf : in out Bounded_String;
+      Id  : Name_Id)
+   is
       P : Natural;
 
    begin
@@ -560,8 +563,7 @@ package body Namet is
    -- Append_Unqualified --
    ------------------------
 
-   procedure Append_Unqualified
-     (Buf : in out Bounded_String; Id : Name_Id) is
+   procedure Append_Unqualified (Buf : in out Bounded_String; Id : Name_Id) is
    begin
       Append (Buf, Id);
       Strip_Qualification_And_Suffixes (Buf);
@@ -572,7 +574,9 @@ package body Namet is
    --------------------------------
 
    procedure Append_Unqualified_Decoded
-     (Buf : in out Bounded_String; Id : Name_Id) is
+     (Buf : in out Bounded_String;
+      Id  : Name_Id)
+   is
    begin
       Append_Decoded (Buf, Id);
       Strip_Qualification_And_Suffixes (Buf);
@@ -908,8 +912,12 @@ package body Namet is
    ----------------
 
    procedure Insert_Str
-     (Buf : in out Bounded_String; S : String; Index : Positive) is
+     (Buf   : in out Bounded_String;
+      S     : String;
+      Index : Positive)
+   is
       SL : constant Natural := S'Length;
+
    begin
       Buf.Chars (Index + SL .. Buf.Length + SL) :=
         Buf.Chars (Index .. Buf.Length);
@@ -1468,7 +1476,9 @@ package body Namet is
    --------------------------------
 
    procedure Set_Character_Literal_Name
-     (Buf : in out Bounded_String; C : Char_Code) is
+     (Buf : in out Bounded_String;
+      C   : Char_Code)
+   is
    begin
       Buf.Length := 0;
       Append (Buf, 'Q');
diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads
index 873897f..1d00ee0c 100644
--- a/gcc/ada/namet.ads
+++ b/gcc/ada/namet.ads
@@ -152,10 +152,10 @@ package Namet is
    type Bounded_String (Max_Length : Natural := 4 * Max_Line_Length) is limited
    --  The default here is intended to be an infinite value that ensures that
    --  we never overflow the buffer (names this long are too absurd to worry).
-      record
-         Length : Natural := 0;
-         Chars  : String (1 .. Max_Length);
-      end record;
+   record
+      Length : Natural := 0;
+      Chars  : String (1 .. Max_Length);
+   end record;
 
    --  To create a Name_Id, you can declare a Bounded_String as a local
    --  variable, and Append things onto it, and finally call Name_Find.
@@ -167,8 +167,8 @@ package Namet is
    --  to avoid the global.
 
    Global_Name_Buffer : Bounded_String;
-   Name_Buffer : String renames Global_Name_Buffer.Chars;
-   Name_Len : Natural renames Global_Name_Buffer.Length;
+   Name_Buffer        : String renames Global_Name_Buffer.Chars;
+   Name_Len           : Natural renames Global_Name_Buffer.Length;
 
    --  Note that there is some circuitry (e.g. Osint.Write_Program_Name) that
    --  does a save/restore on Name_Len and Name_Buffer (1 .. Name_Len). This
@@ -373,7 +373,8 @@ package Namet is
    --  apostrophes.
 
    procedure Append_Decoded_With_Brackets
-     (Buf : in out Bounded_String; Id : Name_Id);
+     (Buf : in out Bounded_String;
+      Id  : Name_Id);
    --  Same as Append_Decoded, except that the brackets notation (Uhh
    --  replaced by ["hh"], Whhhh replaced by ["hhhh"], WWhhhhhhhh replaced by
    --  ["hhhhhhhh"]) is used for all non-lower half characters, regardless of
@@ -383,8 +384,7 @@ package Namet is
    --  requirement for a canonical representation not affected by the
    --  character set options (e.g. in the binder generation of symbols).
 
-   procedure Append_Unqualified
-     (Buf : in out Bounded_String; Id : Name_Id);
+   procedure Append_Unqualified (Buf : in out Bounded_String; Id : Name_Id);
    --  Same as Append, except that qualification (as defined in unit
    --  Exp_Dbug) is removed (including both preceding __ delimited names, and
    --  also the suffixes used to indicate package body entities and to
@@ -395,7 +395,8 @@ package Namet is
    --  after gigi has been called.
 
    procedure Append_Unqualified_Decoded
-     (Buf : in out Bounded_String; Id : Name_Id);
+     (Buf : in out Bounded_String;
+      Id  : Name_Id);
    --  Same as Append_Unqualified, but decoded as for Append_Decoded
 
    procedure Append_Encoded (Buf : in out Bounded_String; C : Char_Code);
@@ -408,12 +409,15 @@ package Namet is
    --  are stored using the Uhh encoding).
 
    procedure Set_Character_Literal_Name
-     (Buf : in out Bounded_String; C : Char_Code);
+     (Buf : in out Bounded_String;
+      C   : Char_Code);
    --  This procedure sets the proper encoded name for the character literal
    --  for the given character code.
 
    procedure Insert_Str
-     (Buf : in out Bounded_String; S : String; Index : Positive);
+     (Buf   : in out Bounded_String;
+      S     : String;
+      Index : Positive);
    --  Inserts S in Buf, starting at Index. Any existing characters at or past
    --  this location get moved beyond the inserted string.
 
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index b6256e1..5508c9b 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -1027,6 +1027,31 @@ package body Sem_Ch12 is
       raise Instantiation_Error;
    end Abandon_Instantiation;
 
+   --------------------------------
+   --  Add_Pending_Instantiation --
+   --------------------------------
+
+   procedure Add_Pending_Instantiation (Inst : Node_Id; Act_Decl : Node_Id) is
+   begin
+
+      --  Add to the instantiation node and the corresponding unit declaration
+      --  the current values of global flags to be used when analyzing the
+      --  instance body.
+
+      Pending_Instantiations.Append
+        ((Inst_Node                => Inst,
+          Act_Decl                 => Act_Decl,
+          Expander_Status          => Expander_Active,
+          Current_Sem_Unit         => Current_Sem_Unit,
+          Scope_Suppress           => Scope_Suppress,
+          Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
+          Version                  => Ada_Version,
+          Version_Pragma           => Ada_Version_Pragma,
+          Warnings                 => Save_Warnings,
+          SPARK_Mode               => SPARK_Mode,
+          SPARK_Mode_Pragma        => SPARK_Mode_Pragma));
+   end Add_Pending_Instantiation;
+
    --------------------------
    -- Analyze_Associations --
    --------------------------
@@ -4138,18 +4163,7 @@ package body Sem_Ch12 is
 
                --  Make entry in table
 
-               Pending_Instantiations.Append
-                 ((Inst_Node                => N,
-                   Act_Decl                 => Act_Decl,
-                   Expander_Status          => Expander_Active,
-                   Current_Sem_Unit         => Current_Sem_Unit,
-                   Scope_Suppress           => Scope_Suppress,
-                   Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
-                   Version                  => Ada_Version,
-                   Version_Pragma           => Ada_Version_Pragma,
-                   Warnings                 => Save_Warnings,
-                   SPARK_Mode               => SPARK_Mode,
-                   SPARK_Mode_Pragma        => SPARK_Mode_Pragma));
+               Add_Pending_Instantiation (N, Act_Decl);
             end if;
          end if;
 
@@ -4745,18 +4759,7 @@ package body Sem_Ch12 is
 
         and then not Is_Eliminated (Subp)
       then
-         Pending_Instantiations.Append
-           ((Inst_Node                => N,
-             Act_Decl                 => Unit_Declaration_Node (Subp),
-             Expander_Status          => Expander_Active,
-             Current_Sem_Unit         => Current_Sem_Unit,
-             Scope_Suppress           => Scope_Suppress,
-             Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
-             Version                  => Ada_Version,
-             Version_Pragma           => Ada_Version_Pragma,
-             Warnings                 => Save_Warnings,
-             SPARK_Mode               => SPARK_Mode,
-             SPARK_Mode_Pragma        => SPARK_Mode_Pragma));
+         Add_Pending_Instantiation (N, Unit_Declaration_Node (Subp));
          return True;
 
       --  Here if not inlined, or we ignore the inlining
diff --git a/gcc/ada/sem_ch12.ads b/gcc/ada/sem_ch12.ads
index faf8917..c95396a 100644
--- a/gcc/ada/sem_ch12.ads
+++ b/gcc/ada/sem_ch12.ads
@@ -37,6 +37,10 @@ package Sem_Ch12 is
    procedure Analyze_Formal_Subprogram_Declaration      (N : Node_Id);
    procedure Analyze_Formal_Package_Declaration         (N : Node_Id);
 
+   procedure Add_Pending_Instantiation (Inst : Node_Id; Act_Decl : Node_Id);
+   --  Add an entry in the table of instance bodies that must be analyzed
+   --  when inlining requires its body or the body of a nested instance.
+
    function Build_Function_Wrapper
      (Formal_Subp : Entity_Id;
       Actual_Subp : Entity_Id) return Node_Id;
@@ -113,12 +117,12 @@ package Sem_Ch12 is
    --  of G, we compile the body of I2, but not that of I1. However, when we
    --  compile U as the main unit, we compile both bodies. This will lead to
    --  link-time errors if the compilation of I1 generates public symbols,
-   --  because those in I2 will receive different names in both cases.
-   --  This forces us to analyze the body of I1 even when U is not the main
-   --  unit. We don't want this additional mechanism to generate an error
-   --  when the body of the generic for I1 is not present, and this is the
-   --  reason for the presence of the flag Body_Optional, which is exchanged
-   --  between the current procedure and Load_Parent_Of_Generic.
+   --  because those in I2 will receive different names in both cases. This
+   --  forces us to analyze the body of I1 even when U is not the main unit.
+   --  We don't want this additional mechanism to generate an error when the
+   --  body of the generic for I1 is not present, and this is the reason for
+   --  the presence of the flag Body_Optional, which is exchanged between the
+   --  current procedure and Load_Parent_Of_Generic.
 
    procedure Instantiate_Subprogram_Body
      (Body_Info     : Pending_Body_Info;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 688861e..cb7eb8f 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -3754,15 +3754,21 @@ package body Sem_Ch13 is
          Is_Read : constant Boolean := (TSS_Nam = TSS_Stream_Read);
          --  True for Read attribute, false for other attributes
 
-         function Has_Good_Profile (Subp : Entity_Id) return Boolean;
+         function Has_Good_Profile
+           (Subp   : Entity_Id;
+            Report : Boolean := False) return Boolean;
          --  Return true if the entity is a subprogram with an appropriate
-         --  profile for the attribute being defined.
+         --  profile for the attribute being defined. If result is false and
+         --  Report is True function emits appropriate error.
 
          ----------------------
          -- Has_Good_Profile --
          ----------------------
 
-         function Has_Good_Profile (Subp : Entity_Id) return Boolean is
+         function Has_Good_Profile
+           (Subp   : Entity_Id;
+            Report : Boolean := False) return Boolean
+         is
             F              : Entity_Id;
             Is_Function    : constant Boolean := (TSS_Nam = TSS_Stream_Input);
             Expected_Ekind : constant array (Boolean) of Entity_Kind :=
@@ -3837,6 +3843,11 @@ package body Sem_Ch13 is
               and then not Is_First_Subtype (Typ)
               and then not Is_Class_Wide_Type (Typ)
             then
+               if Report and not Is_First_Subtype (Typ) then
+                  Error_Msg_N
+                    ("formal of stream operation must be a first subtype", F);
+               end if;
+
                return False;
 
             else
@@ -3885,7 +3896,7 @@ package body Sem_Ch13 is
 
          if Is_Entity_Name (Expr) then
             if not Is_Overloaded (Expr) then
-               if Has_Good_Profile (Entity (Expr)) then
+               if Has_Good_Profile (Entity (Expr), Report => True) then
                   Subp := Entity (Expr);
                end if;
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 0e03ff6..343fbe6 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2554,8 +2554,9 @@ package body Sem_Ch6 is
               Nkind (N) = N_Pragma
                 and then
                   (Pragma_Name (N) = Name_Inline_Always
-                    or else (Front_End_Inlining
-                              and then Pragma_Name (N) = Name_Inline))
+                    or else (Pragma_Name (N) = Name_Inline
+                      and then
+                        (Front_End_Inlining or else Optimization_Level > 0)))
                 and then
                   Chars
                     (Expression (First (Pragma_Argument_Associations (N)))) =
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 3f7e97b..67d464c 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -173,6 +173,14 @@ package body Sem_Eval is
    --  discrete, real, or string type and must be a compile time known value
    --  (it is an error to make the call if these conditions are not met).
 
+   function Find_Universal_Operator_Type (N : Node_Id) return Entity_Id;
+   --  Check whether an arithmetic operation with universal operands which is a
+   --  rewritten function call with an explicit scope indication is ambiguous:
+   --  P."+" (1, 2) will be ambiguous if there is more than one visible numeric
+   --  type declared in P and the context does not impose a type on the result
+   --  (e.g. in the expression of a type conversion). If ambiguous, emit an
+   --  error and return Empty, else return the result type of the operator.
+
    function From_Bits (B : Bits; T : Entity_Id) return Uint;
    --  Converts a bit string of length B'Length to a Uint value to be used for
    --  a target of type T, which is a modular type. This procedure includes the
@@ -180,14 +188,11 @@ package body Sem_Eval is
    --  (for a binary modulus, the bit string is the right length any way so all
    --  is well).
 
-   function Is_Static_Choice (Choice : Node_Id) return Boolean;
-   --  Given a choice (from a case expression or membership test), returns
-   --  True if the choice is static. No test is made for raising of constraint
-   --  error, so this function is used only for legality tests.
-
-   function Is_Static_Choice_List (Choices : List_Id) return Boolean;
-   --  Given a choice list (from a case expression or membership test), return
-   --  True if all choices are static in the sense of Is_Static_Choice.
+   function Get_String_Val (N : Node_Id) return Node_Id;
+   --  Given a tree node for a folded string or character value, returns the
+   --  corresponding string literal or character literal (one of the two must
+   --  be available, or the operand would not have been marked as foldable in
+   --  the earlier analysis of the operation).
 
    function Is_OK_Static_Choice (Choice : Node_Id) return Boolean;
    --  Given a choice (from a case expression or membership test), returns
@@ -197,6 +202,15 @@ package body Sem_Eval is
    --  Given a choice list (from a case expression or membership test), return
    --  True if all choices are static in the sense of Is_OK_Static_Choice.
 
+   function Is_Static_Choice (Choice : Node_Id) return Boolean;
+   --  Given a choice (from a case expression or membership test), returns
+   --  True if the choice is static. No test is made for raising of constraint
+   --  error, so this function is used only for legality tests.
+
+   function Is_Static_Choice_List (Choices : List_Id) return Boolean;
+   --  Given a choice list (from a case expression or membership test), return
+   --  True if all choices are static in the sense of Is_Static_Choice.
+
    function Is_Static_Range (N : Node_Id) return Boolean;
    --  Determine if range is static, as defined in RM 4.9(26). The only allowed
    --  argument is an N_Range node (but note that the semantic analysis of
@@ -206,12 +220,6 @@ package body Sem_Eval is
    --  raise Constraint_Error or not. Used for checking whether expressions are
    --  static in the 4.9 sense (without worrying about exceptions).
 
-   function Get_String_Val (N : Node_Id) return Node_Id;
-   --  Given a tree node for a folded string or character value, returns the
-   --  corresponding string literal or character literal (one of the two must
-   --  be available, or the operand would not have been marked as foldable in
-   --  the earlier analysis of the operation).
-
    function OK_Bits (N : Node_Id; Bits : Uint) return Boolean;
    --  Bits represents the number of bits in an integer value to be computed
    --  (but the value has not been computed yet). If this value in Bits is
@@ -255,14 +263,6 @@ package body Sem_Eval is
    --  used for producing the result of the static evaluation of the
    --  logical operators
 
-   function Find_Universal_Operator_Type (N : Node_Id) return Entity_Id;
-   --  Check whether an arithmetic operation with universal operands which is a
-   --  rewritten function call with an explicit scope indication is ambiguous:
-   --  P."+" (1, 2) will be ambiguous if there is more than one visible numeric
-   --  type declared in P and the context does not impose a type on the result
-   --  (e.g. in the expression of a type conversion). If ambiguous, emit an
-   --  error and return Empty, else return the result type of the operator.
-
    procedure Test_Expression_Is_Foldable
      (N    : Node_Id;
       Op1  : Node_Id;
@@ -596,9 +596,21 @@ package body Sem_Eval is
          Set_Raises_Constraint_Error (Choice);
          return Non_Static;
 
+      --  When the choice denotes a subtype with a static predictate, check the
+      --  expression against the predicate values.
+
+      elsif (Nkind (Choice) = N_Subtype_Indication
+               or else (Is_Entity_Name (Choice)
+                         and then Is_Type (Entity (Choice))))
+        and then Has_Predicates (Etype (Choice))
+        and then Has_Static_Predicate (Etype (Choice))
+      then
+         return
+           Choices_Match (Expr, Static_Discrete_Predicate (Etype (Choice)));
+
       --  Discrete type case
 
-      elsif Is_Discrete_Type (Etype (Expr)) then
+      elsif Is_Discrete_Type (Etyp) then
          Val := Expr_Value (Expr);
 
          if Nkind (Choice) = N_Range then
@@ -612,8 +624,7 @@ package body Sem_Eval is
             end if;
 
          elsif Nkind (Choice) = N_Subtype_Indication
-           or else
-             (Is_Entity_Name (Choice) and then Is_Type (Entity (Choice)))
+           or else (Is_Entity_Name (Choice) and then Is_Type (Entity (Choice)))
          then
             if Val >= Expr_Value (Type_Low_Bound  (Etype (Choice)))
                  and then
@@ -635,9 +646,9 @@ package body Sem_Eval is
             end if;
          end if;
 
-         --  Real type case
+      --  Real type case
 
-      elsif Is_Real_Type (Etype (Expr)) then
+      elsif Is_Real_Type (Etyp) then
          ValR := Expr_Value_R (Expr);
 
          if Nkind (Choice) = N_Range then
@@ -651,8 +662,7 @@ package body Sem_Eval is
             end if;
 
          elsif Nkind (Choice) = N_Subtype_Indication
-           or else
-             (Is_Entity_Name (Choice) and then Is_Type (Entity (Choice)))
+           or else (Is_Entity_Name (Choice) and then Is_Type (Entity (Choice)))
          then
             if ValR >= Expr_Value_R (Type_Low_Bound  (Etype (Choice)))
                  and then
@@ -671,15 +681,14 @@ package body Sem_Eval is
             end if;
          end if;
 
-         --  String type cases
+      --  String type cases
 
       else
-         pragma Assert (Is_String_Type (Etype (Expr)));
+         pragma Assert (Is_String_Type (Etyp));
          ValS := Expr_Value_S (Expr);
 
          if Nkind (Choice) = N_Subtype_Indication
-           or else
-             (Is_Entity_Name (Choice) and then Is_Type (Entity (Choice)))
+           or else (Is_Entity_Name (Choice) and then Is_Type (Entity (Choice)))
          then
             if not Is_Constrained (Etype (Choice)) then
                return Match;
@@ -2714,45 +2723,34 @@ package body Sem_Eval is
    --  static subtype (RM 4.9(12)).
 
    procedure Eval_Membership_Op (N : Node_Id) is
-      Left   : constant Node_Id := Left_Opnd (N);
-      Right  : constant Node_Id := Right_Opnd (N);
       Alts   : constant List_Id := Alternatives (N);
+      Choice : constant Node_Id := Right_Opnd (N);
+      Expr   : constant Node_Id := Left_Opnd (N);
       Result : Match_Result;
 
    begin
       --  Ignore if error in either operand, except to make sure that Any_Type
       --  is properly propagated to avoid junk cascaded errors.
 
-      if Etype (Left) = Any_Type
-        or else (Present (Right) and then Etype (Right) = Any_Type)
+      if Etype (Expr) = Any_Type
+        or else (Present (Choice) and then Etype (Choice) = Any_Type)
       then
          Set_Etype (N, Any_Type);
          return;
       end if;
 
-      --  Ignore if types involved have predicates
-      --  Is this right for static predicates ???
-      --  And what about the alternatives ???
-
-      if Present (Predicate_Function (Etype (Left)))
-        or else (Present (Right)
-                  and then Present (Predicate_Function (Etype (Right))))
-      then
-         return;
-      end if;
-
       --  If left operand non-static, then nothing to do
 
-      if not Is_Static_Expression (Left) then
+      if not Is_Static_Expression (Expr) then
          return;
       end if;
 
       --  If choice is non-static, left operand is in non-static context
 
-      if (Present (Right) and then not Is_Static_Choice (Right))
+      if (Present (Choice) and then not Is_Static_Choice (Choice))
         or else (Present (Alts) and then not Is_Static_Choice_List (Alts))
       then
-         Check_Non_Static_Context (Left);
+         Check_Non_Static_Context (Expr);
          return;
       end if;
 
@@ -2762,16 +2760,16 @@ package body Sem_Eval is
 
       --  If left operand raises constraint error, propagate and we are done
 
-      if Raises_Constraint_Error (Left) then
+      if Raises_Constraint_Error (Expr) then
          Set_Raises_Constraint_Error (N, True);
 
       --  See if we match
 
       else
-         if Present (Right) then
-            Result := Choice_Matches (Left, Right);
+         if Present (Choice) then
+            Result := Choice_Matches (Expr, Choice);
          else
-            Result := Choices_Match (Left, Alts);
+            Result := Choices_Match (Expr, Alts);
          end if;
 
          --  If result is Non_Static, it means that we raise Constraint_Error,
@@ -4697,8 +4695,7 @@ package body Sem_Eval is
          return Is_OK_Static_Range (Choice);
 
       elsif Nkind (Choice) = N_Subtype_Indication
-        or else
-          (Is_Entity_Name (Choice) and then Is_Type (Entity (Choice)))
+        or else (Is_Entity_Name (Choice) and then Is_Type (Entity (Choice)))
       then
          return Is_OK_Static_Subtype (Etype (Choice));
 
@@ -4787,6 +4784,9 @@ package body Sem_Eval is
       then
          return False;
 
+      elsif Has_Dynamic_Predicate_Aspect (Typ) then
+         return False;
+
       --  String types
 
       elsif Is_String_Type (Typ) then
@@ -4853,8 +4853,7 @@ package body Sem_Eval is
          return Is_Static_Range (Choice);
 
       elsif Nkind (Choice) = N_Subtype_Indication
-        or else
-          (Is_Entity_Name (Choice) and then Is_Type (Entity (Choice)))
+        or else (Is_Entity_Name (Choice) and then Is_Type (Entity (Choice)))
       then
          return Is_Static_Subtype (Etype (Choice));
 
@@ -4883,7 +4882,7 @@ package body Sem_Eval is
       return True;
    end Is_Static_Choice_List;
 
----------------------
+   ---------------------
    -- Is_Static_Range --
    ---------------------
 
@@ -4929,6 +4928,9 @@ package body Sem_Eval is
       then
          return False;
 
+      elsif Has_Dynamic_Predicate_Aspect (Typ) then
+         return False;
+
       --  String types
 
       elsif Is_String_Type (Typ) then
diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads
index 7f206e7..b59fb6c 100644
--- a/gcc/ada/sem_eval.ads
+++ b/gcc/ada/sem_eval.ads
@@ -198,88 +198,10 @@ package Sem_Eval is
    --  True for a recursive call from within Compile_Time_Compare to avoid some
    --  infinite recursion cases. It should never be set by a client.
 
-   procedure Flag_Non_Static_Expr (Msg : String; Expr : Node_Id);
-   --  This procedure is called after it has been determined that Expr is not
-   --  static when it is required to be. Msg is the text of a message that
-   --  explains the error. This procedure checks if an error is already posted
-   --  on Expr, if so, it does nothing unless All_Errors_Mode is set in which
-   --  case this flag is ignored. Otherwise the given message is posted using
-   --  Error_Msg_F, and then Why_Not_Static is called on Expr to generate
-   --  additional messages. The string given as Msg should end with ! to make
-   --  it an unconditional message, to ensure that if it is posted, the entire
-   --  set of messages is all posted.
-
-   function Is_OK_Static_Expression (N : Node_Id) return Boolean;
-   --  An OK static expression is one that is static in the RM definition sense
-   --  and which does not raise constraint error. For most legality checking
-   --  purposes you should use Is_Static_Expression. For those legality checks
-   --  where the expression N should not raise constraint error use this
-   --  routine. This routine is *not* to be used in contexts where the test is
-   --  for compile time evaluation purposes. Use Compile_Time_Known_Value
-   --  instead (see section on "Compile-Time Known Values" above).
-
-   function Is_OK_Static_Range (N : Node_Id) return Boolean;
-   --  Determines if range is static, as defined in RM 4.9(26), and also checks
-   --  that neither bound of the range raises constraint error, thus ensuring
-   --  that both bounds of the range are compile-time evaluable (i.e. do not
-   --  raise constraint error). A result of true means that the bounds are
-   --  compile time evaluable. A result of false means they are not (either
-   --  because the range is not static, or because one or the other bound
-   --  raises CE).
-
-   function Is_Static_Subtype (Typ : Entity_Id) return Boolean;
-   --  Determines whether a subtype fits the definition of an Ada static
-   --  subtype as given in (RM 4.9(26)). Important note: This check does not
-   --  include the Ada 2012 case of a non-static predicate which results in an
-   --  otherwise static subtype being non-static. Such a subtype will return
-   --  True for this test, so if the distinction is important, the caller must
-   --  deal with this.
-   --
-   --  Implementation note: an attempt to include this Ada 2012 case failed,
-   --  since it appears that this routine is called in some cases before the
-   --  Static_Discrete_Predicate field is set ???
-   --
-   --  This differs from Is_OK_Static_Subtype (which is what must be used by
-   --  clients) in that it does not care whether the bounds raise a constraint
-   --  error exception or not. Used for checking whether expressions are static
-   --  in the 4.9 sense (without worrying about exceptions).
-
-   function Is_OK_Static_Subtype (Typ : Entity_Id) return Boolean;
-   --  Determines whether a subtype fits the definition of an Ada static
-   --  subtype as given in (RM 4.9(26)) with the additional check that neither
-   --  bound raises constraint error (meaning that Expr_Value[_R|S] can be used
-   --  on these bounds). Important note: This check does not include the Ada
-   --  2012 case of a non-static predicate which results in an otherwise static
-   --  subtype being non-static. Such a subtype will return True for this test,
-   --  so if the distinction is important, the caller must deal with this.
-   --
-   --  Implementation note: an attempt to include this Ada 2012 case failed,
-   --  since it appears that this routine is called in some cases before the
-   --  Static_Discrete_Predicate field is set ???
-   --
-   --  This differs from Is_Static_Subtype in that it includes the constraint
-   --  error checks, which are missing from Is_Static_Subtype.
-
-   function Subtypes_Statically_Compatible
-     (T1                      : Entity_Id;
-      T2                      : Entity_Id;
-      Formal_Derived_Matching : Boolean := False) return Boolean;
-   --  Returns true if the subtypes are unconstrained or the constraint on
-   --  on T1 is statically compatible with T2 (as defined by 4.9.1(4)).
-   --  Otherwise returns false. Formal_Derived_Matching indicates whether
-   --  the type T1 is a generic actual being checked against ancestor T2
-   --  in a formal derived type association.
-
-   function Subtypes_Statically_Match
-     (T1                      : Entity_Id;
-      T2                      : Entity_Id;
-      Formal_Derived_Matching : Boolean := False) return Boolean;
-   --  Determine whether two types T1, T2, which have the same base type,
-   --  are statically matching subtypes (RM 4.9.1(1-2)). Also includes the
-   --  extra GNAT rule that object sizes must match (this can be false for
-   --  types that match in the RM sense because of use of 'Object_Size),
-   --  except when testing a generic actual T1 against an ancestor T2 in a
-   --  formal derived type association (indicated by Formal_Derived_Matching).
+   function Compile_Time_Known_Bounds (T : Entity_Id) return Boolean;
+   --  If T is an array whose index bounds are all known at compile time, then
+   --  True is returned. If T is not an array type, or one or more of its index
+   --  bounds is not known at compile time, then False is returned.
 
    function Compile_Time_Known_Value (Op : Node_Id) return Boolean;
    --  Returns true if Op is an expression not raising Constraint_Error whose
@@ -306,6 +228,15 @@ package Sem_Eval is
    --  efficient with compile time known values, e.g. range analysis for the
    --  purpose of removing checks is more effective if we know precise bounds.
 
+   function Compile_Time_Known_Value_Or_Aggr (Op : Node_Id) return Boolean;
+   --  Similar to Compile_Time_Known_Value, but also returns True if the value
+   --  is a compile-time-known aggregate, i.e. an aggregate all of whose
+   --  constituent expressions are either compile-time-known values (based on
+   --  calling Compile_Time_Known_Value) or compile-time-known aggregates.
+   --  Note that the aggregate could still involve run-time checks that might
+   --  fail (such as for subtype checks in component associations), but the
+   --  evaluation of the expressions themselves will not raise an exception.
+
    function CRT_Safe_Compile_Time_Known_Value (Op : Node_Id) return Boolean;
    --  In the case of configurable run-times, there may be an issue calling
    --  Compile_Time_Known_Value with non-static expressions where the legality
@@ -328,19 +259,16 @@ package Sem_Eval is
    --  if we are in configurable run-time mode, even if the expression would
    --  normally be considered compile-time known.
 
-   function Compile_Time_Known_Value_Or_Aggr (Op : Node_Id) return Boolean;
-   --  Similar to Compile_Time_Known_Value, but also returns True if the value
-   --  is a compile-time-known aggregate, i.e. an aggregate all of whose
-   --  constituent expressions are either compile-time-known values (based on
-   --  calling Compile_Time_Known_Value) or compile-time-known aggregates.
-   --  Note that the aggregate could still involve run-time checks that might
-   --  fail (such as for subtype checks in component associations), but the
-   --  evaluation of the expressions themselves will not raise an exception.
-
-   function Compile_Time_Known_Bounds (T : Entity_Id) return Boolean;
-   --  If T is an array whose index bounds are all known at compile time, then
-   --  True is returned. If T is not an array type, or one or more of its index
-   --  bounds is not known at compile time, then False is returned.
+   function Expr_Rep_Value (N : Node_Id) return Uint;
+   --  This is identical to Expr_Value, except in the case of enumeration
+   --  literals of types for which an enumeration representation clause has
+   --  been given, in which case it returns the representation value rather
+   --  than the pos value. This is the value that is needed for generating code
+   --  sequences, while the Expr_Value value is appropriate for compile time
+   --  constraint errors or getting the logical value. Note that this function
+   --  does NOT concern itself with biased values, if the caller needs a
+   --  properly biased value, the subtraction of the bias must be handled
+   --  explicitly.
 
    function Expr_Value (N : Node_Id) return Uint;
    --  Returns the folded value of the expression N. This function is called in
@@ -372,17 +300,6 @@ package Sem_Eval is
    --  is static or its value is known at compile time. This version is used
    --  for string types and returns the corresponding N_String_Literal node.
 
-   function Expr_Rep_Value (N : Node_Id) return Uint;
-   --  This is identical to Expr_Value, except in the case of enumeration
-   --  literals of types for which an enumeration representation clause has
-   --  been given, in which case it returns the representation value rather
-   --  than the pos value. This is the value that is needed for generating code
-   --  sequences, while the Expr_Value value is appropriate for compile time
-   --  constraint errors or getting the logical value. Note that this function
-   --  does NOT concern itself with biased values, if the caller needs a
-   --  properly biased value, the subtraction of the bias must be handled
-   --  explicitly.
-
    procedure Eval_Actual                 (N : Node_Id);
    procedure Eval_Allocator              (N : Node_Id);
    procedure Eval_Arithmetic_Op          (N : Node_Id);
@@ -411,6 +328,17 @@ package Sem_Eval is
    procedure Eval_Unary_Op               (N : Node_Id);
    procedure Eval_Unchecked_Conversion   (N : Node_Id);
 
+   procedure Flag_Non_Static_Expr (Msg : String; Expr : Node_Id);
+   --  This procedure is called after it has been determined that Expr is not
+   --  static when it is required to be. Msg is the text of a message that
+   --  explains the error. This procedure checks if an error is already posted
+   --  on Expr, if so, it does nothing unless All_Errors_Mode is set in which
+   --  case this flag is ignored. Otherwise the given message is posted using
+   --  Error_Msg_F, and then Why_Not_Static is called on Expr to generate
+   --  additional messages. The string given as Msg should end with ! to make
+   --  it an unconditional message, to ensure that if it is posted, the entire
+   --  set of messages is all posted.
+
    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
@@ -474,6 +402,38 @@ package Sem_Eval is
    --  is some independent way of knowing that it is valid, i.e. either it is
    --  an entity with Is_Known_Valid set, or Assume_No_Invalid_Values is True.
 
+   function Is_Null_Range (Lo : Node_Id; Hi : Node_Id) return Boolean;
+   --  Returns True if it can guarantee that Lo .. Hi is a null range. If it
+   --  cannot (because the value of Lo or Hi is not known at compile time) then
+   --  it returns False.
+
+   function Is_OK_Static_Expression (N : Node_Id) return Boolean;
+   --  An OK static expression is one that is static in the RM definition sense
+   --  and which does not raise constraint error. For most legality checking
+   --  purposes you should use Is_Static_Expression. For those legality checks
+   --  where the expression N should not raise constraint error use this
+   --  routine. This routine is *not* to be used in contexts where the test is
+   --  for compile time evaluation purposes. Use Compile_Time_Known_Value
+   --  instead (see section on "Compile-Time Known Values" above).
+
+   function Is_OK_Static_Range (N : Node_Id) return Boolean;
+   --  Determines if range is static, as defined in RM 4.9(26), and also checks
+   --  that neither bound of the range raises constraint error, thus ensuring
+   --  that both bounds of the range are compile-time evaluable (i.e. do not
+   --  raise constraint error). A result of true means that the bounds are
+   --  compile time evaluable. A result of false means they are not (either
+   --  because the range is not static, or because one or the other bound
+   --  raises CE).
+
+   function Is_OK_Static_Subtype (Typ : Entity_Id) return Boolean;
+   --  Determines whether a subtype fits the definition of an Ada static
+   --  subtype as given in (RM 4.9(26)) with the additional check that neither
+   --  bound raises constraint error (meaning that Expr_Value[_R|S] can be used
+   --  on these bounds).
+   --
+   --  This differs from Is_Static_Subtype in that it includes the constraint
+   --  error checks, which are missing from Is_Static_Subtype.
+
    function Is_Out_Of_Range
      (N            : Node_Id;
       Typ          : Entity_Id;
@@ -488,6 +448,19 @@ package Sem_Eval is
    --  that it is out of range. The parameters Assume_Valid, Fixed_Int, and
    --  Int_Real are as described for Is_In_Range above.
 
+   function Is_Static_Subtype (Typ : Entity_Id) return Boolean;
+   --  Determines whether a subtype fits the definition of an Ada static
+   --  subtype as given in (RM 4.9(26)).
+   --
+   --  This differs from Is_OK_Static_Subtype (which is what must be used by
+   --  clients) in that it does not care whether the bounds raise a constraint
+   --  error exception or not. Used for checking whether expressions are static
+   --  in the 4.9 sense (without worrying about exceptions).
+
+   function Is_Statically_Unevaluated (Expr : Node_Id) return Boolean;
+   --  This function returns True if the given expression Expr is statically
+   --  unevaluated, as defined in (RM 4.9 (32.1-32.6)).
+
    function In_Subrange_Of
      (T1        : Entity_Id;
       T2        : Entity_Id;
@@ -498,15 +471,6 @@ package Sem_Eval is
    --  it cannot be determined at compile time. Flag Fixed_Int is used as in
    --  routine Is_In_Range above.
 
-   function Is_Null_Range (Lo : Node_Id; Hi : Node_Id) return Boolean;
-   --  Returns True if it can guarantee that Lo .. Hi is a null range. If it
-   --  cannot (because the value of Lo or Hi is not known at compile time) then
-   --  it returns False.
-
-   function Is_Statically_Unevaluated (Expr : Node_Id) return Boolean;
-   --  This function returns True if the given expression Expr is statically
-   --  unevaluated, as defined in (RM 4.9 (32.1-32.6)).
-
    function Not_Null_Range (Lo : Node_Id; Hi : Node_Id) return Boolean;
    --  Returns True if it can guarantee that Lo .. Hi is not a null range. If
    --  it cannot (because the value of Lo or Hi is not known at compile time)
@@ -518,6 +482,27 @@ package Sem_Eval is
    --  predicates match. Separated out from Subtypes_Statically_Match so
    --  that it can be used in specializing error messages.
 
+   function Subtypes_Statically_Compatible
+     (T1                      : Entity_Id;
+      T2                      : Entity_Id;
+      Formal_Derived_Matching : Boolean := False) return Boolean;
+   --  Returns true if the subtypes are unconstrained or the constraint on
+   --  on T1 is statically compatible with T2 (as defined by 4.9.1(4)).
+   --  Otherwise returns false. Formal_Derived_Matching indicates whether
+   --  the type T1 is a generic actual being checked against ancestor T2
+   --  in a formal derived type association.
+
+   function Subtypes_Statically_Match
+     (T1                      : Entity_Id;
+      T2                      : Entity_Id;
+      Formal_Derived_Matching : Boolean := False) return Boolean;
+   --  Determine whether two types T1, T2, which have the same base type,
+   --  are statically matching subtypes (RM 4.9.1(1-2)). Also includes the
+   --  extra GNAT rule that object sizes must match (this can be false for
+   --  types that match in the RM sense because of use of 'Object_Size),
+   --  except when testing a generic actual T1 against an ancestor T2 in a
+   --  formal derived type association (indicated by Formal_Derived_Matching).
+
    procedure Why_Not_Static (Expr : Node_Id);
    --  This procedure may be called after generating an error message that
    --  complains that something is non-static. If it finds good reasons, it
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index c55054b..c753e61 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -2860,15 +2860,21 @@ package body Sem_Prag is
 
                   if Ekind_In (Input_Id, E_Abstract_State,
                                          E_Constant,
+                                         E_Generic_In_Out_Parameter,
+                                         E_Generic_In_Parameter,
                                          E_In_Parameter,
                                          E_In_Out_Parameter,
                                          E_Out_Parameter,
                                          E_Variable)
                   then
                      --  The input cannot denote states or objects declared
-                     --  within the related package (SPARK RM 7.1.5(4)).
+                     --  within the related package (SPARK RM 7.1.5(4)). The
+                     --  only exception to this are generic formal parameters.
 
-                     if Within_Scope (Input_Id, Current_Scope) then
+                     if not Ekind_In (Input_Id, E_Generic_In_Out_Parameter,
+                                                E_Generic_In_Parameter)
+                       and then Within_Scope (Input_Id, Current_Scope)
+                     then
                         Error_Msg_Name_1 := Chars (Pack_Id);
                         SPARK_Msg_NE
                           ("input item & cannot denote a visible object or "