Commit d21c7dd6 by Ed Schonberg Committed by Pierre-Marie de Rodat

[Ada] Spurious error on inst. of partially defaulted formal package

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.

2019-07-01  Ed Schonberg  <schonberg@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.

From-SVN: r272883
parent 6578a6bf
2019-07-01 Ed Schonberg <schonberg@adacore.com>
* 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,
2019-07-01 Hristian Kirtchev <kirtchev@adacore.com> 2019-07-01 Hristian Kirtchev <kirtchev@adacore.com>
* checks.adb, exp_ch9.adb, exp_unst.adb, sem_ch4.adb, * checks.adb, exp_ch9.adb, exp_unst.adb, sem_ch4.adb,
......
...@@ -6195,6 +6195,12 @@ package body Sem_Ch12 is ...@@ -6195,6 +6195,12 @@ package body Sem_Ch12 is
-- Common error routine for mismatch between the parameters of the -- Common error routine for mismatch between the parameters of the
-- actual instance and those of the formal package. -- 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; function Same_Instantiated_Constant (E1, E2 : Entity_Id) return Boolean;
-- The formal may come from a nested formal package, and the actual may -- The formal may come from a nested formal package, and the actual may
-- have been constant-folded. To determine whether the two denote the -- have been constant-folded. To determine whether the two denote the
...@@ -6245,6 +6251,32 @@ package body Sem_Ch12 is ...@@ -6245,6 +6251,32 @@ package body Sem_Ch12 is
end if; end if;
end Check_Mismatch; 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 -- -- Same_Instantiated_Constant --
-------------------------------- --------------------------------
...@@ -6414,6 +6446,9 @@ package body Sem_Ch12 is ...@@ -6414,6 +6446,9 @@ package body Sem_Ch12 is
then then
goto Next_E; goto Next_E;
elsif Is_Defaulted (E1) then
goto Next_E;
elsif Is_Type (E1) then elsif Is_Type (E1) then
-- Subtypes must statically match. E1, E2 are the local entities -- Subtypes must statically match. E1, E2 are the local entities
......
2019-07-01 Ed Schonberg <schonberg@adacore.com> 2019-07-01 Ed Schonberg <schonberg@adacore.com>
* 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.
2019-07-01 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/enum_rep.adb, gnat.dg/enum_rep.ads: New testcase. * gnat.dg/enum_rep.adb, gnat.dg/enum_rep.ads: New testcase.
2019-07-01 Ed Schonberg <schonberg@adacore.com> 2019-07-01 Ed Schonberg <schonberg@adacore.com>
......
-- { 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;
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;
package Generic_Inst3_Kafka_Lib is
end Generic_Inst3_Kafka_Lib;
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;
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;
package Generic_Inst3_Traits is
pragma Pure;
end Generic_Inst3_Traits;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment