diff mbox series

[Ada] Spurious error on partial parameterization

Message ID 20171020160854.GA9216@adacore.com
State New
Headers show
Series [Ada] Spurious error on partial parameterization | expand

Commit Message

Pierre-Marie de Rodat Oct. 20, 2017, 4:08 p.m. UTC 
This patch corrects an issue whereby a defaulted formal package actual
generated a spurious type mismatch error upon instantiation instead of beging
accepted as per ARM 12.7 4.4/3.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

2017-10-20  Justin Squirek  <squirek@adacore.com>

	* sem_ch12.adb (Check_Formal_Package_Instance): Add sanity check to
	verify a renaming exists for a generic formal before comparing it to
	the actual as defaulted formals will not have a renamed_object.

gcc/testsuite/

2017-10-20  Justin Squirek  <squirek@adacore.com>

	* gnat.dg/default_pkg_actual.adb, gnat.dg/default_pkg_actual2.adb: New
	testcases.
diff mbox series

Patch

Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb	(revision 253941)
+++ sem_ch12.adb	(working copy)
@@ -6459,10 +6459,11 @@ 
          elsif Ekind (E1) = E_Package then
             Check_Mismatch
               (Ekind (E1) /= Ekind (E2)
-                or else Renamed_Object (E1) /= Renamed_Object (E2));
+                or else (Present (Renamed_Object (E2))
+                          and then Renamed_Object (E1) /=
+                                     Renamed_Object (E2)));
 
          elsif Is_Overloadable (E1) then
-
             --  Verify that the actual subprograms match. Note that actuals
             --  that are attributes are rewritten as subprograms. If the
             --  subprogram in the formal package is defaulted, no check is
Index: ../testsuite/gnat.dg/default_pkg_actual.adb
===================================================================
--- ../testsuite/gnat.dg/default_pkg_actual.adb	(revision 0)
+++ ../testsuite/gnat.dg/default_pkg_actual.adb	(revision 0)
@@ -0,0 +1,32 @@ 
+--  { dg-do compile }
+
+procedure Default_Pkg_Actual is
+
+   generic
+   package As is
+   end As;
+
+   generic
+      type T is private;
+      with package A0 is new As;
+   package Bs is
+   end Bs;
+
+   generic
+      with package Xa is new As;
+   package Xs is
+      package Xb is new Bs(T => Integer, A0 => Xa);
+   end Xs;
+
+   generic
+      with package Yb is new Bs(T => Integer, others => <>);
+   package Ys is
+   end Ys;
+
+   package A is new As;
+   package X is new Xs(Xa => A);
+   package Y is new Ys(Yb => X.Xb);
+
+begin
+   null;
+end;
Index: ../testsuite/gnat.dg/default_pkg_actual2.adb
===================================================================
--- ../testsuite/gnat.dg/default_pkg_actual2.adb	(revision 0)
+++ ../testsuite/gnat.dg/default_pkg_actual2.adb	(revision 0)
@@ -0,0 +1,27 @@ 
+--  { dg-do compile }
+
+procedure Default_Pkg_Actual2 is
+
+   generic
+   package P1 is
+   end;
+
+   generic
+      with package FP1a is new P1;
+      with package FP1b is new P1;
+   package P2 is
+   end;
+
+   generic
+      with package FP2 is new P2 (FP1a => <>,  FP1b => <>);
+   package P3 is
+   end;
+
+   package NP1a is new P1;
+   package NP1b is new P1;
+   package NP2  is new P2 (NP1a, NP1b);
+   package NP4  is new P3 (NP2);
+
+begin
+   null;
+end;