[multiple changes]

2016-10-12  Jerome Lambourg  <lambourg@adacore.com>

	* init.c: Make sure to call finit on x86_64-vx7 to reinitialize
	the FPU unit.

2016-10-12  Arnaud Charlet  <charlet@adacore.com>

	* lib-load.adb (Load_Unit): Generate an error message even when
	Error_Node is null.

2016-10-12  Ed Schonberg  <schonberg@adacore.com>

	* lib-writ.adb (Write_ALI): Disable optimization related to transitive
	limited_with clauses for now.

2016-10-12  Javier Miranda  <miranda@adacore.com>

	* sem_attr.adb (Analyze_Attribute_Old_Result): Generating C
	code handle 'old located in inlined _postconditions procedures.
	(Analyze_Attribute [Attribute_Result]): Handle 'result when
	rewriting the attribute as a reference to the formal parameter
	_Result of inlined _postconditions procedures.

2016-10-12  Tristan Gingold  <gingold@adacore.com>

	* s-rident.ads (Profile_Info): Remove
	Max_Protected_Entries restriction from GNAT_Extended_Ravenscar
	* sem_ch9.adb (Analyze_Protected_Type_Declaration):
	Not a controlled type on restricted runtimes.

2016-10-12  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch3.adb (Derive_Subprogram): Add test
	for Is_Controlled of Parent_Type when determining whether an
	inherited subprogram with one of the special names Initialize,
	Adjust, or Finalize should be derived with its normal name even
	when inherited as a private operation (which would normally
	result in the inherited operation having a special "hidden" name).

2016-10-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Call): If a function call returns a
	limited view of a type replace it with the non-limited view,
	which must be available when compiling call.  This was already
	done elsewhere for non-overloaded calls, but needs to be done
	after resolution if function name is overloaded.

2016-10-12  Javier Miranda  <miranda@adacore.com>

	* a-tags.adb (IW_Membership [private]): new overloaded
	subprogram that factorizes the code needed to check if a
	given type implements an interface type.
	(IW_Membership
	[public]): invoke the new internal IW_Membership function.
	(Is_Descendant_At_Same_Level): Fix this routine to implement RM
	3.9 (12.3/3)

From-SVN: r241036

10 files changed, 179 insertions, 55 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 37ab195..fd49a21 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,60 @@
+2016-10-12  Jerome Lambourg  <lambourg@adacore.com>
+
+	* init.c: Make sure to call finit on x86_64-vx7 to reinitialize
+	the FPU unit.
+
+2016-10-12  Arnaud Charlet  <charlet@adacore.com>
+
+	* lib-load.adb (Load_Unit): Generate an error message even when
+	Error_Node is null.
+
+2016-10-12  Ed Schonberg  <schonberg@adacore.com>
+
+	* lib-writ.adb (Write_ALI): Disable optimization related to transitive
+	limited_with clauses for now.
+
+2016-10-12  Javier Miranda  <miranda@adacore.com>
+
+	* sem_attr.adb (Analyze_Attribute_Old_Result): Generating C
+	code handle 'old located in inlined _postconditions procedures.
+	(Analyze_Attribute [Attribute_Result]): Handle 'result when
+	rewriting the attribute as a reference to the formal parameter
+	_Result of inlined _postconditions procedures.
+
+2016-10-12  Tristan Gingold  <gingold@adacore.com>
+
+	* s-rident.ads (Profile_Info): Remove
+	Max_Protected_Entries restriction from GNAT_Extended_Ravenscar
+	* sem_ch9.adb (Analyze_Protected_Type_Declaration):
+	Not a controlled type on restricted runtimes.
+
+2016-10-12  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_ch3.adb (Derive_Subprogram): Add test
+	for Is_Controlled of Parent_Type when determining whether an
+	inherited subprogram with one of the special names Initialize,
+	Adjust, or Finalize should be derived with its normal name even
+	when inherited as a private operation (which would normally
+	result in the inherited operation having a special "hidden" name).
+
+2016-10-12  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Resolve_Call): If a function call returns a
+	limited view of a type replace it with the non-limited view,
+	which must be available when compiling call.  This was already
+	done elsewhere for non-overloaded calls, but needs to be done
+	after resolution if function name is overloaded.
+
+2016-10-12  Javier Miranda  <miranda@adacore.com>
+
+	* a-tags.adb (IW_Membership [private]): new overloaded
+	subprogram that factorizes the code needed to check if a
+	given type implements an interface type.
+	(IW_Membership
+	[public]): invoke the new internal IW_Membership function.
+	(Is_Descendant_At_Same_Level): Fix this routine to implement RM
+	3.9 (12.3/3)
+
 2016-10-12  Tristan Gingold  <gingold@adacore.com>
 
 	* exp_ch9.adb (Expand_N_Delay_Relative_Statement): Add support
