diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2019-09-19 08:13:01 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-09-19 08:13:01 +0000 |
commit | 4af04d04c427e2ca78bb988cf6b1ad209a99a142 (patch) | |
tree | 6aecebcde170934f49929bc06001f08200b70add | |
parent | 682c09cebada73fb80e3a36fec6a3b1a09c5781e (diff) | |
download | gcc-4af04d04c427e2ca78bb988cf6b1ad209a99a142.zip gcc-4af04d04c427e2ca78bb988cf6b1ad209a99a142.tar.gz gcc-4af04d04c427e2ca78bb988cf6b1ad209a99a142.tar.bz2 |
[Ada] Fix spurious type mismatch failure on nested instantiations
This fixes a spurious type mismatch failure reported between formal and
actual of a call to a subprogram that comes from the instantiation of a
child generic unit that itself contains an instantiation of a slibling
child generic unit, when the parent is itself a generic unit with
private part. The regression was introduced by a recent change made to
clear the Is_Generic_Actual_Type on the implicit full view built when a
generic package is instantiated on a private type.
2019-09-19 Eric Botcazou <ebotcazou@adacore.com>
gcc/ada/
* sem_ch12.adb (Restore_Private_Views): Comment out new code
that clear the Is_Generic_Actual_Type also on the full view.
gcc/testsuite/
* gnat.dg/generic_inst13.adb,
gnat.dg/generic_inst13_pkg-nested_g.ads,
gnat.dg/generic_inst13_pkg-ops_g.ads,
gnat.dg/generic_inst13_pkg.ads: New testcase.
From-SVN: r275935
-rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/ada/sem_ch12.adb | 14 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/generic_inst13.adb | 22 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/generic_inst13_pkg-nested_g.ads | 14 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/generic_inst13_pkg-ops_g.ads | 9 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/generic_inst13_pkg.ads | 11 |
7 files changed, 79 insertions, 3 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7d867bf..5ff5f16 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-09-19 Eric Botcazou <ebotcazou@adacore.com> + + * sem_ch12.adb (Restore_Private_Views): Comment out new code + that clear the Is_Generic_Actual_Type also on the full view. + 2019-09-19 Bob Duff <duff@adacore.com> * exp_ch3.adb (Rewrite_As_Renaming): Return False if there are diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 17de328..61a40eb 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -14638,9 +14638,17 @@ package body Sem_Ch12 is else Set_Is_Generic_Actual_Type (E, False); - if Is_Private_Type (E) and then Present (Full_View (E)) then - Set_Is_Generic_Actual_Type (Full_View (E), False); - end if; + -- It might seem reasonable to clear the Is_Generic_Actual_Type + -- flag also on the Full_View if the type is private, since it + -- was set also on this Full_View. However, this flag is relied + -- upon by Covers to spot "types exported from instantiations" + -- which are implicit Full_Views built for instantiations made + -- on private types and we get type mismatches if we do it when + -- the block exchanging the declarations below triggers ??? + + -- if Is_Private_Type (E) and then Present (Full_View (E)) then + -- Set_Is_Generic_Actual_Type (Full_View (E), False); + -- end if; end if; -- An unusual case of aliasing: the actual may also be directly diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3755221..69e7854 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2019-09-19 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/generic_inst13.adb, + gnat.dg/generic_inst13_pkg-nested_g.ads, + gnat.dg/generic_inst13_pkg-ops_g.ads, + gnat.dg/generic_inst13_pkg.ads: New testcase. + 2019-09-19 Bob Duff <duff@adacore.com> * gnat.dg/concat3.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/generic_inst13.adb b/gcc/testsuite/gnat.dg/generic_inst13.adb new file mode 100644 index 0000000..c83b893 --- /dev/null +++ b/gcc/testsuite/gnat.dg/generic_inst13.adb @@ -0,0 +1,22 @@ +-- { dg-do compile } + +with Generic_Inst13_Pkg; +with Generic_Inst13_Pkg.Nested_G; + +procedure Generic_Inst13 is + + type Item_T is range 1 .. 16; + + package My_Inst is new Generic_Inst13_Pkg (Item_T); + + package My_Nested is new My_Inst.Nested_G; + + procedure Proc (Left, Right : My_Nested.T) is + R : constant My_Nested.List_T := My_Nested."or" (Left, Right); + begin + null; + end; + +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/generic_inst13_pkg-nested_g.ads b/gcc/testsuite/gnat.dg/generic_inst13_pkg-nested_g.ads new file mode 100644 index 0000000..edbfe94 --- /dev/null +++ b/gcc/testsuite/gnat.dg/generic_inst13_pkg-nested_g.ads @@ -0,0 +1,14 @@ +with Generic_Inst13_Pkg.Ops_G; + +generic +package Generic_Inst13_Pkg.Nested_G is + + type T is new Generic_Inst13_Pkg.T; + + package My_Operations is new Generic_Inst13_Pkg.Ops_G (T); + + subtype List_T is My_Operations.List_T; + + function "or" (Left, Right : T) return List_T renames My_Operations."or"; + +end Generic_Inst13_Pkg.Nested_G; diff --git a/gcc/testsuite/gnat.dg/generic_inst13_pkg-ops_g.ads b/gcc/testsuite/gnat.dg/generic_inst13_pkg-ops_g.ads new file mode 100644 index 0000000..0832940 --- /dev/null +++ b/gcc/testsuite/gnat.dg/generic_inst13_pkg-ops_g.ads @@ -0,0 +1,9 @@ +generic + type Data_T is private; +package Generic_Inst13_Pkg.Ops_G is + + type List_T is array (Positive range <>) of Data_T; + + function "or" (Left, Right : Data_T) return List_T is ((Left, Right)); + +end Generic_Inst13_Pkg.Ops_G;
\ No newline at end of file diff --git a/gcc/testsuite/gnat.dg/generic_inst13_pkg.ads b/gcc/testsuite/gnat.dg/generic_inst13_pkg.ads new file mode 100644 index 0000000..5cdfb64 --- /dev/null +++ b/gcc/testsuite/gnat.dg/generic_inst13_pkg.ads @@ -0,0 +1,11 @@ +generic + type Component_T is private; +package Generic_Inst13_Pkg is + + type T is private; + +private + + type T is array (Boolean) of Component_T; + +end Generic_Inst13_Pkg; |