* 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
+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.
-- 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
return Flag90 (Id);
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
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
- 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
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 ("Rewritten_For_C", Flag287 (Id));
-- by reference, either because its return type is a by-reference-type
-- 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]
-- 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) (non-generic case only)
-- Rewritten_For_C (Flag287) (generate C code only)
-- Sec_Stack_Needed_For_Return (Flag167)
-- SPARK_Pragma_Inherited (Flag265)
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 Rewritten_For_C (Id : E) return B;
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_Rewritten_For_C (Id : E; V : B := True);
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 (Rewritten_For_C);
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_Rewritten_For_C);
Has_Default_Initialization : Boolean := False;
-- 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;
-- List of freezing actions, left at No_List if none
function Freeze_Profile (E : Entity_Id) return Boolean;
-- Freeze formals and return type of subprogram. If some type in the
- -- profile is a limited view, freezing of the entity will take place
- -- elsewhere, and the function returns False. This routine will be
- -- modified if and when we can implement AI05-019 efficiently ???
+ -- profile is incomplete and we are in an instance, freezing of the
+ -- entity will take place elsewhere, and the function returns False.
procedure Freeze_Record_Type (Rec : Entity_Id);
-- Freeze record type, including freezing component types, and freezing
-- Determine whether an arbitrary entity is subject to Boolean aspect
-- 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;
-- Create a new freeze node for entity E
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
R_Type := Etype (E);
then
R_Type := Full_View (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;
Freeze_And_Append (R_Type, N, Result);
return False;
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 --
---------------------
Freeze_Subprogram (E);
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
-- a postcondition other than False for a No_Return subprogram.
projects / gcc.git / commitdiff