Commit 4d9446f9 by Eric Botcazou Committed by Eric Botcazou

einfo.ads (Returns_Limited_View): Remove.

	* einfo.ads (Returns_Limited_View): Remove.
	(Set_Returns_Limited_View ): Likewise.
	* einfo.adb (Returns_Limited_View): Likewise.
	(Set_Returns_Limited_View ): Likewise.
	* freeze.adb (Late_Freeze_Subprogram): Remove.
	(Freeze_Entity): Do not defer the freezing of functions returning an
	incomplete type coming from a limited context.

From-SVN: r237121
parent 31ce6157
2016-06-06 Eric Botcazou <ebotcazou@adacore.com> 2016-06-06 Eric Botcazou <ebotcazou@adacore.com>
* einfo.ads (Returns_Limited_View): Remove.
(Set_Returns_Limited_View ): Likewise.
* einfo.adb (Returns_Limited_View): Likewise.
(Set_Returns_Limited_View ): Likewise.
* freeze.adb (Late_Freeze_Subprogram): Remove.
(Freeze_Entity): Do not defer the freezing of functions returning an
incomplete type coming from a limited context.
2016-06-06 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (finish_subprog_decl): Add ASM_NAME parameter. * gcc-interface/gigi.h (finish_subprog_decl): Add ASM_NAME parameter.
* gcc-interface/decl.c (gnu_ext_name_for_subprog): New function. * gcc-interface/decl.c (gnu_ext_name_for_subprog): New function.
(gnat_to_gnu_entity) <E_Subprogram_Type>: Do not check compatibility (gnat_to_gnu_entity) <E_Subprogram_Type>: Do not check compatibility
......
...@@ -432,7 +432,6 @@ package body Einfo is ...@@ -432,7 +432,6 @@ package body Einfo is
-- No_Pool_Assigned Flag131 -- No_Pool_Assigned Flag131
-- Is_Default_Init_Cond_Procedure Flag132 -- Is_Default_Init_Cond_Procedure Flag132
-- Has_Inherited_Default_Init_Cond Flag133 -- Has_Inherited_Default_Init_Cond Flag133
-- Returns_Limited_View Flag134
-- Has_Aliased_Components Flag135 -- Has_Aliased_Components Flag135
-- No_Strict_Aliasing Flag136 -- No_Strict_Aliasing Flag136
-- Is_Machine_Code_Subprogram Flag137 -- Is_Machine_Code_Subprogram Flag137
...@@ -3065,12 +3064,6 @@ package body Einfo is ...@@ -3065,12 +3064,6 @@ package body Einfo is
return Flag90 (Id); return Flag90 (Id);
end Returns_By_Ref; end Returns_By_Ref;
function Returns_Limited_View (Id : E) return B is
begin
pragma Assert (Ekind (Id) = E_Function);
return Flag134 (Id);
end Returns_Limited_View;
function Reverse_Bit_Order (Id : E) return B is function Reverse_Bit_Order (Id : E) return B is
begin begin
pragma Assert (Is_Record_Type (Id)); pragma Assert (Is_Record_Type (Id));
...@@ -6142,12 +6135,6 @@ package body Einfo is ...@@ -6142,12 +6135,6 @@ package body Einfo is
Set_Flag90 (Id, V); Set_Flag90 (Id, V);
end Set_Returns_By_Ref; end Set_Returns_By_Ref;
procedure Set_Returns_Limited_View (Id : E; V : B := True) is
begin
pragma Assert (Ekind (Id) = E_Function);
Set_Flag134 (Id, V);
end Set_Returns_Limited_View;
procedure Set_Reverse_Bit_Order (Id : E; V : B := True) is procedure Set_Reverse_Bit_Order (Id : E; V : B := True) is
begin begin
pragma Assert pragma Assert
...@@ -9141,7 +9128,6 @@ package body Einfo is ...@@ -9141,7 +9128,6 @@ package body Einfo is
W ("Requires_Overriding", Flag213 (Id)); W ("Requires_Overriding", Flag213 (Id));
W ("Return_Present", Flag54 (Id)); W ("Return_Present", Flag54 (Id));
W ("Returns_By_Ref", Flag90 (Id)); W ("Returns_By_Ref", Flag90 (Id));
W ("Returns_Limited_View", Flag134 (Id));
W ("Reverse_Bit_Order", Flag164 (Id)); W ("Reverse_Bit_Order", Flag164 (Id));
W ("Reverse_Storage_Order", Flag93 (Id)); W ("Reverse_Storage_Order", Flag93 (Id));
W ("Rewritten_For_C", Flag287 (Id)); W ("Rewritten_For_C", Flag287 (Id));
......
...@@ -3973,12 +3973,6 @@ package Einfo is ...@@ -3973,12 +3973,6 @@ package Einfo is
-- by reference, either because its return type is a by-reference-type -- by reference, either because its return type is a by-reference-type
-- or because the function explicitly uses the secondary stack. -- or because the function explicitly uses the secondary stack.
-- Returns_Limited_View (Flag134)
-- Defined in function entities. Set if 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] -- Reverse_Bit_Order (Flag164) [base type only]
-- Defined in all record type entities. Set if entity has a Bit_Order -- Defined in all record type entities. Set if entity has a Bit_Order
-- aspect (set by an aspect clause or attribute definition clause) that -- aspect (set by an aspect clause or attribute definition clause) that
...@@ -5972,7 +5966,6 @@ package Einfo is ...@@ -5972,7 +5966,6 @@ package Einfo is
-- Requires_Overriding (Flag213) (non-generic case only) -- Requires_Overriding (Flag213) (non-generic case only)
-- Return_Present (Flag54) -- Return_Present (Flag54)
-- Returns_By_Ref (Flag90) -- Returns_By_Ref (Flag90)
-- Returns_Limited_View (Flag134) (non-generic case only)
-- Rewritten_For_C (Flag287) (generate C code only) -- Rewritten_For_C (Flag287) (generate C code only)
-- Sec_Stack_Needed_For_Return (Flag167) -- Sec_Stack_Needed_For_Return (Flag167)
-- SPARK_Pragma_Inherited (Flag265) -- SPARK_Pragma_Inherited (Flag265)
...@@ -7174,7 +7167,6 @@ package Einfo is ...@@ -7174,7 +7167,6 @@ package Einfo is
function Return_Applies_To (Id : E) return N; function Return_Applies_To (Id : E) return N;
function Return_Present (Id : E) return B; function Return_Present (Id : E) return B;
function Returns_By_Ref (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_Bit_Order (Id : E) return B;
function Reverse_Storage_Order (Id : E) return B; function Reverse_Storage_Order (Id : E) return B;
function Rewritten_For_C (Id : E) return B; function Rewritten_For_C (Id : E) return B;
...@@ -7848,7 +7840,6 @@ package Einfo is ...@@ -7848,7 +7840,6 @@ package Einfo is
procedure Set_Return_Applies_To (Id : E; V : N); procedure Set_Return_Applies_To (Id : E; V : N);
procedure Set_Return_Present (Id : E; V : B := True); procedure Set_Return_Present (Id : E; V : B := True);
procedure Set_Returns_By_Ref (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_Bit_Order (Id : E; V : B := True);
procedure Set_Reverse_Storage_Order (Id : E; V : B := True); procedure Set_Reverse_Storage_Order (Id : E; V : B := True);
procedure Set_Rewritten_For_C (Id : E; V : B := True); procedure Set_Rewritten_For_C (Id : E; V : B := True);
...@@ -8678,7 +8669,6 @@ package Einfo is ...@@ -8678,7 +8669,6 @@ package Einfo is
pragma Inline (Return_Applies_To); pragma Inline (Return_Applies_To);
pragma Inline (Return_Present); pragma Inline (Return_Present);
pragma Inline (Returns_By_Ref); pragma Inline (Returns_By_Ref);
pragma Inline (Returns_Limited_View);
pragma Inline (Reverse_Bit_Order); pragma Inline (Reverse_Bit_Order);
pragma Inline (Reverse_Storage_Order); pragma Inline (Reverse_Storage_Order);
pragma Inline (Rewritten_For_C); pragma Inline (Rewritten_For_C);
...@@ -9143,7 +9133,6 @@ package Einfo is ...@@ -9143,7 +9133,6 @@ package Einfo is
pragma Inline (Set_Return_Applies_To); pragma Inline (Set_Return_Applies_To);
pragma Inline (Set_Return_Present); pragma Inline (Set_Return_Present);
pragma Inline (Set_Returns_By_Ref); pragma Inline (Set_Returns_By_Ref);
pragma Inline (Set_Returns_Limited_View);
pragma Inline (Set_Reverse_Bit_Order); pragma Inline (Set_Reverse_Bit_Order);
pragma Inline (Set_Reverse_Storage_Order); pragma Inline (Set_Reverse_Storage_Order);
pragma Inline (Set_Rewritten_For_C); pragma Inline (Set_Rewritten_For_C);
......
...@@ -1934,9 +1934,6 @@ package body Freeze is ...@@ -1934,9 +1934,6 @@ package body Freeze is
Has_Default_Initialization : Boolean := False; Has_Default_Initialization : Boolean := False;
-- This flag gets set to true for a variable with default initialization -- This flag gets set to true for a variable with default initialization
Late_Freezing : Boolean := False;
-- Used to detect attempt to freeze function declared in another unit
Result : List_Id := No_List; Result : List_Id := No_List;
-- List of freezing actions, left at No_List if none -- List of freezing actions, left at No_List if none
...@@ -1973,9 +1970,8 @@ package body Freeze is ...@@ -1973,9 +1970,8 @@ package body Freeze is
function Freeze_Profile (E : Entity_Id) return Boolean; function Freeze_Profile (E : Entity_Id) return Boolean;
-- Freeze formals and return type of subprogram. If some type in the -- Freeze formals and return type of subprogram. If some type in the
-- profile is a limited view, freezing of the entity will take place -- profile is incomplete and we are in an instance, freezing of the
-- elsewhere, and the function returns False. This routine will be -- entity will take place elsewhere, and the function returns False.
-- modified if and when we can implement AI05-019 efficiently ???
procedure Freeze_Record_Type (Rec : Entity_Id); procedure Freeze_Record_Type (Rec : Entity_Id);
-- Freeze record type, including freezing component types, and freezing -- Freeze record type, including freezing component types, and freezing
...@@ -1985,16 +1981,6 @@ package body Freeze is ...@@ -1985,16 +1981,6 @@ package body Freeze is
-- Determine whether an arbitrary entity is subject to Boolean aspect -- Determine whether an arbitrary entity is subject to Boolean aspect
-- Import and its value is specified as True. -- Import and its value is specified as True.
procedure Late_Freeze_Subprogram (E : Entity_Id);
-- Following AI05-151, a function can return a limited view of a type
-- declared elsewhere. In that case the function cannot be frozen at
-- the end of its enclosing package. If its first use is in a different
-- unit, it cannot be frozen there, but if the call is legal the full
-- view of the return type is available and the subprogram can now be
-- frozen. However the freeze node cannot be inserted at the point of
-- call, but rather must go in the package holding the function, so that
-- the backend can process it in the proper context.
function New_Freeze_Node return Node_Id; function New_Freeze_Node return Node_Id;
-- Create a new freeze node for entity E -- Create a new freeze node for entity E
...@@ -3300,15 +3286,6 @@ package body Freeze is ...@@ -3300,15 +3286,6 @@ package body Freeze is
if Ekind (E) = E_Function then if Ekind (E) = E_Function then
-- Check whether function is declared elsewhere. Previous code
-- used Get_Source_Unit on both arguments, but the values are
-- equal in the case of a parent and a child unit.
-- Confusion with subunits in code ????
Late_Freezing :=
not In_Same_Extended_Unit (E, N)
and then Returns_Limited_View (E);
-- Freeze return type -- Freeze return type
R_Type := Etype (E); R_Type := Etype (E);
...@@ -3326,24 +3303,6 @@ package body Freeze is ...@@ -3326,24 +3303,6 @@ package body Freeze is
then then
R_Type := Full_View (R_Type); R_Type := Full_View (R_Type);
Set_Etype (E, R_Type); Set_Etype (E, R_Type);
-- If the return type is a limited view and the non-limited
-- view is still incomplete, the function has to be frozen at a
-- later time. If the function is abstract there is no place at
-- which the full view will become available, and no code to be
-- generated for it, so mark type as frozen.
elsif Ekind (R_Type) = E_Incomplete_Type
and then From_Limited_With (R_Type)
and then Ekind (Non_Limited_View (R_Type)) = E_Incomplete_Type
then
if Is_Abstract_Subprogram (E) then
null;
else
Set_Is_Frozen (E, False);
Set_Returns_Limited_View (E);
return False;
end if;
end if; end if;
Freeze_And_Append (R_Type, N, Result); Freeze_And_Append (R_Type, N, Result);
...@@ -4613,25 +4572,6 @@ package body Freeze is ...@@ -4613,25 +4572,6 @@ package body Freeze is
return False; return False;
end Has_Boolean_Aspect_Import; end Has_Boolean_Aspect_Import;
----------------------------
-- Late_Freeze_Subprogram --
----------------------------
procedure Late_Freeze_Subprogram (E : Entity_Id) is
Spec : constant Node_Id :=
Specification (Unit_Declaration_Node (Scope (E)));
Decls : List_Id;
begin
if Present (Private_Declarations (Spec)) then
Decls := Private_Declarations (Spec);
else
Decls := Visible_Declarations (Spec);
end if;
Append_List (Result, Decls);
end Late_Freeze_Subprogram;
--------------------- ---------------------
-- New_Freeze_Node -- -- New_Freeze_Node --
--------------------- ---------------------
...@@ -5111,12 +5051,6 @@ package body Freeze is ...@@ -5111,12 +5051,6 @@ package body Freeze is
Freeze_Subprogram (E); Freeze_Subprogram (E);
end if; end if;
if Late_Freezing then
Late_Freeze_Subprogram (E);
Ghost_Mode := Save_Ghost_Mode;
return No_List;
end if;
-- If warning on suspicious contracts then check for the case of -- If warning on suspicious contracts then check for the case of
-- a postcondition other than False for a No_Return subprogram. -- a postcondition other than False for a No_Return subprogram.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment