This patch removes a spurious error on an instantiation whose generic
unit has a formal package where some formal parameters are
box-initialiaed. Previously the code assumed that box-initialization
for a formal package applied to all its formal parameters.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-07-01 Ed Schonberg <schonb...@adacore.com>
gcc/ada/
* sem_ch12.adb (Is_Defaulted): New predicate in
Check_Formal_Package_Intance, to skip the conformance of checks
on parameters of a formal package that are defaulted,
gcc/testsuite/
* gnat.dg/generic_inst3.adb,
gnat.dg/generic_inst3_kafka_lib-topic.ads,
gnat.dg/generic_inst3_kafka_lib.ads,
gnat.dg/generic_inst3_markets.ads,
gnat.dg/generic_inst3_traits-encodables.ads,
gnat.dg/generic_inst3_traits.ads: New testcase.--- gcc/ada/sem_ch12.adb
+++ gcc/ada/sem_ch12.adb
@@ -6195,6 +6195,12 @@ package body Sem_Ch12 is
-- Common error routine for mismatch between the parameters of the
-- actual instance and those of the formal package.
+ function Is_Defaulted (Param : Entity_Id) return Boolean;
+ -- If the formql package has partly box-initialized formals, skip
+ -- conformace check for these formals. Previously the code assumed
+ -- that boc initialization for a formal package applied to all
+ -- its formal parameters.
+
function Same_Instantiated_Constant (E1, E2 : Entity_Id) return Boolean;
-- The formal may come from a nested formal package, and the actual may
-- have been constant-folded. To determine whether the two denote the
@@ -6245,6 +6251,32 @@ package body Sem_Ch12 is
end if;
end Check_Mismatch;
+ ------------------
+ -- Is_Defaulted --
+ ------------------
+
+ function Is_Defaulted (Param : Entity_Id) return Boolean is
+ Assoc : Node_Id;
+ begin
+ Assoc := First (Generic_Associations
+ (Parent (Associated_Formal_Package (Actual_Pack))));
+
+ while Present (Assoc) loop
+ if Nkind (Assoc) = N_Others_Choice then
+ return True;
+
+ elsif Nkind (Assoc) = N_Generic_Association
+ and then Chars (Selector_Name (Assoc)) = Chars (Param)
+ then
+ return Box_Present (Assoc);
+ end if;
+
+ Next (Assoc);
+ end loop;
+
+ return False;
+ end Is_Defaulted;
+
--------------------------------
-- Same_Instantiated_Constant --
--------------------------------
@@ -6414,6 +6446,9 @@ package body Sem_Ch12 is
then
goto Next_E;
+ elsif Is_Defaulted (E1) then
+ goto Next_E;
+
elsif Is_Type (E1) then
-- Subtypes must statically match. E1, E2 are the local entities
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst3.adb
@@ -0,0 +1,20 @@
+-- { dg-do compile }
+
+with Generic_Inst3_Kafka_Lib.Topic;
+with Generic_Inst3_Traits.Encodables;
+with Generic_Inst3_Markets;
+
+procedure Generic_Inst3 is
+ generic
+ with package Values is new Generic_Inst3_Traits.Encodables (<>);
+ with package Topic is new Generic_Inst3_Kafka_Lib.Topic
+ (Values => Values, others => <>);
+ package Dummy is
+ end Dummy;
+
+ package Inst is new Dummy
+ (Values => Generic_Inst3_Markets.Data_Encodables,
+ Topic => Generic_Inst3_Markets.Data_Topic);
+begin
+ null;
+end Generic_Inst3;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst3_kafka_lib-topic.ads
@@ -0,0 +1,7 @@
+with Generic_Inst3_Traits.Encodables;
+generic
+ Topic_Name : String;
+ with package Keys is new Generic_Inst3_Traits.Encodables (<>);
+ with package Values is new Generic_Inst3_Traits.Encodables (<>);
+package Generic_Inst3_Kafka_Lib.Topic is
+end Generic_Inst3_Kafka_Lib.Topic;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst3_kafka_lib.ads
@@ -0,0 +1,2 @@
+package Generic_Inst3_Kafka_Lib is
+end Generic_Inst3_Kafka_Lib;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst3_markets.ads
@@ -0,0 +1,10 @@
+with Generic_Inst3_Kafka_Lib.Topic;
+with Generic_Inst3_Traits.Encodables;
+package Generic_Inst3_Markets is
+ type Data_Type is null record;
+ function Image (D : Data_Type) return String is ("");
+ package Data_Encodables is new Generic_Inst3_Traits.Encodables (Data_Type, Image);
+ package Data_Topic is new Generic_Inst3_Kafka_Lib.Topic
+ (Keys => Data_Encodables, Values => Data_Encodables,
+ Topic_Name => "bla");
+end Generic_Inst3_Markets;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst3_traits-encodables.ads
@@ -0,0 +1,8 @@
+with Ada.Streams;
+generic
+ pragma Warnings (Off, "is not referenced");
+ type T (<>) is private;
+ with function Image (Val : in T) return String;
+package Generic_Inst3_Traits.Encodables is
+ pragma Pure;
+end Generic_Inst3_Traits.Encodables;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst3_traits.ads
@@ -0,0 +1,3 @@
+package Generic_Inst3_Traits is
+ pragma Pure;
+end Generic_Inst3_Traits;
