[multiple changes]

2015-05-22  Ed Schonberg  <schonberg@adacore.com>

	* einfo.ads, einfo.adb (Incomplete_Actuals): New attribute of
	package instantiations. Holds the list of actuals in the instance
	that are incomplete types, to determine where the corresponding
	instance body must be placed.
	* sem_ch6.adb (Conforming_Types): An incomplete type used as an
	actual in an instance matches an incomplete formal.
	* sem_disp.adb (Check_Dispatching_Call): Handle missing case of
	explicit dereference.
	(Inherited_Subprograms): In the presence of a limited view there
	are no subprograms to inherit.
	* sem_ch12.adb (Preanalyze_Actuals): Build list of incomplete
	actuals of instance, for later placement of instance body and
	freeze nodes for actuals.
	(Install_Body): In the presence of actuals that incomplete types
	from a limited view, the instance body cannot be placed after
	the declaration because full views have not been seen yet. Any
	use of the non-limited views in the instance body requires
	the presence of a regular with_clause in the enclosing unit,
	and will fail if this with_clause is missing.  We place the
	instance body at the beginning of the enclosing body, which is
	the unit being compiled, and ensure that freeze nodes for the
	full views of the incomplete types appear before the instance.

2015-05-22  Pascal Obry  <obry@adacore.com>

	* makeutl.ads, prj-conf.adb, prj-nmsc.adb, prj.ads
	(In_Place_Option): Removed.
	(Relocate_Build_Tree_Option): New constant.
	(Root_Dir_Option): New constant.
	(Obj_Root_Dir): Removed.
	(Build_Tree_Dir): New variable.
	(Root_Src_Tree): Removed.
	(Root_Dir): New variable.
	* prj-conf.adb (Get_Or_Create_Configuration_File): Add check
	for improper relocation.
	* prj-nmsc.adb (Locate_Directory): Add check for improper
	relocation.

From-SVN: r223553

10 files changed, 241 insertions, 30 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 87519d8..3777b63 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,43 @@
+2015-05-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* einfo.ads, einfo.adb (Incomplete_Actuals): New attribute of
+	package instantiations. Holds the list of actuals in the instance
+	that are incomplete types, to determine where the corresponding
+	instance body must be placed.
+	* sem_ch6.adb (Conforming_Types): An incomplete type used as an
+	actual in an instance matches an incomplete formal.
+	* sem_disp.adb (Check_Dispatching_Call): Handle missing case of
+	explicit dereference.
+	(Inherited_Subprograms): In the presence of a limited view there
+	are no subprograms to inherit.
+	* sem_ch12.adb (Preanalyze_Actuals): Build list of incomplete
+	actuals of instance, for later placement of instance body and
+	freeze nodes for actuals.
+	(Install_Body): In the presence of actuals that incomplete types
+	from a limited view, the instance body cannot be placed after
+	the declaration because full views have not been seen yet. Any
+	use of the non-limited views in the instance body requires
+	the presence of a regular with_clause in the enclosing unit,
+	and will fail if this with_clause is missing.  We place the
+	instance body at the beginning of the enclosing body, which is
+	the unit being compiled, and ensure that freeze nodes for the
+	full views of the incomplete types appear before the instance.
+
+2015-05-22  Pascal Obry  <obry@adacore.com>
+
+	* makeutl.ads, prj-conf.adb, prj-nmsc.adb, prj.ads
+	(In_Place_Option): Removed.
+	(Relocate_Build_Tree_Option): New constant.
+	(Root_Dir_Option): New constant.
+	(Obj_Root_Dir): Removed.
+	(Build_Tree_Dir): New variable.
+	(Root_Src_Tree): Removed.
+	(Root_Dir): New variable.
+	* prj-conf.adb (Get_Or_Create_Configuration_File): Add check
+	for improper relocation.
+	* prj-nmsc.adb (Locate_Directory): Add check for improper
+	relocation.
+
 2015-05-22  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* einfo.adb (Default_Init_Cond_Procedure): Code cleanup. The
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index ce0eb4a..bcbf20f 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -212,6 +212,7 @@ package body Einfo is
    --    Protection_Object               Node23
    --    Stored_Constraint               Elist23
 
+   --    Incomplete_Actuals              Elist24
    --    Related_Expression              Node24
    --    Subps_Index                     Uint24
 
@@ -1878,6 +1879,12 @@ package body Einfo is
       return Node35 (Id);
    end Import_Pragma;
 
+   function Incomplete_Actuals (Id : E) return L is
+   begin
+      pragma Assert (Ekind (Id) = E_Package);
+      return Elist24 (Id);
+   end Incomplete_Actuals;
+
    function Interface_Alias (Id : E) return E is
    begin
       pragma Assert (Is_Subprogram (Id));
