From: Eric Botcazou Date: Thu, 19 Sep 2019 08:13:01 +0000 (+0000) Subject: [Ada] Fix spurious type mismatch failure on nested instantiations X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=4af04d04c427e2ca78bb988cf6b1ad209a99a142;p=gcc.git [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 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7d867bfd5ea..5ff5f16875a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-09-19 Eric Botcazou + + * 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 * 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 17de328d29f..61a40ebcb94 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 3755221c56b..69e78548ab8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2019-09-19 Eric Botcazou + + * 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 * 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 00000000000..c83b893dae8 --- /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 00000000000..edbfe942afe --- /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 00000000000..08329408ed0 --- /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 00000000000..5cdfb64834f --- /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;