[multiple changes]

2014-08-04  Ed Schonberg  <schonberg@adacore.com>

	* einfo.ads, einfo.adb (Returns_Limited_View): New flag defined
	on function entities whose return type is a limited view.
	* freeze.adb (Freeze_Entity): Use Returns_Limited_View to determine
	where to place the freeze node for a function that returns the
	limited view of a type, when the function is called and frozen
	in a different unit.

2014-08-04  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch3.adb (Build_Derived_Private_Type): Minor code
	refactoring.

From-SVN: r213564

5 files changed, 46 insertions, 18 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7b9017a..c45e77a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+2014-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* einfo.ads, einfo.adb (Returns_Limited_View): New flag defined
+	on function entities whose return type is a limited view.
+	* freeze.adb (Freeze_Entity): Use Returns_Limited_View to determine
+	where to place the freeze node for a function that returns the
+	limited view of a type, when the function is called and frozen
+	in a different unit.
+
+2014-08-04  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* sem_ch3.adb (Build_Derived_Private_Type): Minor code
+	refactoring.
+
 2014-08-04  Robert Dewar  <dewar@adacore.com>
 
 	* gnat_ugn.texi: Clarify documentation on assertions.
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index cecdabe..f3899a9 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -414,6 +414,7 @@ package body Einfo is
    --    No_Pool_Assigned                Flag131
    --    Is_Default_Init_Cond_Procedure  Flag132
    --    Has_Inherited_Default_Init_Cond Flag133
+   --    Returns_Limited_View            Flag134
    --    Has_Aliased_Components          Flag135
    --    No_Strict_Aliasing              Flag136
    --    Is_Machine_Code_Subprogram      Flag137
@@ -572,8 +573,6 @@ package body Einfo is
    --    No_Predicate_On_Actual          Flag275
    --    No_Dynamic_Predicate_On_Actual  Flag276
 
-   --    (unused)                        Flag134
-
    --    (unused)                        Flag275
    --    (unused)                        Flag276
    --    (unused)                        Flag277
@@ -2871,6 +2870,11 @@ package body Einfo is
       return Flag90 (Id);
    end Returns_By_Ref;
 
+   function Returns_Limited_View (Id : E) return B is
+   begin
+      return Flag134 (Id);
+   end Returns_Limited_View;
+
    function Reverse_Bit_Order (Id : E) return B is
    begin
       pragma Assert (Is_Record_Type (Id));
@@ -5695,6 +5699,11 @@ package body Einfo is
       Set_Flag90 (Id, V);
    end Set_Returns_By_Ref;
 
+   procedure Set_Returns_Limited_View (Id : E; V : B := True) is
+   begin
+      Set_Flag134 (Id, V);
+   end Set_Returns_Limited_View;
+
    procedure Set_Reverse_Bit_Order (Id : E; V : B := True) is
    begin
       pragma Assert
@@ -8552,6 +8561,7 @@ package body Einfo is
       W ("Requires_Overriding",             Flag213 (Id));
       W ("Return_Present",                  Flag54  (Id));
       W ("Returns_By_Ref",                  Flag90  (Id));
+      W ("Returns_Limited_View",            Flag134 (Id));
       W ("Reverse_Bit_Order",               Flag164 (Id));
       W ("Reverse_Storage_Order",           Flag93  (Id));
       W ("Sec_Stack_Needed_For_Return",     Flag167 (Id));
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 23516be..14bb0d0 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3771,6 +3771,12 @@ package Einfo is
 --       returns the result by reference, either because its return type is a
 --       by-reference-type or because it uses explicitly the secondary stack.
 
+--    Returns_Limited_View (Flag134)
+--       Defined on function entities, to indicate that the return type of
+--       the function at the point of definition is a limited view. Used to
+--       handle the late freezing of the function, when it is called in the
+--       current semantic unit while it is still unfrozen.
+
 --    Reverse_Bit_Order (Flag164) [base type only]
 --       Defined in all record type entities. Set if entity has a Bit_Order
 --       aspect (set by an aspect clause or attribute definition clause) that
