[multiple changes]

2014-11-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch3.adb (Build_Initialization_Call): Reimplement the
	circuitry which extraacts the [underlying] full view of a
	private type to handle a case where the private type acts as a
	generic actual.
	* exp_ch5.adb (Expand_Iterator_Loop_Over_Array): Inherit the
	loop label form the original loop regardless of whether it came
	from source.
	* sem_attr.adb (Analyze_Attribute): When taking 'Access of an
	expression function with a generated body that has not been
	analyzed yet, analyze the body to freeze the expression.
	* sem_util.adb (Set_Public_Status_Of): New routine.
	(Transfer_Entities): Handle the case where a private type with
	an internally generated full view is being transfered and update
	its full view.

2014-11-20  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Check_Object): If a unit is in a multi-source
	file, its object file is never the same as any other unit.

2014-11-20  Bob Duff  <duff@adacore.com>

	* s-taskin.adb (Initialize_ATCB): Take into
	account the fact that the domain of the activator can be null
	if we're initializing a foreign task.

From-SVN: r217877

7 files changed, 164 insertions, 80 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a363967..45870c3 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,31 @@
+2014-11-20  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch3.adb (Build_Initialization_Call): Reimplement the
+	circuitry which extraacts the [underlying] full view of a
+	private type to handle a case where the private type acts as a
+	generic actual.
+	* exp_ch5.adb (Expand_Iterator_Loop_Over_Array): Inherit the
+	loop label form the original loop regardless of whether it came
+	from source.
+	* sem_attr.adb (Analyze_Attribute): When taking 'Access of an
+	expression function with a generated body that has not been
+	analyzed yet, analyze the body to freeze the expression.
+	* sem_util.adb (Set_Public_Status_Of): New routine.
+	(Transfer_Entities): Handle the case where a private type with
+	an internally generated full view is being transfered and update
+	its full view.
+
+2014-11-20  Vincent Celier  <celier@adacore.com>
+
+	* prj-nmsc.adb (Check_Object): If a unit is in a multi-source
+	file, its object file is never the same as any other unit.
+
+2014-11-20  Bob Duff  <duff@adacore.com>
+
+	* s-taskin.adb (Initialize_ATCB): Take into
+	account the fact that the domain of the activator can be null
+	if we're initializing a foreign task.
+
 2014-11-20  Robert Dewar  <dewar@adacore.com>
 
 	* sem_ch12.adb: Minor reformatting.
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 0e6c8dd..8bbbdc3 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -1459,7 +1459,7 @@ package body Exp_Ch3 is
       Discr          : Entity_Id;
       First_Arg      : Node_Id;
       Full_Init_Type : Entity_Id;
-      Full_Type      : Entity_Id := Typ;
+      Full_Type      : Entity_Id;
       Init_Type      : Entity_Id;
       Proc           : Entity_Id;
 
@@ -1490,20 +1490,38 @@ package body Exp_Ch3 is
          return Empty_List;
       end if;
 
-      --  Go to full view or underlying full view if private type. In the case
-      --  of successive private derivations, this can require two steps.
+      Full_Type := Typ;
 
-      if Is_Private_Type (Full_Type)
-        and then Present (Full_View (Full_Type))
-      then
-         Full_Type := Full_View (Full_Type);
-      end if;
+      --  Use the [underlying] full view when dealing with a private type. This
+      --  may require several steps depending on derivations.
 
-      if Is_Private_Type (Full_Type)
-        and then Present (Underlying_Full_View (Full_Type))
-      then
-         Full_Type := Underlying_Full_View (Full_Type);
-      end if;
+      loop
+         if Is_Private_Type (Full_Type) then
+            if Present (Full_View (Full_Type)) then
+               Full_Type := Full_View (Full_Type);
+
+            elsif Present (Underlying_Full_View (Full_Type)) then
+               Full_Type := Underlying_Full_View (Full_Type);
+
+            --  When a private type acts as a generic actual and lacks a full
+            --  view, use the base type.
+
+            elsif Is_Generic_Actual_Type (Full_Type) then
+               Full_Type := Base_Type (Full_Type);
+
+            --  The loop has recovered the [underlying] full view, stop the
+            --  traversal.
+
+            else
+               exit;
+            end if;
+
+         --  The type is not private, nothing to do
+
+         else
+            exit;
+         end if;
+      end loop;
 
       --  If Typ is derived, the procedure is the initialization procedure for
       --  the root type. Wrap the argument in an conversion to make it type
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index e66a5836..fc6141a 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -3766,14 +3766,10 @@ package body Exp_Ch5 is
          end loop;
       end if;
 
-      --  If original loop has a source name, preserve it so it can be
-      --  recognized by an exit statement in the body of the rewritten loop.
-      --  This only concerns source names: the generated name of an anonymous
-      --  loop will be create again during the subsequent analysis below.
+      --  Inherit the loop identifier from the original loop. This ensures that
+      --  the scope stack is consistent after the rewriting.
 
