[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

gcc/ada/ChangeLog

+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

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

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;

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');

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.
 

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

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;

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;
 

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)))) =

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 "