-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
begin
if Num'Size > Integer'Size then
Aux.Put_LLD
--- (TFT (File), Long_Long_Integer'Integer_Value (Item),
--- ???
- (TFT (File), Long_Long_Integer (Item),
+ (TFT (File), Long_Long_Integer'Integer_Value (Item),
Fore, Aft, Exp, Scale);
else
Aux.Put_Dec
--- (TFT (File), Integer'Integer_Value (Item), Fore, Aft, Exp, Scale);
--- ???
- (TFT (File), Integer (Item), Fore, Aft, Exp, Scale);
-
+ (TFT (File), Integer'Integer_Value (Item), Fore, Aft, Exp, Scale);
end if;
end Put;
begin
if Num'Size > Integer'Size then
--- Aux.Puts_LLD
--- (S, Long_Long_Integer'Integer_Value (Item), Aft, Exp, Scale);
--- ???
Aux.Puts_LLD
- (S, Long_Long_Integer (Item), Aft, Exp, Scale);
+ (S, Long_Long_Integer'Integer_Value (Item), Aft, Exp, Scale);
+
else
--- Aux.Puts_Dec (S, Integer'Integer_Value (Item), Aft, Exp, Scale);
--- ???
- Aux.Puts_Dec (S, Integer (Item), Aft, Exp, Scale);
+ Aux.Puts_Dec (S, Integer'Integer_Value (Item), Aft, Exp, Scale);
end if;
for J in S'Range loop
Needs_Freezing : Boolean;
S : Entity_Id;
+ procedure Check_Generic_Parent;
+ -- The actual may be an instantiation of a unit
+ -- declared in a previous instantiation. If that
+ -- one is also in the current compilation, it must
+ -- itself be frozen before the actual.
+ -- Should this itself be recursive ???
+
+ --------------------------
+ -- Check_Generic_Parent --
+ --------------------------
+
+ procedure Check_Generic_Parent is
+ Par : Entity_Id;
+ begin
+ if Nkind (Parent (Actual)) = N_Package_Specification
+ then
+ Par := Scope (Generic_Parent (Parent (Actual)));
+ if Is_Generic_Instance (Par)
+ and then Scope (Par) = Current_Scope
+ and then (No (Freeze_Node (Par))
+ or else
+ not Is_List_Member (Freeze_Node (Par)))
+ then
+ Set_Has_Delayed_Freeze (Par);
+ Append_Elmt (Par, Actuals_To_Freeze);
+ end if;
+ end if;
+ end Check_Generic_Parent;
+
begin
if not Expander_Active
or else not Has_Completion (Actual)
or else not In_Same_Source_Unit (I_Node, Actual)
+ or else Is_Frozen (Actual)
or else
(Present (Renamed_Entity (Actual))
and then not
end loop;
if Needs_Freezing then
+ Check_Generic_Parent;
Set_Has_Delayed_Freeze (Actual);
Append_Elmt (Actual, Actuals_To_Freeze);
end if;
-- if no delay is needed, we place the freeze node at the end of the
-- current declarative part.
- if Expander_Active then
+ if Expander_Active
+ and then (No (Freeze_Node (Act_Id))
+ or else not Is_List_Member (Freeze_Node (Act_Id)))
+ then
Ensure_Freeze_Node (Act_Id);
F_Node := Freeze_Node (Act_Id);
Expression => Relocate_Node (Expr))),
Pragma_Name => Chars (Id));
+ -- Linker_Section does not need delaying, as its argument
+ -- must be a static string. Furthermore, if applied to
+ -- an object with an explicit initialization, the object
+ -- must be frozen in order to elaborate the initialization
+ -- code. (This is already done for types with implicit
+ -- initialization, such as protected types.)
+
+ if A_Id = Aspect_Linker_Section
+ and then Nkind (N) = N_Object_Declaration
+ and then Has_Init_Expression (N)
+ then
+ Delay_Required := False;
+ end if;
+
-- Synchronization
-- Corresponds to pragma Implemented, construct the pragma
-- reference for future checks (see Analyze_Refined_State_In_Decls).
procedure Resolve_State (N : Node_Id);
- -- Handle the overloading of state names by functions. When N denotes a
- -- function, this routine finds the corresponding state and sets the entity
- -- of N to that of the state.
+ -- Handle the overloading of state names by parameterless functions. When N
+ -- denotes a function, this routine finds the corresponding state and sets
+ -- the entity of N to that of the state.
procedure Rewrite_Assertion_Kind
(N : Node_Id;
-- homonym chain looking for an abstract state.
if Ekind (Func) = E_Function and then Has_Homonym (Func) then
+ pragma Assert (Is_Overloaded (N));
+
State := Homonym (Func);
while Present (State) loop
+ if Ekind (State) = E_Abstract_State then
- -- Resolve the overloading by setting the proper entity of the
- -- reference to that of the state.
+ -- Resolve the overloading by setting the proper entity of
+ -- the reference to that of the state.
- if Ekind (State) = E_Abstract_State then
- Set_Etype (N, Standard_Void_Type);
- Set_Entity (N, State);
- Set_Associated_Node (N, State);
+ Set_Etype (N, Standard_Void_Type);
+ Set_Entity (N, State);
+ Set_Is_Overloaded (N, False);
+
+ Generate_Reference (State, N);
return;
end if;