[Ada] Spurious "Duplicated symbol" error with discriminated tasks

This patch fixes a spurious error in a program that contains a
discriminated task type and several of its subtype in the same
declarative part, when the corresponding discriminant constraints are
expressions.

2018-08-21  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_util.ads, sem_util.adb (New_External_Entity): Type of
	Suffix_Index must be Int, not Nat, so that a negative value can
	be used to generate a unique name for an external object, as
	specified in Tbuild.New_External_Name.
	(Scope_Within): Handle private type whose completion is a
	synchronized type (For unnesting).
	* itypes.ads, itypes.adb (Create_Itype): Ditto
	* sem_ch3.adb (Constrain_Corresponding_Record): Generate a
	unique name for the created subtype, because there may be
	several discriminated tasks present in the same scope, and each
	needs its distinct corresponding record subtype.

gcc/testsuite/

	* gnat.dg/task1.adb, gnat.dg/task1.ads, gnat.dg/task1_pkg.adb,
	gnat.dg/task1_pkg.ads: New testcase.

From-SVN: r263716

gcc/ada/ChangeLog

+2018-08-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_util.ads, sem_util.adb (New_External_Entity): Type of
+	Suffix_Index must be Int, not Nat, so that a negative value can
+	be used to generate a unique name for an external object, as
+	specified in Tbuild.New_External_Name.
+	(Scope_Within): Handle private type whose completion is a
+	synchronized type (For unnesting).
+	* itypes.ads, itypes.adb (Create_Itype): Ditto
+	* sem_ch3.adb (Constrain_Corresponding_Record): Generate a
+	unique name for the created subtype, because there may be
+	several discriminated tasks present in the same scope, and each
+	needs its distinct corresponding record subtype.
+
 2018-08-21  Yannick Moy  <moy@adacore.com>
 
 	* doc/gnat_ugn/gnat_and_program_execution.rst: Update

gcc/ada/itypes.adb

@@ -42,7 +42,7 @@ package body Itypes is
       Related_Nod  : Node_Id;
       Related_Id   : Entity_Id := Empty;
       Suffix       : Character := ' ';
-      Suffix_Index : Nat       := 0;
+      Suffix_Index : Int       := 0;
       Scope_Id     : Entity_Id := Current_Scope) return Entity_Id
    is
       Typ : Entity_Id;

gcc/ada/itypes.ads

@@ -110,7 +110,7 @@ package Itypes is
       Related_Nod  : Node_Id;
       Related_Id   : Entity_Id := Empty;
       Suffix       : Character := ' ';
-      Suffix_Index : Nat       := 0;
+      Suffix_Index : Int       := 0;
       Scope_Id     : Entity_Id := Current_Scope) return Entity_Id;
    --  Used to create a new Itype
    --

gcc/ada/sem_ch3.adb

@@ -9453,6 +9453,7 @@ package body Sem_Ch3 is
               (Derived_Type, Save_Discr_Constr);
             Set_Stored_Constraint
               (Derived_Type, Expand_To_Stored_Constraint (Parent_Type, Discs));
+
             Replace_Components (Derived_Type, New_Decl);
          end if;
 
@@ -13692,7 +13693,8 @@ package body Sem_Ch3 is
       Related_Nod : Node_Id) return Entity_Id
    is
       T_Sub : constant Entity_Id :=
-                Create_Itype (E_Record_Subtype, Related_Nod, Corr_Rec, 'C');
+                Create_Itype (E_Record_Subtype,
+                  Related_Nod, Corr_Rec, 'C', Suffix_Index => -1);
 
    begin
       Set_Etype             (T_Sub, Corr_Rec);

gcc/ada/sem_util.adb

@@ -20997,7 +20997,7 @@ package body Sem_Util is
       Sloc_Value   : Source_Ptr;
       Related_Id   : Entity_Id;
       Suffix       : Character;
-      Suffix_Index : Nat := 0;
+      Suffix_Index : Int := 0;
       Prefix       : Character := ' ') return Entity_Id
    is
       N : constant Entity_Id :=
@@ -24039,6 +24039,15 @@ package body Sem_Util is
            and then Outer = Protected_Body_Subprogram (Curr)
          then
             return True;
+
+         --  OUtside of its scope, a synchronized type may just be
+         --  private.
+
+         elsif Is_Private_Type (Curr)
+           and then Present (Full_View (Curr))
+            and then Is_Concurrent_Type (Full_View (Curr))
+         then
+            return Scope_Within (Full_View (Curr), Outer);
          end if;
       end loop;
 

gcc/ada/sem_util.ads

@@ -2326,7 +2326,7 @@ package Sem_Util is
       Sloc_Value   : Source_Ptr;
       Related_Id   : Entity_Id;
       Suffix       : Character;
-      Suffix_Index : Nat := 0;
+      Suffix_Index : Int := 0;
       Prefix       : Character := ' ') return Entity_Id;
    --  This function creates an N_Defining_Identifier node for an internal
    --  created entity, such as an implicit type or subtype, or a record

gcc/testsuite/ChangeLog

+2018-08-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* gnat.dg/task1.adb, gnat.dg/task1.ads, gnat.dg/task1_pkg.adb,
+	gnat.dg/task1_pkg.ads: New testcase.
+
 2018-08-21  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* gnat.dg/linkedlist.adb: New testcase.

gcc/testsuite/gnat.dg/task1.adb

+--  { dg-do assemble }
+
+package body Task1 is
+   procedure Dummy is null;
+end Task1;

gcc/testsuite/gnat.dg/task1.ads

+with Task1_Pkg; use Task1_Pkg;
+
+package Task1 is
+   TAB : constant Typ_Task_Par_Tab := (others => (Dummy => FALSE));
+
+   T1 : Typ_Task (TAB (1).Dummy);
+   T2 : Typ_Task (TAB (2).Dummy);
+
+   procedure Dummy;
+end Task1;

gcc/testsuite/gnat.dg/task1_pkg.adb

+package body Task1_Pkg is
+   task body Typ_Task is
+   begin
+      loop
+         null;
+      end loop;
+   end Typ_Task;
+
+begin
+   null;
+end Task1_Pkg;

gcc/testsuite/gnat.dg/task1_pkg.ads

+package Task1_Pkg is
+   subtype Typ_Bool is boolean;
+
+   type Typ_Task_Par is record
+      Dummy : Typ_Bool;
+   end record;
+
+   type Typ_Task_Par_Tab is array (1 .. 33) of aliased Typ_Task_Par;
+   task type Typ_Task (dummy : Typ_Bool);
+end Task1_Pkg;