@@ -4765,6 +4772,12 @@ package body Einfo is
       Set_Node4 (Id, V);
    end Set_Homonym;
 
+   procedure Set_Incomplete_Actuals (Id : E; V : L) is
+   begin
+      pragma Assert (Ekind (Id) = E_Package);
+      Set_Elist24 (Id, V);
+   end Set_Incomplete_Actuals;
+
    procedure Set_Import_Pragma (Id : E; V : E) is
    begin
       pragma Assert (Is_Subprogram (Id));
@@ -9801,6 +9814,9 @@ package body Einfo is
               E_Procedure                                  =>
             Write_Str ("Subps_Index");
 
+         when E_Package                                    =>
+            Write_Str ("Incomplete_Actuals");
+
          when others                                       =>
             Write_Str ("Field24???");
       end case;
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 1fe9d7d..550294f 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2090,6 +2090,13 @@ package Einfo is
 --       Rep_Item chain mechanism, because a single pragma Import can apply
 --       to multiple subprogram entities).
 
+--    Incomplete_Actuals (Elist24)
+--       Defined on package entities that are instances. Indicates the actusl
+--       types in the instantiation that are limited views. IF this list is
+--       not empty, the instantiation, which appears in a package declaration,
+--       is relocated to the corresponding package body, which must have a
+--       corresponding non-limited with_clause.
+
 --    In_Package_Body (Flag48)
 --       Defined in package entities. Set on the entity that denotes the
 --       package (the defining occurrence of the package declaration) while
@@ -4028,7 +4035,9 @@ package Einfo is
 --       length objects). It is set conservatively (i.e. if it is True, the
 --       size is certainly known at compile time, if it is False, then the
 --       size may or may not be known at compile time, but the code will
---       assume that it is not known).
+--       assume that it is not known). Note that the value may be known only
+--       to the back end, so the fact that this flag is set does not mean that
+--       the front end can access the value.
 
 --    Small_Value (Ureal21)
 --       Defined in fixed point types. Points to the universal real for the
@@ -6042,6 +6051,7 @@ package Einfo is
    --    Generic_Renamings                   (Elist23)  (for an instance)
    --    Inner_Instances                     (Elist23)  (generic case only)
    --    Limited_View                        (Node23)   (non-generic/instance)
+   --    Incomplete_Actuals                  (Elist24)  (for an instance)
    --    Abstract_States                     (Elist25)
    --    Package_Instantiation               (Node26)
    --    Current_Use_Clause                  (Node27)
@@ -6840,6 +6850,7 @@ package Einfo is
    function Hiding_Loop_Variable                (Id : E) return E;
    function Homonym                             (Id : E) return E;
    function Import_Pragma                       (Id : E) return E;
+   function Incomplete_Actuals                  (Id : E) return L;
    function In_Package_Body                     (Id : E) return B;
    function In_Private_Part                     (Id : E) return B;
    function In_Use                              (Id : E) return B;
@@ -7492,6 +7503,7 @@ package Einfo is
    procedure Set_Hiding_Loop_Variable            (Id : E; V : E);
    procedure Set_Homonym                         (Id : E; V : E);
    procedure Set_Import_Pragma                   (Id : E; V : E);
+   procedure Set_Incomplete_Actuals              (Id : E; V : L);
    procedure Set_In_Package_Body                 (Id : E; V : B := True);
    procedure Set_In_Private_Part                 (Id : E; V : B := True);
    procedure Set_In_Use                          (Id : E; V : B := True);
@@ -8265,6 +8277,7 @@ package Einfo is
    pragma Inline (Hiding_Loop_Variable);
    pragma Inline (Homonym);
    pragma Inline (Import_Pragma);
+   pragma Inline (Incomplete_Actuals);
    pragma Inline (In_Package_Body);
    pragma Inline (In_Private_Part);
    pragma Inline (In_Use);
@@ -8763,6 +8776,7 @@ package Einfo is
    pragma Inline (Set_Hiding_Loop_Variable);
    pragma Inline (Set_Homonym);
    pragma Inline (Set_Import_Pragma);
+   pragma Inline (Set_Incomplete_Actuals);
    pragma Inline (Set_In_Package_Body);
    pragma Inline (Set_In_Private_Part);
    pragma Inline (Set_In_Use);
diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads
index 5a318aa..45442c8 100644
--- a/gcc/ada/makeutl.ads
+++ b/gcc/ada/makeutl.ads
@@ -66,9 +66,17 @@ package Makeutl is
    --  Switch used to indicate that the real directories (object, exec,
    --  library, ...) are subdirectories of those in the project file.
 
