From 2e5df2955f9ec8deafeb2978fcb38fb99f2660fd Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 21 Aug 2018 14:46:34 +0000 Subject: [PATCH] [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 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 | 14 ++++++++++++++ gcc/ada/itypes.adb | 2 +- gcc/ada/itypes.ads | 2 +- gcc/ada/sem_ch3.adb | 4 +++- gcc/ada/sem_util.adb | 11 ++++++++++- gcc/ada/sem_util.ads | 2 +- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/task1.adb | 5 +++++ gcc/testsuite/gnat.dg/task1.ads | 10 ++++++++++ gcc/testsuite/gnat.dg/task1_pkg.adb | 11 +++++++++++ gcc/testsuite/gnat.dg/task1_pkg.ads | 10 ++++++++++ 11 files changed, 71 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/task1.adb create mode 100644 gcc/testsuite/gnat.dg/task1.ads create mode 100644 gcc/testsuite/gnat.dg/task1_pkg.adb create mode 100644 gcc/testsuite/gnat.dg/task1_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2b17d4af563..df4a9dbdf9c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2018-08-21 Ed Schonberg + + * 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 * doc/gnat_ugn/gnat_and_program_execution.rst: Update diff --git a/gcc/ada/itypes.adb b/gcc/ada/itypes.adb index fa88ef70ff0..6640c57bac1 100644 --- 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 e59cbe8097b..1513c8afff7 100644 --- 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 349ece78761..d12ccc9c9a9 100644 --- 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 bfa2b4fb141..a8ea805d467 100644 --- 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 aec3644ed5b..74d670dabba 100644 --- 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 f95fe09eb3d..5d4bdbd8d19 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-08-21 Ed Schonberg + + * 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 * 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 index 00000000000..1f1d1e960d7 --- /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 index 00000000000..8908915248b --- /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 index 00000000000..abd0a3657d9 --- /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 index 00000000000..183d2395e84 --- /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; -- 2.30.2