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 @@
-- --
-- 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- --
......@@ -112,16 +112,11 @@ package body Ada.Wide_Text_IO.Decimal_IO is
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;
......@@ -145,15 +140,11 @@ package body Ada.Wide_Text_IO.Decimal_IO is
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
......
......@@ -1908,10 +1908,40 @@ package body Sem_Ch12 is
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
......@@ -1943,6 +1973,7 @@ package body Sem_Ch12 is
end loop;
if Needs_Freezing then
Check_Generic_Parent;
Set_Has_Delayed_Freeze (Actual);
Append_Elmt (Actual, Actuals_To_Freeze);
end if;
......@@ -9281,7 +9312,10 @@ package body Sem_Ch12 is
-- 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);
......
......@@ -2208,6 +2208,20 @@ package body Sem_Ch13 is
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
......
......@@ -283,9 +283,9 @@ package body Sem_Prag is
-- 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;
......@@ -30229,16 +30229,20 @@ package body Sem_Prag is
-- 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;
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