@@ -6613,13 +6613,17 @@ Syntax:
This pragma specifies that the specified entity, which must be
a variable declared in a library-level package, is to be marked as
"Thread Local Storage" (``TLS``). On systems supporting this (which
-include Windows, Solaris, GNU/Linux and VxWorks 6), this causes each
+include Windows, Solaris, GNU/Linux, and VxWorks 6), this causes each
thread (and hence each Ada task) to see a distinct copy of the variable.
-The variable may not have default initialization, and if there is
+The variable must not have default initialization, and if there is
an explicit initialization, it must be either ``null`` for an
-access variable, or a static expression for a scalar variable.
-This provides a low level mechanism similar to that provided by
+access variable, a static expression for a scalar variable, or a fully
+static aggregate for a composite type, that is to say, an aggregate all
+of whose components are static, and which does not include packed or
+discriminated components.
+
+This provides a low-level mechanism similar to that provided by
the ``Ada.Task_Attributes`` package, but much more efficient
and is also useful in writing interface code that will interact
with foreign threads.
@@ -4727,7 +4727,25 @@ package body Exp_Aggr is
return;
end if;
+ -- A subaggregate may have been flattened but is not known to be
+ -- Compile_Time_Known. Set that flag in cases that cannot require
+ -- elaboration code, so that the aggregate can be used as the
+ -- initial value of a thread-local variable.
+
if Is_Flat (N, Number_Dimensions (Typ)) then
+ Check_Static_Components;
+ if Static_Components then
+ if Is_Packed (Etype (N))
+ or else
+ (Is_Record_Type (Component_Type (Etype (N)))
+ and then Has_Discriminants (Component_Type (Etype (N))))
+ then
+ null;
+ else
+ Set_Compile_Time_Known_Aggregate (N);
+ end if;
+ end if;
+
return;
end if;
@@ -3441,12 +3441,19 @@ package body Freeze is
(Is_OK_Static_Expression (Expression (Decl))
or else Nkind (Expression (Decl)) = N_Null)))
then
- Error_Msg_NE
- ("Thread_Local_Storage variable& is "
- & "improperly initialized", Decl, E);
- Error_Msg_NE
- ("\only allowed initialization is explicit "
- & "NULL or static expression", Decl, E);
+ 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;
end if;
@@ -21,7 +21,7 @@
@copying
@quotation
-GNAT Reference Manual , Apr 24, 2018
+GNAT Reference Manual , May 22, 2018
AdaCore
@@ -8070,13 +8070,17 @@ pragma Thread_Local_Storage ([Entity =>] LOCAL_NAME);
This pragma specifies that the specified entity, which must be
a variable declared in a library-level package, is to be marked as
"Thread Local Storage" (@code{TLS}). On systems supporting this (which
-include Windows, Solaris, GNU/Linux and VxWorks 6), this causes each
+include Windows, Solaris, GNU/Linux, and VxWorks 6), this causes each
thread (and hence each Ada task) to see a distinct copy of the variable.
-The variable may not have default initialization, and if there is
+The variable must not have default initialization, and if there is
an explicit initialization, it must be either @code{null} for an
-access variable, or a static expression for a scalar variable.
-This provides a low level mechanism similar to that provided by
+access variable, a static expression for a scalar variable, or a fully
+static aggregate for a composite type, that is to say, an aggregate all
+of whose components are static, and which does not include packed or
+discriminated components.
+
+This provides a low-level mechanism similar to that provided by
the @code{Ada.Task_Attributes} package, but much more efficient
and is also useful in writing interface code that will interact
with foreign threads.
new file mode 100644
@@ -0,0 +1,51 @@
+-- { dg-do run }
+
+with Text_IO; use Text_IO;
+with TLS1_Pkg; use TLS1_Pkg;
+
+procedure TLS1 is
+ Result : Integer;
+
+ task type T is
+ entry Change (Inc : Integer);
+ entry Sum (Result : out Integer);
+ end T;
+
+ task body T is
+ begin
+ accept Change (Inc : Integer) do
+ for I in My_Array.data'range loop
+ My_Array.Data (I).Point := Inc;
+ end loop;
+ end;
+
+ accept Sum (Result : out Integer) do
+ Result := 0;
+ for I in My_Array.data'range loop
+ Result := Result + My_Array.Data (I).Point;
+ end loop;
+ end;
+ end T;
+
+ Gang : array (1..10) of T;
+
+begin
+ for J in Gang'range loop
+ Gang (J).Change (J);
+ end loop;
+
+ -- Verify the contents of each local thread storage.
+
+ for J in Gang'range loop
+ Gang (J).Sum (Result);
+ pragma Assert (Result = J * 500);
+ end loop;
+
+ -- Verify that original data is unaffected.
+
+ for J in My_Array.Data'range loop
+ Result := Result + My_Array.Data (J).Point;
+ end loop;
+
+ pragma Assert (Result = 500);
+end TLS1;
new file mode 100644
@@ -0,0 +1,23 @@
+pragma Restrictions (No_Implicit_Loops);
+
+package TLS1_Pkg is
+ Type My_Record_Type is record
+ Date : long_float;
+ Point : Integer;
+ end record;
+
+ type Nb_Type is range 0 .. 500;
+ subtype Index_Type is Nb_Type range 1 .. 500;
+
+ type My_Array_Type is array (Index_Type) of My_Record_Type;
+
+ type My_Pseudo_Box_Type is record
+ Nb : Nb_Type;
+ Data : My_Array_Type;
+ End record;
+
+ My_Array : My_Pseudo_Box_Type := (Nb => 10,
+ Data => (others => (Date => 3.0, Point => 1)));
+ pragma Thread_Local_Storage (My_Array);
+
+end TLS1_Pkg;