diff --git a/gcc/ada/a-tags.adb b/gcc/ada/a-tags.adb
index 203d19e..07c2139 100644
--- a/gcc/ada/a-tags.adb
+++ b/gcc/ada/a-tags.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -61,6 +61,13 @@ package body Ada.Tags is
    --  table.  This is Inline_Always since it is called from other Inline_
    --  Always subprograms where we want no out of line code to be generated.
 
+   function IW_Membership
+     (Descendant_TSD : Type_Specific_Data_Ptr;
+      T              : Tag) return Boolean;
+   --  Subsidiary function of IW_Membership and CW_Membership which factorizes
+   --  the functionality needed to check if a given descendant implements an
+   --  interface tag T.
+
    function Length (Str : Cstring_Ptr) return Natural;
    --  Length of string represented by the given pointer (treating the string
    --  as a C-style string, which is Nul terminated). See comment in body
@@ -431,27 +438,14 @@ package body Ada.Tags is
    -- IW_Membership --
    -------------------
 
-   --  Canonical implementation of Classwide Membership corresponding to:
-
-   --     Obj in Iface'Class
-
-   --  Each dispatch table contains a table with the tags of all the
-   --  implemented interfaces.
-
-   --  Obj is in Iface'Class if Iface'Tag is found in the table of interfaces
-   --  that are contained in the dispatch table referenced by Obj'Tag.
-
-   function IW_Membership (This : System.Address; T : Tag) return Boolean is
+   function IW_Membership
+     (Descendant_TSD : Type_Specific_Data_Ptr;
+      T              : Tag) return Boolean
+   is
       Iface_Table : Interface_Data_Ptr;
-      Obj_Base    : System.Address;
-      Obj_DT      : Dispatch_Table_Ptr;
-      Obj_TSD     : Type_Specific_Data_Ptr;
 
    begin
-      Obj_Base    := Base_Address (This);
-      Obj_DT      := DT (To_Tag_Ptr (Obj_Base).all);
-      Obj_TSD     := To_Type_Specific_Data_Ptr (Obj_DT.TSD);
-      Iface_Table := Obj_TSD.Interfaces_Table;
+      Iface_Table := Descendant_TSD.Interfaces_Table;
 
       if Iface_Table /= null then
          for Id in 1 .. Iface_Table.Nb_Ifaces loop
@@ -464,8 +458,8 @@ package body Ada.Tags is
       --  Look for the tag in the ancestor tags table. This is required for:
       --     Iface_CW in Typ'Class
 
-      for Id in 0 .. Obj_TSD.Idepth loop
-         if Obj_TSD.Tags_Table (Id) = T then
+      for Id in 0 .. Descendant_TSD.Idepth loop
+         if Descendant_TSD.Tags_Table (Id) = T then
             return True;
          end if;
       end loop;
@@ -474,6 +468,33 @@ package body Ada.Tags is
    end IW_Membership;
 
    -------------------
+   -- IW_Membership --
+   -------------------
+
+   --  Canonical implementation of Classwide Membership corresponding to:
+
+   --     Obj in Iface'Class
+
+   --  Each dispatch table contains a table with the tags of all the
+   --  implemented interfaces.
+
+   --  Obj is in Iface'Class if Iface'Tag is found in the table of interfaces
+   --  that are contained in the dispatch table referenced by Obj'Tag.
+
+   function IW_Membership (This : System.Address; T : Tag) return Boolean is
+      Obj_Base : System.Address;
+      Obj_DT   : Dispatch_Table_Ptr;
+      Obj_TSD  : Type_Specific_Data_Ptr;
+
+   begin
+      Obj_Base := Base_Address (This);
+      Obj_DT   := DT (To_Tag_Ptr (Obj_Base).all);
+      Obj_TSD  := To_Type_Specific_Data_Ptr (Obj_DT.TSD);
+
+      return IW_Membership (Obj_TSD, T);
+   end IW_Membership;
+
+   -------------------
    -- Expanded_Name --
    -------------------
 
@@ -721,18 +742,27 @@ package body Ada.Tags is
      (Descendant : Tag;
       Ancestor   : Tag) return Boolean
    is
