Commit b6eb7548 by Hristian Kirtchev Committed by Pierre-Marie de Rodat

[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  <kirtchev@adacore.com>

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
parent 1fc75ecf
2018-11-14 Hristian Kirtchev <kirtchev@adacore.com>
* 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 <schonberg@adacore.com>
* sem_res.adb (Resolve_If_Expression): Verify that the subtypes
......
......@@ -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
......
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