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 <squi...@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 <squi...@adacore.com>
* gnat.dg/default_pkg_actual.adb, gnat.dg/default_pkg_actual2.adb: New
testcases.
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;
