[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2b17d4af5630c9da9549a66a4724150e6c6deee1..df4a9dbdf9c39c1359c90a94e71445617cd59225 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+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

diff --git a/gcc/ada/itypes.adb b/gcc/ada/itypes.adb
index fa88ef70ff05ae25d10367538e652246e75722ef..6640c57bac1935207e2ee1edc4b3404ace088485 100644 (file)
--- a/gcc/ada/itypes.adb
+++ b/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;

diff --git a/gcc/ada/itypes.ads b/gcc/ada/itypes.ads
index e59cbe8097b485ddc49e5fd4226995908604d0bf..1513c8afff797ffc61d5df34ba4aa76e80c83403 100644 (file)
--- a/gcc/ada/itypes.ads
+++ b/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
    --

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 349ece787613136aff383d39ef31920af4f4ee32..d12ccc9c9a969d779b3eef5a557c9b06b9b1c72b 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/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);

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index bfa2b4fb141fa2e81e5144f94d30e08487ec633f..a8ea805d467a31e9538940a447bc77cb02dedcd7 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/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;
 

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index aec3644ed5b7eda32f99550c1668649350d85dc2..74d670dabbaca9de67795ba1abea7779a5e73a72 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f95fe09eb3daf0811d9c53080f7191df4c597856..5d4bdbd8d1918b4c2616afbca4ae340b4012223f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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.

diff --git a/gcc/testsuite/gnat.dg/task1.adb b/gcc/testsuite/gnat.dg/task1.adb
new file mode 100644 (file)
index 0000000..1f1d1e9
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/task1.adb
@@ -0,0 +1,5 @@
+--  { dg-do assemble }
+
+package body Task1 is
+   procedure Dummy is null;
+end Task1;

diff --git a/gcc/testsuite/gnat.dg/task1.ads b/gcc/testsuite/gnat.dg/task1.ads
new file mode 100644 (file)
index 0000000..8908915
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/task1_pkg.adb b/gcc/testsuite/gnat.dg/task1_pkg.adb
new file mode 100644 (file)
index 0000000..abd0a36
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/task1_pkg.ads b/gcc/testsuite/gnat.dg/task1_pkg.ads
new file mode 100644 (file)
index 0000000..183d239
--- /dev/null
+++ b/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;