-      D_TSD_Ptr : constant Addr_Ptr :=
-        To_Addr_Ptr (To_Address (Descendant) - DT_Typeinfo_Ptr_Size);
-      A_TSD_Ptr : constant Addr_Ptr :=
-        To_Addr_Ptr (To_Address (Ancestor) - DT_Typeinfo_Ptr_Size);
-      D_TSD     : constant Type_Specific_Data_Ptr :=
-        To_Type_Specific_Data_Ptr (D_TSD_Ptr.all);
-      A_TSD     : constant Type_Specific_Data_Ptr :=
-        To_Type_Specific_Data_Ptr (A_TSD_Ptr.all);
-
    begin
-      return CW_Membership (Descendant, Ancestor)
-        and then D_TSD.Access_Level = A_TSD.Access_Level;
+      if Descendant = Ancestor then
+         return True;
+
+      else
+         declare
+            D_TSD_Ptr : constant Addr_Ptr :=
+              To_Addr_Ptr (To_Address (Descendant) - DT_Typeinfo_Ptr_Size);
+            A_TSD_Ptr : constant Addr_Ptr :=
+              To_Addr_Ptr (To_Address (Ancestor) - DT_Typeinfo_Ptr_Size);
+            D_TSD     : constant Type_Specific_Data_Ptr :=
+              To_Type_Specific_Data_Ptr (D_TSD_Ptr.all);
+            A_TSD     : constant Type_Specific_Data_Ptr :=
+              To_Type_Specific_Data_Ptr (A_TSD_Ptr.all);
+         begin
+            return D_TSD.Access_Level = A_TSD.Access_Level
+              and then (CW_Membership (Descendant, Ancestor)
+                          or else
+                        IW_Membership (D_TSD, Ancestor));
+         end;
+      end if;
    end Is_Descendant_At_Same_Level;
 
    ------------
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index 114310d..e180f3c 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -2138,9 +2138,9 @@ __gnat_init_float (void)
 #endif
 #endif
 
-#if defined (__i386__) && !defined (VTHREADS)
+#if (defined (__i386__) || defined (__x86_64__)) && !defined (VTHREADS)
   /* This is used to properly initialize the FPU on an x86 for each
-     process thread. Is this needed for x86_64 ???  */
+     process thread. */
   asm ("finit");
 #endif
 
diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb
index 83d3576..c66fd72 100644
--- a/gcc/ada/lib-load.adb
+++ b/gcc/ada/lib-load.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -784,7 +784,7 @@ package body Lib.Load is
 
             --  Generate message if unit required
 
-            if Required and then Present (Error_Node) then
+            if Required then
                if Is_Predefined_File_Name (Fname) then
 
                   --  This is a predefined library unit which is not present
@@ -799,7 +799,9 @@ package body Lib.Load is
                   --  the message about the restriction violation is generated,
                   --  if needed.
 
-                  Check_Restricted_Unit (Load_Name, Error_Node);
+                  if Present (Error_Node) then
+                     Check_Restricted_Unit (Load_Name, Error_Node);
+                  end if;
 
                   Error_Msg_Unit_1 := Uname_Actual;
                   Error_Msg -- CODEFIX
diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb
index c5f9d01..b78e3eb 100644
--- a/gcc/ada/lib-writ.adb
+++ b/gcc/ada/lib-writ.adb
@@ -1440,9 +1440,21 @@ package body Lib.Writ is
             --  in the context of the parent, and their file table entries are
             --  not properly decorated, they are recognized syntactically.
 
-            if Present (Cunit_Entity (Unum))
+            --  This optimization is disabled when inline is active, because
+            --  inline may propose some bodies for inlining, and decide later
+            --  that they may lead to circularities, in which case they are
+            --  also left unanalyzed in the file table. There is no simple way
+            --  to distinguish between the two kinds of unanalyzed entries,
+            --  so simplest is to skip this step.
+
+            --  Actually, this optimization is always disabled, because it
+            --  breaks gnatfind.
+
+            if False -- ???
+              and then Present (Cunit_Entity (Unum))
               and then Ekind (Cunit_Entity (Unum)) = E_Void
               and then Nkind (Unit (Cunit (Unum))) /= N_Subunit
+              and then not Inline_Active
             then
                goto Next_Unit;
             end if;
diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads
index ab234c3..8f552ba 100644
--- a/gcc/ada/s-rident.ads
+++ b/gcc/ada/s-rident.ads
@@ -563,7 +563,6 @@ package System.Rident is
                            No_Task_Hierarchy               => True,
                            No_Terminate_Alternatives       => True,
                            Max_Asynchronous_Select_Nesting => True,
-                           Max_Protected_Entries           => True,
                            Max_Select_Alternatives         => True,
                            Max_Task_Entries                => True,
 
