From eb0f297f9ae8dab927ee000090f562e64239b4b4 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 8 Sep 2017 10:47:04 +0200 Subject: [PATCH] [multiple changes] 2017-09-08 Ed Schonberg * 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 * 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 * 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 * 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 --- gcc/ada/a-wtdeio.adb | 21 ++++++--------------- gcc/ada/sem_ch12.adb | 36 +++++++++++++++++++++++++++++++++++- gcc/ada/sem_ch13.adb | 14 ++++++++++++++ gcc/ada/sem_prag.adb | 22 +++++++++++++--------- 4 files changed, 68 insertions(+), 25 deletions(-) diff --git a/gcc/ada/a-wtdeio.adb b/gcc/ada/a-wtdeio.adb index 598b72a941e..1c13f9a878b 100644 --- a/gcc/ada/a-wtdeio.adb +++ b/gcc/ada/a-wtdeio.adb @@ -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 diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index f1e659c4bab..94bd498d74a 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -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); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 20619964bd2..90b629ce926 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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 diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 9cf91556922..2f6b2306f60 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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; -- 2.30.2