Commit eb0f297f by Arnaud Charlet

[multiple changes]

2017-09-08  Ed Schonberg  <schonberg@adacore.com>

        * sem_ch12.adb (Check_Generic_Parent): New procedure within
        Analyze_Associations, to handle actual packages that depend on
        previous instances.  If a package IAP that is an instantiation is
        used as an actual in a subsequent instantiation SI in the same
        scope, and IAP has a body, IAP must be frozen before SI. If
        the generic parent of IAP is itself declared in a previous
        instantiation in the same scope, that instantiation must also
        be frozen before SI.
        (Install_Body): Prevent double insertion of freeze node for
        instance.

2017-09-08  Hristian Kirtchev  <kirtchev@adacore.com>

        * sem_prag.adb (Resolve_State): Update the
        comment on documentation. Generate a reference to the state once
        resolution takes place.

2017-09-08  Ed Schonberg  <schonberg@adacore.com>

        * sem_ch13.adb (Analyze_Aspect_Specifications, case
        Linker_Section): If the aspect applies to an object declaration
        with explicit initialization, do not delay the freezing of the
        object, to prevent access-before-elaboration in the generated
        initialization code.

2017-09-08  Ed Schonberg  <schonberg@adacore.com>

        * a-wtdeio.adb (Put, all versions): Use Long_Long_Integer
        (Integer_Value (Item)) when the size of the fixed decimal type
        is larger than Integer.

From-SVN: r251866
parent be91c7e2
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -112,16 +112,11 @@ package body Ada.Wide_Text_IO.Decimal_IO is ...@@ -112,16 +112,11 @@ package body Ada.Wide_Text_IO.Decimal_IO is
begin begin
if Num'Size > Integer'Size then if Num'Size > Integer'Size then
Aux.Put_LLD Aux.Put_LLD
-- (TFT (File), Long_Long_Integer'Integer_Value (Item), (TFT (File), Long_Long_Integer'Integer_Value (Item),
-- ???
(TFT (File), Long_Long_Integer (Item),
Fore, Aft, Exp, Scale); Fore, Aft, Exp, Scale);
else else
Aux.Put_Dec Aux.Put_Dec
-- (TFT (File), Integer'Integer_Value (Item), Fore, Aft, Exp, Scale); (TFT (File), Integer'Integer_Value (Item), Fore, Aft, Exp, Scale);
-- ???
(TFT (File), Integer (Item), Fore, Aft, Exp, Scale);
end if; end if;
end Put; end Put;
...@@ -145,15 +140,11 @@ package body Ada.Wide_Text_IO.Decimal_IO is ...@@ -145,15 +140,11 @@ package body Ada.Wide_Text_IO.Decimal_IO is
begin begin
if Num'Size > Integer'Size then if Num'Size > Integer'Size then
-- Aux.Puts_LLD
-- (S, Long_Long_Integer'Integer_Value (Item), Aft, Exp, Scale);
-- ???
Aux.Puts_LLD Aux.Puts_LLD
(S, Long_Long_Integer (Item), Aft, Exp, Scale); (S, Long_Long_Integer'Integer_Value (Item), Aft, Exp, Scale);
else else
-- Aux.Puts_Dec (S, Integer'Integer_Value (Item), Aft, Exp, Scale); Aux.Puts_Dec (S, Integer'Integer_Value (Item), Aft, Exp, Scale);
-- ???
Aux.Puts_Dec (S, Integer (Item), Aft, Exp, Scale);
end if; end if;
for J in S'Range loop for J in S'Range loop
......
...@@ -1908,10 +1908,40 @@ package body Sem_Ch12 is ...@@ -1908,10 +1908,40 @@ package body Sem_Ch12 is
Needs_Freezing : Boolean; Needs_Freezing : Boolean;
S : Entity_Id; 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 begin
if not Expander_Active if not Expander_Active
or else not Has_Completion (Actual) or else not Has_Completion (Actual)
or else not In_Same_Source_Unit (I_Node, Actual) or else not In_Same_Source_Unit (I_Node, Actual)
or else Is_Frozen (Actual)
or else or else
(Present (Renamed_Entity (Actual)) (Present (Renamed_Entity (Actual))
and then not and then not
...@@ -1943,6 +1973,7 @@ package body Sem_Ch12 is ...@@ -1943,6 +1973,7 @@ package body Sem_Ch12 is
end loop; end loop;
if Needs_Freezing then if Needs_Freezing then
Check_Generic_Parent;
Set_Has_Delayed_Freeze (Actual); Set_Has_Delayed_Freeze (Actual);
Append_Elmt (Actual, Actuals_To_Freeze); Append_Elmt (Actual, Actuals_To_Freeze);
end if; end if;
...@@ -9281,7 +9312,10 @@ package body Sem_Ch12 is ...@@ -9281,7 +9312,10 @@ package body Sem_Ch12 is
-- if no delay is needed, we place the freeze node at the end of the -- if no delay is needed, we place the freeze node at the end of the
-- current declarative part. -- 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); Ensure_Freeze_Node (Act_Id);
F_Node := Freeze_Node (Act_Id); F_Node := Freeze_Node (Act_Id);
......
...@@ -2208,6 +2208,20 @@ package body Sem_Ch13 is ...@@ -2208,6 +2208,20 @@ package body Sem_Ch13 is
Expression => Relocate_Node (Expr))), Expression => Relocate_Node (Expr))),
Pragma_Name => Chars (Id)); 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 -- Synchronization
-- Corresponds to pragma Implemented, construct the pragma -- Corresponds to pragma Implemented, construct the pragma
......
...@@ -283,9 +283,9 @@ package body Sem_Prag is ...@@ -283,9 +283,9 @@ package body Sem_Prag is
-- reference for future checks (see Analyze_Refined_State_In_Decls). -- reference for future checks (see Analyze_Refined_State_In_Decls).
procedure Resolve_State (N : Node_Id); procedure Resolve_State (N : Node_Id);
-- Handle the overloading of state names by functions. When N denotes a -- Handle the overloading of state names by parameterless functions. When N
-- function, this routine finds the corresponding state and sets the entity -- denotes a function, this routine finds the corresponding state and sets
-- of N to that of the state. -- the entity of N to that of the state.
procedure Rewrite_Assertion_Kind procedure Rewrite_Assertion_Kind
(N : Node_Id; (N : Node_Id;
...@@ -30229,16 +30229,20 @@ package body Sem_Prag is ...@@ -30229,16 +30229,20 @@ package body Sem_Prag is
-- homonym chain looking for an abstract state. -- homonym chain looking for an abstract state.
if Ekind (Func) = E_Function and then Has_Homonym (Func) then if Ekind (Func) = E_Function and then Has_Homonym (Func) then
pragma Assert (Is_Overloaded (N));
State := Homonym (Func); State := Homonym (Func);
while Present (State) loop while Present (State) loop
if Ekind (State) = E_Abstract_State then
-- Resolve the overloading by setting the proper entity of the -- Resolve the overloading by setting the proper entity of
-- reference to that of the state. -- the reference to that of the state.
if Ekind (State) = E_Abstract_State then Set_Etype (N, Standard_Void_Type);
Set_Etype (N, Standard_Void_Type); Set_Entity (N, State);
Set_Entity (N, State); Set_Is_Overloaded (N, False);
Set_Associated_Node (N, State);
Generate_Reference (State, N);
return; return;
end if; end if;
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