@@ -584,7 +583,6 @@ package System.Rident is
 
                         Value =>
                           (Max_Asynchronous_Select_Nesting => 0,
-                           Max_Protected_Entries           => 1,
                            Max_Select_Alternatives         => 0,
                            Max_Task_Entries                => 0,
                            others                          => 0)));
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index c0be95d..cd7691f 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1358,13 +1358,23 @@ package body Sem_Attr is
          --  appear on a subprogram renaming, when the renamed entity is an
          --  attribute reference.
 
-         if not Nkind_In (Subp_Decl, N_Abstract_Subprogram_Declaration,
-                                     N_Entry_Declaration,
-                                     N_Generic_Subprogram_Declaration,
-                                     N_Subprogram_Body,
-                                     N_Subprogram_Body_Stub,
-                                     N_Subprogram_Declaration,
-                                     N_Subprogram_Renaming_Declaration)
+         --  Generating C code the internally built nested _postcondition
+         --  subprograms are inlined; after expanded, inlined aspects are
+         --  located in the internal block generated by the frontend.
+
+         if Nkind (Subp_Decl) = N_Block_Statement
+           and then Modify_Tree_For_C
+           and then In_Inlined_Body
+         then
+            null;
+
+         elsif not Nkind_In (Subp_Decl, N_Abstract_Subprogram_Declaration,
+                                        N_Entry_Declaration,
+                                        N_Generic_Subprogram_Declaration,
+                                        N_Subprogram_Body,
+                                        N_Subprogram_Body_Stub,
+                                        N_Subprogram_Declaration,
+                                        N_Subprogram_Renaming_Declaration)
          then
             return;
          end if;
@@ -5276,6 +5286,9 @@ package body Sem_Attr is
 
          --  Local variables
 
+         In_Inlined_C_Postcondition : constant Boolean :=
+           Modify_Tree_For_C and then In_Inlined_Body;
+
          Legal   : Boolean;
          Pref_Id : Entity_Id;
          Spec_Id : Entity_Id;
@@ -5309,10 +5322,7 @@ package body Sem_Attr is
          --  The exception to this rule is when generating C since in this case
          --  postconditions are inlined.
 
-         if No (Spec_Id)
-           and then Modify_Tree_For_C
-           and then In_Inlined_Body
-         then
+         if No (Spec_Id) and then In_Inlined_C_Postcondition then
             Spec_Id := Entity (P);
 
          elsif not Legal then
@@ -5325,7 +5335,11 @@ package body Sem_Attr is
          --  Instead, rewrite the attribute as a reference to formal parameter
          --  _Result of the _Postconditions procedure.
 
-         if Chars (Spec_Id) = Name_uPostconditions then
+         if Chars (Spec_Id) = Name_uPostconditions
+           or else
+             (In_Inlined_C_Postcondition
+                and then Nkind (Parent (Spec_Id)) = N_Block_Statement)
+         then
             Rewrite (N, Make_Identifier (Loc, Name_uResult));
 
             --  The type of formal parameter _Result is that of the function
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 07f25dc..2bd9071 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -14757,9 +14757,10 @@ package body Sem_Ch3 is
         or else Is_Internal (Parent_Subp)
         or else Is_Private_Overriding
         or else Is_Internal_Name (Chars (Parent_Subp))
-        or else Nam_In (Chars (Parent_Subp), Name_Initialize,
-                                             Name_Adjust,
-                                             Name_Finalize)
+        or else (Is_Controlled (Parent_Type)
+                  and then Nam_In (Chars (Parent_Subp), Name_Initialize,
+                                                        Name_Adjust,
+                                                        Name_Finalize))
       then
          Set_Derived_Name;
 
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index 8297db8..7ccf38b 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -2090,6 +2090,7 @@ package body Sem_Ch9 is
 
       if (Abort_Allowed or else Restriction_Active (No_Entry_Queue) = False
            or else Number_Entries (T) > 1)
+        and then not Restricted_Profile
         and then
           (Has_Entries (T)
             or else Has_Interrupt_Handler (T)
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index f35c9e2..47a6725 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -6034,6 +6034,15 @@ package body Sem_Res is
          end;
 
       else
+         --  If the function returns the limited view of type, the call must
+         --  appear in a context in which the non-limited view is available.
+         --  As is done in Try_Object_Operation, use the available view to
+         --  prevent back-end confusion.
+
+         if From_Limited_With (Etype (Nam)) then
+            Set_Etype (Nam, Available_View (Etype (Nam)));
+         end if;
+
          Set_Etype (N, Etype (Nam));
       end if;