FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
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
This commit is contained in:
Arnaud Charlet 2014-08-04 12:39:54 +02:00
parent d10bb9d501
commit a4b07ff0af
5 changed files with 46 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
gcc/ada/ChangeLog
View file

@ -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.

14
gcc/ada/einfo.adb
View file

@ -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));

11
gcc/ada/einfo.ads
View file

@ -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);

9
gcc/ada/freeze.adb
View file

@ -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;

16
gcc/ada/sem_ch3.adb
View file

@ -6903,19 +6903,15 @@ package body Sem_Ch3 is
return;
end if;
-- 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;
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.
Build_Full_Derivation;
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;