-------------------
function Freeze_Entity (E : Entity_Id; N : Node_Id) return List_Id is
- Loc : constant Source_Ptr := Sloc (N);
+ Loc : constant Source_Ptr := Sloc (N);
+ Comp : Entity_Id;
+ F_Node : Node_Id;
+ Indx : Node_Id;
+ Formal : Entity_Id;
+ Atype : Entity_Id;
+
Test_E : Entity_Id := E;
- Comp : Entity_Id;
- F_Node : Node_Id;
- Indx : Node_Id;
- Formal : Entity_Id;
- Atype : Entity_Id;
+ -- This could use a comment ???
+
+ 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
-- 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.
+
procedure Wrap_Imported_Subprogram (E : Entity_Id);
-- If E is an entity for an imported subprogram with pre/post-conditions
-- then this procedure will create a wrapper to ensure that proper run-
function After_Last_Declaration return Boolean is
Spec : constant Node_Id := Parent (Current_Scope);
+
begin
if Nkind (Spec) = N_Package_Specification then
if Present (Private_Declarations (Spec)) then
else
return False;
end if;
+
else
return False;
end if;
else
Error_Msg_N
("current instance must be an immutably limited "
- & "type (RM-2012, 7.5 (8.1/3))",
- Prefix (N));
+ & "type (RM-2012, 7.5 (8.1/3))", Prefix (N));
end if;
return Abandon;
Error_Msg_Name_1 := CN;
Error_Msg_Sloc := Sloc (Arr);
Error_Msg_N
- ("pragma Pack affects convention % components #??",
- PP);
+ ("pragma Pack affects convention % components #??", PP);
Error_Msg_Name_1 := CN;
Error_Msg_N
("\array components may not have % compatible "
Comp_Size_C : constant Node_Id :=
Get_Attribute_Definition_Clause
(Ent, Attribute_Component_Size);
+
begin
-- Warn if we have pack and component size so that the
-- pack is ignored.
if Present (Pack_Pragma) then
Error_Msg_N
- ("??pragma Pack causes component size "
- & "to be ^!", Pack_Pragma);
+ ("??pragma Pack causes component size to be ^!",
+ Pack_Pragma);
Error_Msg_N
- ("\??use Component_Size to set "
- & "desired value!", Pack_Pragma);
+ ("\??use Component_Size to set desired value!",
+ Pack_Pragma);
end if;
end if;
Ilen :=
Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Ityp, Loc),
+ Prefix => New_Occurrence_Of (Ityp, Loc),
Attribute_Name => Name_Range_Length);
Analyze_And_Resolve (Ilen);
if Known_RM_Size (Arr) then
declare
- SizC : constant Node_Id := Size_Clause (Arr);
-
+ SizC : constant Node_Id := Size_Clause (Arr);
Discard : Boolean;
- pragma Warnings (Off, Discard);
begin
-- It is not clear if it is possible to have no size clause
if Will_Be_Frozen then
Undelay_Type (Comp);
+
else
if Present (Prev) then
Set_Next_Entity (Prev, Next_Entity (Comp));
if Is_Entity_Name (Expression (Alloc)) then
Freeze_And_Append
(Entity (Expression (Alloc)), N, Result);
- elsif
- Nkind (Expression (Alloc)) = N_Subtype_Indication
+
+ elsif Nkind (Expression (Alloc)) = N_Subtype_Indication
then
Freeze_And_Append
(Entity (Subtype_Mark (Expression (Alloc))),
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;
+
------------------------------
-- Wrap_Imported_Subprogram --
------------------------------
if Ekind (E) = E_Function then
+ -- Check whether function is declared elsewhere.
+
+ 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));
+
-- Freeze return type
R_Type := Etype (E);
Freeze_Subprogram (E);
end if;
+ if Late_Freezing then
+ Late_Freeze_Subprogram (E);
+ 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