[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

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