diff options
author | Ed Schonberg <schonberg@adacore.com> | 2018-08-21 14:46:34 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2018-08-21 14:46:34 +0000 |
commit | 2e5df2955f9ec8deafeb2978fcb38fb99f2660fd (patch) | |
tree | cbf64f4e30b3edf5001151630d175f1f3adafefb | |
parent | c4b9b2916ceb22b57d72fee8f775e02a8851d086 (diff) | |
download | gcc-2e5df2955f9ec8deafeb2978fcb38fb99f2660fd.zip gcc-2e5df2955f9ec8deafeb2978fcb38fb99f2660fd.tar.gz gcc-2e5df2955f9ec8deafeb2978fcb38fb99f2660fd.tar.bz2 |
[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
-rw-r--r-- | gcc/ada/ChangeLog | 14 | ||||
-rw-r--r-- | gcc/ada/itypes.adb | 2 | ||||
-rw-r--r-- | gcc/ada/itypes.ads | 2 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 4 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 11 | ||||
-rw-r--r-- | gcc/ada/sem_util.ads | 2 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/task1.adb | 5 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/task1.ads | 10 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/task1_pkg.adb | 11 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/task1_pkg.ads | 10 |
11 files changed, 71 insertions, 5 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2b17d4a..df4a9db 100644 --- 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 fa88ef7..6640c57 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 e59cbe8..1513c8a 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 349ece7..d12ccc9 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 bfa2b4f..a8ea805 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 aec3644..74d670d 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 f95fe09..5d4bdbd 100644 --- 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 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 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 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 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; |