-      if Present (Identifier (N))
-        and then Comes_From_Source (Identifier (N))
-      then
+      if Present (Identifier (N)) then
          Set_Identifier (Core_Loop, Relocate_Node (Identifier (N)));
       end if;
 
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index b4dd798..3bfe2d8 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -2577,7 +2577,7 @@ package body Prj.Nmsc is
             Error_Msg_Name_1 := Lang_Index.Display_Name;
             Error_Msg
               (Data.Flags,
-               "?no compiler specified for language %%" &
+               "?\no compiler specified for language %%" &
                  ", ignoring all its sources",
                No_Location, Project);
 
@@ -2604,7 +2604,7 @@ package body Prj.Nmsc is
             if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
                Error_Msg
                  (Data.Flags,
-                  "Spec_Suffix not specified for " &
+                  "\Spec_Suffix not specified for " &
                   Get_Name_String (Lang_Index.Name),
                   No_Location, Project);
             end if;
@@ -2612,7 +2612,7 @@ package body Prj.Nmsc is
             if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
                Error_Msg
                  (Data.Flags,
-                  "Body_Suffix not specified for " &
+                  "\Body_Suffix not specified for " &
                   Get_Name_String (Lang_Index.Name),
                   No_Location, Project);
             end if;
@@ -2630,7 +2630,7 @@ package body Prj.Nmsc is
                Error_Msg_Name_1 := Lang_Index.Display_Name;
                Error_Msg
                  (Data.Flags,
-                  "no suffixes specified for %%",
+                  "\no suffixes specified for %%",
                   No_Location, Project);
             end if;
          end if;
@@ -3770,7 +3770,7 @@ package body Prj.Nmsc is
                if Switches /= No_Array_Element then
                   Error_Msg
                     (Data.Flags,
-                     "?Linker switches not taken into account in library " &
+                     "?\Linker switches not taken into account in library " &
                      "projects",
                      No_Location, Project);
                end if;
@@ -6793,7 +6793,7 @@ package body Prj.Nmsc is
                         Error_Msg_Name_2 := Source.Unit.Name;
                         Error_Or_Warning
                           (Data.Flags, Data.Flags.Missing_Source_Files,
-                           "source file %% for unit %% not found",
+                           "\source file %% for unit %% not found",
                            No_Location, Project.Project);
                      end if;
                   end if;
@@ -7789,7 +7789,7 @@ package body Prj.Nmsc is
             Error_Msg_File_1 := Source.File;
             Error_Msg
               (Data.Flags,
-               "{ cannot be both excluded and an exception file name",
+               "\{ cannot be both excluded and an exception file name",
                No_Location, Project.Project);
          end if;
 
@@ -7936,13 +7936,15 @@ package body Prj.Nmsc is
          if Source /= No_Source
            and then Source.Replaced_By = No_Source
            and then Source.Path /= Src.Path
+           and then Source.Index = 0
+           and then Src.Index = 0
            and then Is_Extending (Src.Project, Source.Project)
          then
             Error_Msg_File_1 := Src.File;
             Error_Msg_File_2 := Source.File;
             Error_Msg
               (Data.Flags,
-               "{ and { have the same object file name",
+               "\{ and { have the same object file name",
                No_Location, Project.Project);
 
          else
diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb
index 310873b..1c18a89 100644
--- a/gcc/ada/s-taskin.adb
+++ b/gcc/ada/s-taskin.adb
@@ -118,10 +118,17 @@ package body System.Tasking is
       T.Common.Base_Priority            := Base_Priority;
       T.Common.Base_CPU                 := Base_CPU;
 
-      --  The Domain defaults to that of the activator
-
-      T.Common.Domain                   :=
-        (if Domain = null then Self_ID.Common.Domain else Domain);
+      --  The Domain defaults to that of the activator. But that can be null in
+      --  the case of foreign threads (see Register_Foreign_Thread), in which
+      --  case we default to the System_Domain.
+
+      if Domain /= null then
+         T.Common.Domain := Domain;
+      elsif Self_ID.Common.Domain /= null then
+         T.Common.Domain := Self_ID.Common.Domain;
+      else
+         T.Common.Domain := System_Domain;
+      end if;
       pragma Assert (T.Common.Domain /= null);
 
       T.Common.Current_Priority         := 0;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index e805314..7ff7939 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -10517,10 +10517,8 @@ package body Sem_Attr is
                   Scop      : constant Entity_Id := Scope (Subp_Id);
                   Subp_Decl : constant Node_Id   :=
                                 Unit_Declaration_Node (Subp_Id);
-
-                  Flag_Id : Entity_Id;
-                  HSS     : Node_Id;
-                  Stmt    : Node_Id;
+                  Flag_Id   : Entity_Id;
+                  Subp_Body : Node_Id;
 
                --  If the access has been taken and the body of the subprogram
                --  has not been see yet, indirect calls must be protected with
@@ -10571,24 +10569,20 @@ package body Sem_Attr is
                   --  generated body is immediately analyzed and the expression
                   --  is automatically frozen.
 
