From 921186579c3ba7d4e1fea8e967ec7d0f804167bf Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Tue, 11 Dec 2018 11:12:37 +0000 Subject: [PATCH] [Ada] Spurious error with pragma Thread_Local_Storage The following patch modifies the checks related to pragma Thread_Local_Storage to correct a confusion in semantics which led to spurious errors. ------------ -- Source -- ------------ -- pack.ads package Pack is type Arr is array (1 .. 5) of Boolean; type Arr_With_Default is array (1 .. 5) of Boolean with Default_Component_Value => False; type Int is new Integer range 1 .. 5; type Int_With_Default is new Integer range 1 .. 5 with Default_Value => 1; protected type Prot_Typ is entry E; end Prot_Typ; type Rec_1 is record Comp : Integer; end record; type Rec_2 is record Comp : Int; end record; type Rec_3 is record Comp : Int_With_Default; end record; task type Task_Typ is entry E; end Task_Typ; end Pack; -- pack.adb package body Pack is function F (Val : Int) return Int is begin if Val <= 1 then return 1; else return F (Val - 1) * Val; end if; end F; function F (Val : Int_With_Default) return Int_With_Default is begin if Val <= 1 then return 1; else return F (Val - 1) * Val; end if; end F; function F (Val : Integer) return Integer is begin if Val <= 1 then return 1; else return F (Val - 1) * Val; end if; end F; protected body Prot_Typ is entry E when True is begin null; end E; end Prot_Typ; task body Task_Typ is begin accept E; end Task_Typ; Obj_1 : Arr; -- OK pragma Thread_Local_Storage (Obj_1); Obj_2 : Arr := (others => True); -- OK pragma Thread_Local_Storage (Obj_2); Obj_3 : Arr := (others => F (2) = Integer (3)); -- ERROR pragma Thread_Local_Storage (Obj_3); Obj_4 : Arr_With_Default; -- ERROR pragma Thread_Local_Storage (Obj_4); Obj_5 : Arr_With_Default := (others => True); -- OK pragma Thread_Local_Storage (Obj_5); Obj_6 : Arr_With_Default := (others => F (2) = Integer (3)); -- ERROR pragma Thread_Local_Storage (Obj_6); Obj_7 : Integer; -- OK pragma Thread_Local_Storage (Obj_7); Obj_8 : Integer := 1; -- OK pragma Thread_Local_Storage (Obj_8); Obj_9 : Integer := F (2); -- ERROR pragma Thread_Local_Storage (Obj_9); Obj_10 : Int; -- OK pragma Thread_Local_Storage (Obj_10); Obj_11 : Int := 1; -- OK pragma Thread_Local_Storage (Obj_11); Obj_12 : Int := F (2); -- ERROR pragma Thread_Local_Storage (Obj_12); Obj_13 : Int_With_Default; -- ERROR pragma Thread_Local_Storage (Obj_13); Obj_14 : Int_With_Default := 1; -- OK pragma Thread_Local_Storage (Obj_14); Obj_15 : Int_With_Default := F (2); -- ERROR pragma Thread_Local_Storage (Obj_15); Obj_16 : Prot_Typ; -- ERROR pragma Thread_Local_Storage (Obj_16); Obj_17 : Rec_1; -- OK pragma Thread_Local_Storage (Obj_17); Obj_18 : Rec_1 := (others => 1); -- OK pragma Thread_Local_Storage (Obj_18); Obj_19 : Rec_1 := (others => F (2)); -- ERROR pragma Thread_Local_Storage (Obj_19); Obj_20 : Rec_2; -- OK pragma Thread_Local_Storage (Obj_20); Obj_21 : Rec_2 := (others => 1); -- OK pragma Thread_Local_Storage (Obj_21); Obj_22 : Rec_2 := (others => F (2)); -- ERROR pragma Thread_Local_Storage (Obj_22); Obj_23 : Rec_3; -- ERROR pragma Thread_Local_Storage (Obj_23); Obj_24 : Rec_3 := (others => 1); -- OK pragma Thread_Local_Storage (Obj_24); Obj_25 : Rec_3 := (others => F (2)); -- ERROR pragma Thread_Local_Storage (Obj_25); Obj_26 : Task_Typ; -- ERROR pragma Thread_Local_Storage (Obj_26); end Pack; ---------------------------- -- Compilation and output -- ---------------------------- $ gcc -c pack.adb pack.adb:47:04: Thread_Local_Storage variable "Obj_4" is improperly initialized pack.adb:47:04: only allowed initialization is explicit "null", static expression or static aggregate pack.adb:62:04: Thread_Local_Storage variable "Obj_9" is improperly initialized pack.adb:62:04: only allowed initialization is explicit "null", static expression or static aggregate pack.adb:71:04: Thread_Local_Storage variable "Obj_12" is improperly initialized pack.adb:71:04: only allowed initialization is explicit "null", static expression or static aggregate pack.adb:74:04: Thread_Local_Storage variable "Obj_13" is improperly initialized pack.adb:74:04: only allowed initialization is explicit "null", static expression or static aggregate pack.adb:80:04: Thread_Local_Storage variable "Obj_15" is improperly initialized pack.adb:80:04: only allowed initialization is explicit "null", static expression or static aggregate pack.adb:83:04: Thread_Local_Storage variable "Obj_16" is improperly initialized pack.adb:83:04: only allowed initialization is explicit "null", static expression or static aggregate pack.adb:92:04: Thread_Local_Storage variable "Obj_19" is improperly initialized pack.adb:92:04: only allowed initialization is explicit "null", static expression or static aggregate pack.adb:101:04: Thread_Local_Storage variable "Obj_22" is improperly initialized pack.adb:101:04: only allowed initialization is explicit "null", static expression or static aggregate pack.adb:104:04: Thread_Local_Storage variable "Obj_23" is improperly initialized pack.adb:104:04: only allowed initialization is explicit "null", static expression or static aggregate pack.adb:110:04: Thread_Local_Storage variable "Obj_25" is improperly initialized pack.adb:110:04: only allowed initialization is explicit "null", static expression or static aggregate pack.adb:113:04: Thread_Local_Storage variable "Obj_26" is improperly initialized pack.adb:113:04: only allowed initialization is explicit "null", static expression or static aggregate 2018-12-11 Hristian Kirtchev gcc/ada/ * freeze.adb (Check_Pragma_Thread_Local_Storage): Use the violating set to diagnose detect an illegal initialization, rather than the complement of the OK set. (Freeze_Object_Declaration): Factorize code in Has_Default_Initialization. (Has_Default_Initialization, Has_Incompatible_Initialization): New routines. From-SVN: r267017 --- gcc/ada/ChangeLog | 10 ++++ gcc/ada/freeze.adb | 139 ++++++++++++++++++++++++++++++++------------- 2 files changed, 109 insertions(+), 40 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index aab6ceb5c25..c08199bbcf5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2018-12-11 Hristian Kirtchev + + * freeze.adb (Check_Pragma_Thread_Local_Storage): Use the + violating set to diagnose detect an illegal initialization, + rather than the complement of the OK set. + (Freeze_Object_Declaration): Factorize code in + Has_Default_Initialization. + (Has_Default_Initialization, Has_Incompatible_Initialization): + New routines. + 2018-12-11 Dmitriy Anisimkov * libgnat/g-socket.ads (Family_Type): Add new enumerated value diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index dc3e54cca28..0573949e68d 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3187,8 +3187,13 @@ package body Freeze is -- 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. + -- Ensure that the initialization state of variable Var_Id subject + -- to pragma Thread_Local_Storage agrees with the semantics of the + -- pragma. + + function Has_Default_Initialization + (Obj_Id : Entity_Id) return Boolean; + -- Determine whether object Obj_Id default initialized ------------------------------- -- Check_Large_Modular_Array -- @@ -3274,53 +3279,117 @@ package body Freeze is --------------------------------------- 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); + function Has_Incompatible_Initialization + (Var_Decl : Node_Id) return Boolean; + -- Determine whether variable Var_Id with declaration Var_Decl is + -- initialized with a value that violates the semantics of pragma + -- Thread_Local_Storage. - begin - -- A variable whose initialization is suppressed lacks default - -- initialization. + ------------------------------------- + -- Has_Incompatible_Initialization -- + ------------------------------------- - if Suppress_Initialization (Var_Id) then - null; + function Has_Incompatible_Initialization + (Var_Decl : Node_Id) return Boolean + is + Init_Expr : constant Node_Id := Expression (Var_Decl); - -- The variable has some form of initialization. Check whether it - -- is compatible with the semantics of the pragma. + begin + -- The variable is default-initialized. This directly violates + -- the semantics of the pragma. - elsif Has_Init_Expression (Decl) - and then Present (Expr) - and then + if Has_Default_Initialization (Var_Id) then + return True; - -- The variable is initialized with "null" + -- The variable has explicit initialization. In this case only + -- a handful of values satisfy the semantics of the pragma. - (Nkind (Expr) = N_Null - or else + elsif Has_Init_Expression (Var_Decl) + and then Present (Init_Expr) + then + -- "null" is a legal form of initialization + + if Nkind (Init_Expr) = N_Null then + return False; - -- The variable is initialized with a static constant + -- A static expression is a legal form of initialization - Is_OK_Static_Expression (Expr) - or else + elsif Is_Static_Expression (Init_Expr) then + return False; - -- The variable is initialized with a static aggregate + -- A static aggregate is a legal form of initialization - (Nkind (Expr) = N_Aggregate - and then Compile_Time_Known_Aggregate (Expr))) - then + elsif Nkind (Init_Expr) = N_Aggregate + and then Compile_Time_Known_Aggregate (Init_Expr) + then + return False; + + -- All other initialization expressions violate the semantic + -- of the pragma. + + else + return True; + end if; + + -- The variable lacks any kind of initialization, which agrees + -- with the semantics of the pragma. + + else + return False; + end if; + end Has_Incompatible_Initialization; + + -- Local declarations + + Var_Decl : constant Node_Id := Declaration_Node (Var_Id); + + -- Start of processing for Check_Pragma_Thread_Local_Storage + + begin + -- A variable whose initialization is suppressed lacks any kind of + -- initialization. + + if Suppress_Initialization (Var_Id) then null; - -- Otherwise the initialization of the variable violates the - -- semantics of pragma Thread_Local_Storage. + -- The variable has default initialization, or is explicitly + -- initialized to a value other than null, static expression, + -- or a static aggregate. - else + elsif Has_Incompatible_Initialization (Var_Decl) then Error_Msg_NE ("Thread_Local_Storage variable& is improperly initialized", - Decl, Var_Id); + Var_Decl, Var_Id); Error_Msg_NE ("\only allowed initialization is explicit NULL, static " - & "expression or static aggregate", Decl, Var_Id); + & "expression or static aggregate", Var_Decl, Var_Id); end if; end Check_Pragma_Thread_Local_Storage; + -------------------------------- + -- Has_Default_Initialization -- + -------------------------------- + + function Has_Default_Initialization + (Obj_Id : Entity_Id) return Boolean + is + Obj_Decl : constant Node_Id := Declaration_Node (Obj_Id); + Obj_Typ : constant Entity_Id := Etype (Obj_Id); + + begin + return + Comes_From_Source (Obj_Id) + and then not Is_Imported (Obj_Id) + and then not Has_Init_Expression (Obj_Decl) + and then + ((Has_Non_Null_Base_Init_Proc (Obj_Typ) + and then not No_Initialization (Obj_Decl) + and then not Initialization_Suppressed (Obj_Typ)) + or else + (Needs_Simple_Initialization (Obj_Typ) + and then not Is_Internal (Obj_Id))); + end Has_Default_Initialization; + -- Local variables Typ : constant Entity_Id := Etype (E); @@ -3438,17 +3507,7 @@ package body Freeze is if Ekind (E) = E_Constant and then Present (Full_View (E)) then null; - elsif Comes_From_Source (E) - and then not Is_Imported (E) - and then not Has_Init_Expression (Declaration_Node (E)) - and then - ((Has_Non_Null_Base_Init_Proc (Typ) - and then not No_Initialization (Declaration_Node (E)) - and then not Initialization_Suppressed (Typ)) - or else - (Needs_Simple_Initialization (Typ) - and then not Is_Internal (E))) - then + elsif Has_Default_Initialization (E) then Check_Restriction (No_Default_Initialization, Declaration_Node (E)); end if; -- 2.30.2