-   In_Place_Option : constant String := "--in-place";
+   Relocate_Build_Tree_Option : constant String := "--relocate-build-tree";
    --  Switch to build out-of-tree. In this context the object, exec and
-   --  library directories are relocated to the current working directory.
+   --  library directories are relocated to the current working directory
+   --  or the directory specified as parameter to this option.
+
+   Root_Dir_Option : constant String := "--root-dir";
+   --  The root directory under which all artifacts (objects, library, ali)
+   --  directory are to be found for the current compilation. This directory
+   --  will be use to relocate artifacts based on this directory. If this
+   --  option is not specificed the default value is the directory of the
+   --  main project.
 
    Unchecked_Shared_Lib_Imports : constant String :=
                                     "--unchecked-shared-lib-imports";
diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb
index 29217a7..8c55f2a 100644
--- a/gcc/ada/prj-conf.adb
+++ b/gcc/ada/prj-conf.adb
@@ -962,19 +962,27 @@ package body Prj.Conf is
 
          --  First, find the object directory of the Conf_Project
 
-         --  If the object directory is a relative one and Obj_Root_Dir is set,
-         --  first add it.
+         --  If the object directory is a relative one and Build_Tree_Dir is
+         --  set, first add it.
 
          Name_Len := 0;
 
          if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
 
-            if Obj_Root_Dir /= null then
-               Add_Str_To_Name_Buffer (Obj_Root_Dir.all);
+            if Build_Tree_Dir /= null then
+               Add_Str_To_Name_Buffer (Build_Tree_Dir.all);
+
+               if Get_Name_String (Conf_Project.Directory.Display_Name)'Length
+                 < Root_Dir'Length
+               then
+                  Raise_Invalid_Config
+                    ("cannot relocate deeper than object directory");
+               end if;
+
                Add_Str_To_Name_Buffer
                  (Relative_Path
                     (Get_Name_String (Conf_Project.Directory.Display_Name),
-                     Root_Src_Tree.all));
+                     Root_Dir.all));
             else
                Get_Name_String (Conf_Project.Directory.Display_Name);
             end if;
@@ -984,12 +992,20 @@ package body Prj.Conf is
                Get_Name_String (Obj_Dir.Value);
 
             else
-               if Obj_Root_Dir /= null then
-                  Add_Str_To_Name_Buffer (Obj_Root_Dir.all);
+               if Build_Tree_Dir /= null then
+                  if Get_Name_String
+                    (Conf_Project.Directory.Display_Name)'Length
+                    < Root_Dir'Length
+                  then
+                     Raise_Invalid_Config
+                       ("cannot relocate deeper than object directory");
+                  end if;
+
+                  Add_Str_To_Name_Buffer (Build_Tree_Dir.all);
                   Add_Str_To_Name_Buffer
                     (Relative_Path
                        (Get_Name_String (Conf_Project.Directory.Display_Name),
-                        Root_Src_Tree.all));
+                        Root_Dir.all));
                else
                   Add_Str_To_Name_Buffer
                     (Get_Name_String (Conf_Project.Directory.Display_Name));
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 5d209ec..a34b5a1 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -5589,8 +5589,8 @@ package body Prj.Nmsc is
             end if;
          end if;
 
-      elsif not No_Sources
-        and then (Subdirs /= null or else Obj_Root_Dir /= null)
+      elsif not No_Sources and then
+        (Subdirs /= null or else Build_Tree_Dir /= null)
       then
          Name_Len := 1;
          Name_Buffer (1) := '.';
@@ -6209,21 +6209,29 @@ package body Prj.Nmsc is
       --  Check if we have a root-object dir specified, if so relocate all
       --  artefact directories to it.
 
-      if Obj_Root_Dir /= null
+      if Build_Tree_Dir /= null
         and then Create /= ""
         and then not Is_Absolute_Path (Get_Name_String (Name))
       then
          Name_Len := 0;
-         Add_Str_To_Name_Buffer (Obj_Root_Dir.all);
+         Add_Str_To_Name_Buffer (Build_Tree_Dir.all);
+
+         if The_Parent_Last - The_Parent'First  + 1 < Root_Dir'Length then
+            Err_Vars.Error_Msg_File_1 := Name;
+            Error_Or_Warning
+              (Data.Flags, Error,
+               "{ cannot relocate deeper than " & Create & " directory",
+               No_Location, Project);
+         end if;
+
          Add_Str_To_Name_Buffer
            (Relative_Path
               (The_Parent (The_Parent'First .. The_Parent_Last),
-               Root_Src_Tree.all));
+               Root_Dir.all));
          Add_Str_To_Name_Buffer (Get_Name_String (Name));
 
       else