-                  if Ekind (Subp_Id) = E_Function
-                    and then Nkind (Subp_Decl) = N_Subprogram_Declaration
-                    and then Nkind (Original_Node (Subp_Decl)) =
-                                                        N_Expression_Function
+                  if Is_Expression_Function (Subp_Id)
                     and then Present (Corresponding_Body (Subp_Decl))
-                    and then not Analyzed (Corresponding_Body (Subp_Decl))
                   then
-                     HSS :=
-                       Handled_Statement_Sequence
-                         (Unit_Declaration_Node
-                            (Corresponding_Body (Subp_Decl)));
+                     Subp_Body :=
+                       Unit_Declaration_Node (Corresponding_Body (Subp_Decl));
 
-                     if Present (HSS) then
-                        Stmt := First (Statements (HSS));
+                     --  Analyze the body of the expression function to freeze
+                     --  the expression. This takes care of the case where the
+                     --  'Access is part of dispatch table initialization and
+                     --  the generated body of the expression function has not
+                     --  been analyzed yet.
 
-                        if Nkind (Stmt) = N_Simple_Return_Statement then
-                           Freeze_Expression (Expression (Stmt));
-                        end if;
+                     if not Analyzed (Subp_Body) then
+                        Analyze (Subp_Body);
                      end if;
                   end if;
                end;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index cc8679c..3ae7058 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -17619,48 +17619,87 @@ package body Sem_Util is
    -----------------------
 
    procedure Transfer_Entities (From : Entity_Id; To : Entity_Id) is
-      Ent : Entity_Id := First_Entity (From);
+      procedure Set_Public_Status_Of (Id : Entity_Id);
+      --  Set the Is_Public attribute of arbitrary entity Id by calling routine
+      --  Set_Public_Status. If successfull and Id denotes a record type, set
+      --  the Is_Public attribute of its fields.
+
+      --------------------------
+      -- Set_Public_Status_Of --
+      --------------------------
+
+      procedure Set_Public_Status_Of (Id : Entity_Id) is
+         Field : Entity_Id;
+
+      begin
+         if not Is_Public (Id) then
+            Set_Public_Status (Id);
+
+            --  When the input entity is a public record type, ensure that all
+            --  its internal fields are also exposed to the linker. The fields
+            --  of a class-wide type are never made public.
+
+            if Is_Public (Id)
+              and then Is_Record_Type (Id)
+              and then not Is_Class_Wide_Type (Id)
+            then
+               Field := First_Entity (Id);
+               while Present (Field) loop
+                  Set_Is_Public (Field);
+                  Next_Entity (Field);
+               end loop;
+            end if;
+         end if;
+      end Set_Public_Status_Of;
+
+      --  Local variables
+
+      Full_Id : Entity_Id;
+      Id      : Entity_Id;
+
+   --  Start of processing for Transfer_Entities
 
    begin
-      if No (Ent) then
-         return;
-      end if;
+      Id := First_Entity (From);
 
-      if (Last_Entity (To)) = Empty then
-         Set_First_Entity (To, Ent);
-      else
-         Set_Next_Entity (Last_Entity (To), Ent);
-      end if;
+      if Present (Id) then
 
-      Set_Last_Entity (To, Last_Entity (From));
+         --  Merge the entity chain of the source scope with that of the
+         --  destination scope.
 
-      while Present (Ent) loop
-         Set_Scope (Ent, To);
+         if Present (Last_Entity (To)) then
+            Set_Next_Entity (Last_Entity (To), Id);
+         else
+            Set_First_Entity (To, Id);
+         end if;
 
-         if not Is_Public (Ent) then
-            Set_Public_Status (Ent);
+         Set_Last_Entity (To, Last_Entity (From));
 
-            if Is_Public (Ent) and then Ekind (Ent) = E_Record_Subtype then
+         --  Inspect the entities of the source scope and update their Scope
+         --  attribute.
 
-               --  The components of the propagated Itype must also be public
+         while Present (Id) loop
+            Set_Scope            (Id, To);
+            Set_Public_Status_Of (Id);
 
-               declare
-                  Comp : Entity_Id;
-               begin
-                  Comp := First_Entity (Ent);
-                  while Present (Comp) loop
-                     Set_Is_Public (Comp);
-                     Next_Entity (Comp);
-                  end loop;
-               end;
+            --  Handle an internally generated full view for a private type
+
+            if Is_Private_Type (Id)
+              and then Present (Full_View (Id))
+              and then Is_Itype (Full_View (Id))
+            then
+               Full_Id := Full_View (Id);
+
+               Set_Scope            (Full_Id, To);
+               Set_Public_Status_Of (Full_Id);
             end if;
-         end if;
 
-         Next_Entity (Ent);
-      end loop;
+            Next_Entity (Id);
+         end loop;
 
-      Set_First_Entity (From, Empty);
-      Set_Last_Entity (From, Empty);
+         Set_First_Entity (From, Empty);
+         Set_Last_Entity  (From, Empty);
+      end if;
    end Transfer_Entities;
 
    -----------------------