+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.
-- 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
-- No_Predicate_On_Actual Flag275
-- No_Dynamic_Predicate_On_Actual Flag276
- -- (unused) Flag134
-
-- (unused) Flag275
-- (unused) Flag276
-- (unused) Flag277
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));
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
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));
-- 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
-- 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)
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;
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);
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);
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);
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
Ekind (Non_Limited_View (R_Type)) = E_Incomplete_Type
then
Set_Is_Frozen (E, False);
+ Set_Returns_Limited_View (E);
return Result;
end if;
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;
projects / thirdparty / gcc.git / commitdiff