-         if Obj_Root_Dir /= null and then Create /= "" then
-
+         if Build_Tree_Dir /= null and then Create /= "" then
             --  Issue a warning that we cannot relocate absolute obj dir
 
             Err_Vars.Error_Msg_File_1 := Name;
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index 4910331..29a718e 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -61,16 +61,14 @@ package Prj is
    --  The value after the equal sign in switch --subdirs=...
    --  Contains the relative subdirectory.
 
-   Obj_Root_Dir : String_Ptr := null;
+   Build_Tree_Dir : String_Ptr := null;
    --  A root directory for building out-of-tree projects. All relative object
-   --  directories will be rooted at this location. If Subdirs is also set it
-   --  will be added at the end too.
+   --  directories will be rooted at this location.
 
-   Root_Src_Tree : String_Ptr := null;
+   Root_Dir : String_Ptr := null;
    --  When using out-of-tree build we need to keep information about the root
-   --  directory source tree to properly relocate all projects to this root
-   --  directory. Note that the root source directory is not necessary the
-   --  directory of the main project.
+   --  directory of artifacts to properly relocate them. Note that the root
+   --  directory is not necessary the directory of the main project.
 
    type Library_Support is (None, Static_Only, Full);
    --  Support for Library Project File.
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index fca3856..12f76b3 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -825,11 +825,14 @@ package body Sem_Ch12 is
    --  at the end of the enclosing generic package, which is semantically
    --  neutral.
 
-   procedure Preanalyze_Actuals (N : Node_Id);
+   procedure Preanalyze_Actuals (N : Node_Id; Inst : Entity_Id := Empty);
    --  Analyze actuals to perform name resolution. Full resolution is done
    --  later, when the expected types are known, but names have to be captured
    --  before installing parents of generics, that are not visible for the
    --  actuals themselves.
+   --  If Inst is present, it is the entity of the package instance. This
+   --  entity is marked as having a limited_view actual when some actual is
+   --  a limited view. This is used to place the instance body properly..
 
    procedure Remove_Parent (In_Body : Boolean := False);
    --  Reverse effect after instantiation of child is complete
@@ -3596,7 +3599,12 @@ package body Sem_Ch12 is
       end if;
 
       Generate_Definition (Act_Decl_Id);
-      Preanalyze_Actuals (N);
+      Set_Ekind (Act_Decl_Id, E_Package);
+
+      --  Initialize list of incomplete actuals before analysis.
+      Set_Incomplete_Actuals (Act_Decl_Id, New_Elmt_List);
+
+      Preanalyze_Actuals (N, Act_Decl_Id);
 
       Init_Env;
       Env_Installed := True;
@@ -8845,6 +8853,66 @@ package body Sem_Ch12 is
    --  Start of processing for Install_Body
 
    begin
+      --  Handle first the case of an instance with incomplete actual types.
+      --  The instance body cannot be placed after the declaration because
+      --  full views have not been seen yet. Any use of the non-limited views
+      --  in the instance body requires the presence of a regular with_clause
+      --  in the enclosing unit, and will fail if this with_clause is missing.
+      --  We place the instance body at the beginning of the enclosing body,
+      --  which is the unit being compiled, and ensure that freeze nodes for
+      --  the full views of the incomplete types appear before the instance.
+
+      if not Is_Empty_Elmt_List (Incomplete_Actuals (Act_Id))
+        and then Expander_Active
+        and then Ekind (Scope (Act_Id)) = E_Package
+      then
+         declare
+            Scop    : constant Entity_Id := Scope (Act_Id);
+            Body_Id : constant Node_Id :=
+                         Corresponding_Body (Unit_Declaration_Node (Scop));
+
+         begin
+            Ensure_Freeze_Node (Act_Id);
+            F_Node := Freeze_Node (Act_Id);
+            if Present (Body_Id) then
+               Set_Is_Frozen (Act_Id);
+               Prepend (Act_Body, Declarations (Parent (Body_Id)));
+            end if;
+
+            --  Add freeze nodes of formerly incomplete types ahead of
+            --  the instance body.
+
+            declare
+               Elmt    : Elmt_Id;
+               F_T     : Node_Id;
+               Typ     : Entity_Id;
+
+            begin
+               Elmt := First_Elmt (Incomplete_Actuals (Act_Id));
+               while Present (Elmt) loop
+                  Typ := Node (Elmt);
+                  if From_Limited_With (Typ) then
+                     Typ := Non_Limited_View (Typ);
+                  end if;
+                  Ensure_Freeze_Node (Typ);
+                  F_T := Freeze_Node (Typ);
+
+                  --  If freeze node is already in the tree, remove it
+                  --  and place ahead of instance body.
+
+                  if Is_List_Member (F_T) then
+                     Remove (F_T);
+                  end if;
+
+                  Prepend (F_T, Declarations (Parent (Body_Id)));
+                  Next_Elmt (Elmt);
+               end loop;
+            end;
+         end;
+
+         return;
+      end if;
+
       --  If the body is a subunit, the freeze point is the corresponding stub
       --  in the current compilation, not the subunit itself.
 
