[Ada] Extend the applicability of Thread_Local_Storage to composite types

This patch allows the GNAT-specific Thread_Local_Storage to be applied
to variables of a composite type initiallized with an aggregate with
static components that requires no elaboration code.

2018-05-30  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* freeze.adb (Freeze_Object_Declaration): A pragma Thread_Local_Storage
	is now legal on a variable of composite type initialized with an
	aggregate that is fully static and requires no elaboration code.
	* exp_aggr.adb (Convert_To_Positional): Recognize additional cases of
	nested aggregates that are compile-time static, so they can be used to
	initialize variables declared with Threqd_Local_Storage.
	* doc/gnat_rm/implementation_defined_pragmas.rst: Add documentation on
	Thread_Local_Storage.
	* gnat_rm.texi: Regenerate.

gcc/testsuite/

	* gnat.dg/tls1.adb, gnat.dg/tls1_pkg.ads: New testcase.

From-SVN: r260944

gcc/ada/ChangeLog

+2018-05-30  Ed Schonberg  <schonberg@adacore.com>
+
+	* freeze.adb (Freeze_Object_Declaration): A pragma Thread_Local_Storage
+	is now legal on a variable of composite type initialized with an
+	aggregate that is fully static and requires no elaboration code.
+	* exp_aggr.adb (Convert_To_Positional): Recognize additional cases of
+	nested aggregates that are compile-time static, so they can be used to
+	initialize variables declared with Threqd_Local_Storage.
+	* doc/gnat_rm/implementation_defined_pragmas.rst: Add documentation on
+	Thread_Local_Storage.
+	* gnat_rm.texi: Regenerate.
+
 2018-05-30  Yannick Moy  <moy@adacore.com>
 
 	* sem_util.adb (Policy_In_Effect): Take into account CodePeer and

gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst

@@ -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.

gcc/ada/exp_aggr.adb

@@ -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;
 

gcc/ada/freeze.adb

@@ -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;

gcc/ada/gnat_rm.texi

@@ -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.

gcc/testsuite/ChangeLog

+2018-05-30  Ed Schonberg  <schonberg@adacore.com>
+
+	* gnat.dg/tls1.adb, gnat.dg/tls1_pkg.ads: New testcase.
+
 2018-05-30  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* gnat.dg/synchronized1.adb, gnat.dg/synchronized1.ads: New testcase.

gcc/testsuite/gnat.dg/tls1.adb

+--  { 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;

gcc/testsuite/gnat.dg/tls1_pkg.ads

+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;