From: pmderodat Date: Tue, 21 Aug 2018 14:46:34 +0000 (+0000) Subject: [Ada] Spurious "Duplicated symbol" error with discriminated tasks X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=04d047d8fab8a417d65ce5e2902efcf0798c0838;p=thirdparty%2Fgcc.git [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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@263716 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2b17d4af5630..df4a9dbdf9c3 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 fa88ef70ff05..6640c57bac19 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 e59cbe8097b4..1513c8afff79 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 349ece787613..d12ccc9c9a96 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 bfa2b4fb141f..a8ea805d467a 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 aec3644ed5b7..74d670dabbac 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 f95fe09eb3da..5d4bdbd8d191 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 000000000000..1f1d1e960d7c --- /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 000000000000..8908915248b4 --- /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 000000000000..abd0a3657d9b --- /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 000000000000..183d2395e848 --- /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;