@@ -13195,7 +13263,7 @@ package body Sem_Ch12 is
    -- Preanalyze_Actuals --
    ------------------------
 
-   procedure Preanalyze_Actuals (N : Node_Id) is
+   procedure Preanalyze_Actuals (N : Node_Id; Inst : Entity_Id := Empty) is
       Assoc : Node_Id;
       Act   : Node_Id;
       Errs  : constant Int := Serious_Errors_Detected;
@@ -13286,6 +13354,13 @@ package body Sem_Ch12 is
 
             elsif Nkind (Act) /= N_Operator_Symbol then
                Analyze (Act);
+
+               if Is_Entity_Name (Act)
+                 and then  Is_Type (Entity (Act))
+                 and then From_Limited_With (Entity (Act))
+               then
+                  Append_Elmt (Entity (Act), Incomplete_Actuals (Inst));
+               end if;
             end if;
 
             if Errs /= Serious_Errors_Detected then
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index e366af2..e851346 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2822,7 +2822,7 @@ package body Sem_Ch6 is
          procedure Detect_And_Exchange (Id : Entity_Id);
          --  Determine whether Id's type denotes an incomplete type associated
          --  with a limited with clause and exchange the limited view with the
-         --  non-limited one.
+         --  non-limited one when available.
 
          -------------------------
          -- Detect_And_Exchange --
@@ -2831,7 +2831,9 @@ package body Sem_Ch6 is
          procedure Detect_And_Exchange (Id : Entity_Id) is
             Typ : constant Entity_Id := Etype (Id);
          begin
-            if From_Limited_With (Typ) and then Has_Non_Limited_View (Typ) then
+            if From_Limited_With (Typ)
+              and then Has_Non_Limited_View (Typ)
+            then
                Set_Etype (Id, Non_Limited_View (Typ));
             end if;
          end Detect_And_Exchange;
@@ -6520,6 +6522,16 @@ package body Sem_Ch6 is
       then
          return Ctype <= Mode_Conformant
            or else Subtypes_Statically_Match (Type_1, Full_View (Type_2));
+
+      --  In Ada2012, incomplete types (including limited views) can appear
+      --  as actuals in instantiations.
+
+      elsif Is_Incomplete_Type (Type_1)
+        and then Is_Incomplete_Type (Type_2)
+        and then (Used_As_Generic_Actual (Type_1)
+                   or else Used_As_Generic_Actual (Type_2))
+      then
+         return True;
       end if;
 
       --  Ada 2005 (AI-254): Anonymous access-to-subprogram types must be
@@ -6610,6 +6622,15 @@ package body Sem_Ch6 is
                   end;
                end if;
 
+            --  A limited view of an actual matches the corresponding
+            --  incomplete formal.
+
+            elsif Ekind (Desig_2) = E_Incomplete_Subtype
+              and then From_Limited_With (Desig_2)
+              and then Used_As_Generic_Actual (Etype (Desig_2))
+            then
+               return True;
+
             else
                return Base_Type (Desig_1) = Base_Type (Desig_2)
                 and then (Ctype = Type_Conformant
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 4bc21f7..273b0cd 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -823,6 +823,13 @@ package body Sem_Disp is
                   then
                      Func := Empty;
 
+                  --  Ditto if it is an explicit dereference.
+
+                  elsif
+                    Nkind (Original_Node (Actual)) = N_Explicit_Dereference
+                  then
+                     Func := Empty;
+
                   --  Only other possibility is a qualified expression whose
                   --  constituent expression is itself a call.
 
@@ -2125,6 +2132,14 @@ package body Sem_Disp is
             begin
                Tag_Typ := Find_Dispatching_Type (S);
 
+               --  In the presence of limited views there may be no visible
+               --  dispatching type. Primitives will be inherited when non-
+               --  limited view is frozen.
+
+               if No (Tag_Typ) then
+                  return Result (1 .. 0);
+               end if;
+
                if Is_Concurrent_Type (Tag_Typ) then
                   Tag_Typ := Corresponding_Record_Type (Tag_Typ);
                end if;