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

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

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 1045 bytes --]

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.

Tested on x86_64-pc-linux-gnu, committed on trunk

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.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 3929 bytes --]

--- gcc/ada/itypes.adb
+++ 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
+++ 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
+++ 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
+++ 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
+++ 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

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/task1.adb
@@ -0,0 +1,5 @@
+--  { dg-do assemble }
+
+package body Task1 is
+   procedure Dummy is null;
+end Task1;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/task1.ads
@@ -0,0 +1,10 @@
+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;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/task1_pkg.adb
@@ -0,0 +1,11 @@
+package body Task1_Pkg is
+   task body Typ_Task is
+   begin
+      loop
+         null;
+      end loop;
+   end Typ_Task;
+
+begin
+   null;
+end Task1_Pkg;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/task1_pkg.ads
@@ -0,0 +1,10 @@
+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;