[Ada] Spurious error with pragma Thread_Local_Storage

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

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