[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7d867bfd5eabf00db17a6befd7563a66b2d74935..5ff5f16875ae0f4e8b552fe77f6b04b0e7164687 100644 (file)
--- 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 17de328d29f081b7de110a16e1dc192275e18d3b..61a40ebcb94d25f9fdba80c56b57595960c6d612 100644 (file)
--- 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 3755221c56bcae2ee940579b3011614370ab10e6..69e78548ab8e2b699c6cbc571c6a428e62741d58 100644 (file)
--- 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 (file)
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 (file)
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 (file)
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 (file)
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;