@@ -5710,6 +5716,7 @@ package Einfo is
    --    Requires_Overriding                 (Flag213)  (non-generic case only)
    --    Return_Present                      (Flag54)
    --    Returns_By_Ref                      (Flag90)
+   --    Returns_Limited_View                (Flag134)
    --    Sec_Stack_Needed_For_Return         (Flag167)
    --    SPARK_Pragma_Inherited              (Flag265)
    --    Uses_Sec_Stack                      (Flag95)
@@ -6843,6 +6850,7 @@ package Einfo is
    function Return_Applies_To                   (Id : E) return N;
    function Return_Present                      (Id : E) return B;
    function Returns_By_Ref                      (Id : E) return B;
+   function Returns_Limited_View                (Id : E) return B;
    function Reverse_Bit_Order                   (Id : E) return B;
    function Reverse_Storage_Order               (Id : E) return B;
    function Scalar_Range                        (Id : E) return N;
@@ -7484,6 +7492,7 @@ package Einfo is
    procedure Set_Return_Applies_To               (Id : E; V : N);
    procedure Set_Return_Present                  (Id : E; V : B := True);
    procedure Set_Returns_By_Ref                  (Id : E; V : B := True);
+   procedure Set_Returns_Limited_View            (Id : E; V : B := True);
    procedure Set_Reverse_Bit_Order               (Id : E; V : B := True);
    procedure Set_Reverse_Storage_Order           (Id : E; V : B := True);
    procedure Set_Scalar_Range                    (Id : E; V : N);
@@ -8277,6 +8286,7 @@ package Einfo is
    pragma Inline (Return_Applies_To);
    pragma Inline (Return_Present);
    pragma Inline (Returns_By_Ref);
+   pragma Inline (Returns_Limited_View);
    pragma Inline (Reverse_Bit_Order);
    pragma Inline (Reverse_Storage_Order);
    pragma Inline (Scalar_Range);
@@ -8717,6 +8727,7 @@ package Einfo is
    pragma Inline (Set_Return_Applies_To);
    pragma Inline (Set_Return_Present);
    pragma Inline (Set_Returns_By_Ref);
+   pragma Inline (Set_Returns_Limited_View);
    pragma Inline (Set_Reverse_Bit_Order);
    pragma Inline (Set_Reverse_Storage_Order);
    pragma Inline (Set_Scalar_Range);
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 870cdc2..17f9649 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -4202,12 +4202,8 @@ package body Freeze is
 
                      Late_Freezing :=
                        Get_Source_Unit (E) /= Get_Source_Unit (N)
-                         and then Expander_Active
-                         and then Ekind (Scope (E)) = E_Package
-                         and then Nkind (Unit_Declaration_Node (Scope (E))) =
-                                                       N_Package_Declaration
-                         and then not In_Open_Scopes (Scope (E))
-                         and then Get_Source_Unit (E) /= Current_Sem_Unit;
+                         and then Returns_Limited_View (E)
+                         and then not In_Open_Scopes (Scope (E));
 
                      --  Freeze return type
 
@@ -4237,6 +4233,7 @@ package body Freeze is
                          Ekind (Non_Limited_View (R_Type)) = E_Incomplete_Type
                      then
                         Set_Is_Frozen (E, False);
+                        Set_Returns_Limited_View (E);
                         return Result;
                      end if;
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index ae09b34..94e4510 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -6903,19 +6903,15 @@ package body Sem_Ch3 is
             return;
          end if;
 
-         if not Is_Completion then
-            --  If this is not a completion, construct the implicit full view
-            --  by deriving from the full view of the parent type.
+         --  If this is not a completion, construct the implicit full view by
+         --  deriving from the full view of the parent type. But if this is a
+         --  completion, the derived private type being built is a full view
+         --  and the full derivation can only be its underlying full view.
 
-            Build_Full_Derivation;
+         Build_Full_Derivation;
+         if not Is_Completion then
             Set_Full_View (Derived_Type, Full_Der);
-
          else
-            --  If this is a completion, the full view being built is itself
-            --  private. Construct an underlying full view by deriving from
-            --  the full view of the parent type.
-
-            Build_Full_Derivation;
             Set_Underlying_Full_View (Derived_Type, Full_Der);
          end if;