From b6eb7548cf927d541477146a195e2bdd25900012 Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Wed, 14 Nov 2018 11:42:05 +0000 Subject: [PATCH] [Ada] Use of Suppress_Initialization with pragma Thread_Local_Storage This patch allows for aspect/pragma Suppress_Initialization to be an acceptable form of missing initialization with respect to the semantics of pragma Thread_Local_Storage. ------------ -- Source -- ------------ -- gnat.adc pragma Initialize_Scalars; -- pack.ads with System; package Pack is Addr : System.Address with Thread_Local_Storage, Suppress_Initialization; end Pack; ----------------- -- Compilation -- ----------------- $ gcc -c pack.ads 2018-11-14 Hristian Kirtchev gcc/ada/ * freeze.adb (Check_Pragma_Thread_Local_Storage): New routine. A variable with suppressed initialization has no initialization for purposes of the pragma. (Freeze_Object_Declaration): Remove variable Has_Default_Initialization as it is no longer used. Use routine Check_Pragma_Thread_Local_Storage to verify the semantics of pragma Thread_Local_Storage. From-SVN: r266129 --- gcc/ada/ChangeLog | 10 +++++ gcc/ada/freeze.adb | 96 ++++++++++++++++++++++++++++++---------------- 2 files changed, 73 insertions(+), 33 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 88324854872..900d23a50d3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2018-11-14 Hristian Kirtchev + + * freeze.adb (Check_Pragma_Thread_Local_Storage): New routine. A + variable with suppressed initialization has no initialization + for purposes of the pragma. + (Freeze_Object_Declaration): Remove variable + Has_Default_Initialization as it is no longer used. Use routine + Check_Pragma_Thread_Local_Storage to verify the semantics of + pragma Thread_Local_Storage. + 2018-11-14 Ed Schonberg * sem_res.adb (Resolve_If_Expression): Verify that the subtypes diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 6734f6df544..afb347969ca 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -2178,9 +2178,6 @@ package body Freeze is Formal : Entity_Id; Indx : Node_Id; - Has_Default_Initialization : Boolean := False; - -- This flag gets set to true for a variable with default initialization - Result : List_Id := No_List; -- List of freezing actions, left at No_List if none @@ -3213,6 +3210,10 @@ package body Freeze is -- wrap-around arithmetic might yield a meaningless value for the -- length of the array, or its corresponding attribute. + procedure Check_Pragma_Thread_Local_Storage (Var_Id : Entity_Id); + -- Ensure that the initialization state of variable Var_Id subject to + -- pragma Thread_Local_Storage satisfies the semantics of the pragma. + ------------------------------- -- Check_Large_Modular_Array -- ------------------------------- @@ -3292,6 +3293,58 @@ package body Freeze is end if; end Check_Large_Modular_Array; + --------------------------------------- + -- Check_Pragma_Thread_Local_Storage -- + --------------------------------------- + + procedure Check_Pragma_Thread_Local_Storage (Var_Id : Entity_Id) is + Decl : constant Node_Id := Declaration_Node (Var_Id); + Expr : constant Node_Id := Expression (Decl); + + begin + -- A variable whose initialization is suppressed lacks default + -- initialization. + + if Suppress_Initialization (Var_Id) then + null; + + -- The variable has some form of initialization. Check whether it + -- is compatible with the semantics of the pragma. + + elsif Has_Init_Expression (Decl) + and then Present (Expr) + and then + + -- The variable is initialized with "null" + + (Nkind (Expr) = N_Null + or else + + -- The variable is initialized with a static constant + + Is_OK_Static_Expression (Expr) + or else + + -- The variable is initialized with a static aggregate + + (Nkind (Expr) = N_Aggregate + and then Compile_Time_Known_Aggregate (Expr))) + then + null; + + -- Otherwise the initialization of the variable violates the + -- semantics of pragma Thread_Local_Storage. + + else + Error_Msg_NE + ("Thread_Local_Storage variable& is improperly initialized", + Decl, Var_Id); + Error_Msg_NE + ("\only allowed initialization is explicit NULL, static " + & "expression or static aggregate", Decl, Var_Id); + end if; + end Check_Pragma_Thread_Local_Storage; + -- Local variables Typ : constant Entity_Id := Etype (E); @@ -3420,42 +3473,19 @@ package body Freeze is (Needs_Simple_Initialization (Typ) and then not Is_Internal (E))) then - Has_Default_Initialization := True; Check_Restriction (No_Default_Initialization, Declaration_Node (E)); end if; - -- Check that a Thread_Local_Storage variable does not have default - -- initialization, and any explicit initialization must either be the - -- null constant or a static constant. + -- Ensure that a variable subject to pragma Thread_Local_Storage + -- + -- * Lacks default initialization, or + -- + -- * The initialization expression is either "null", a static + -- constant, or a compile-time known aggregate. if Has_Pragma_Thread_Local_Storage (E) then - declare - Decl : constant Node_Id := Declaration_Node (E); - begin - if Has_Default_Initialization - or else - (Has_Init_Expression (Decl) - and then - (No (Expression (Decl)) - or else not - (Is_OK_Static_Expression (Expression (Decl)) - or else Nkind (Expression (Decl)) = N_Null))) - then - if Nkind (Expression (Decl)) = N_Aggregate - and then Compile_Time_Known_Aggregate (Expression (Decl)) - then - null; - else - Error_Msg_NE - ("Thread_Local_Storage variable& is improperly " - & "initialized", Decl, E); - Error_Msg_NE - ("\only allowed initialization is explicit NULL, " - & "static expression or static aggregate", Decl, E); - end if; - end if; - end; + Check_Pragma_Thread_Local_Storage (E); end if; -- For imported objects, set Is_Public unless there is also an -- 2.30.2