This patch suppresses a spurious ambiguity error on a prefixed call to an
inherited class-wide operation, when the operation also has other visible
homonyms in the context.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
2017-10-09 Ed Schonberg <schonb...@adacore.com>
* sem_ch4.adb (Try_Class_Wide_Operation, Traverse_Homonyms):
Suppress spurious ambiguity error when two traversals of the homonym
chain (first directly, and then through an examination of relevant
interfaces) retrieve the same operation, when other irrelevant homonyms
of the operatioh are also present.
gcc/testsuite/
2017-10-09 Ed Schonberg <schonb...@adacore.com>
* gnat.dg/class_wide3.adb, gnat.dg/class_wide3_pkg.ads: New testcase.
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 253546)
+++ sem_ch4.adb (working copy)
@@ -8860,7 +8860,7 @@
while Present (Hom) loop
if Ekind_In (Hom, E_Procedure, E_Function)
and then (not Is_Hidden (Hom) or else In_Instance)
- and then Scope (Hom) = Scope (Anc_Type)
+ and then Scope (Hom) = Scope (Base_Type (Anc_Type))
and then Present (First_Formal (Hom))
and then
(Base_Type (Etype (First_Formal (Hom))) = Cls_Type
@@ -8921,8 +8921,13 @@
Success => Success,
Skip_First => True);
+ -- The same operation may be encountered on two homonym
+ -- traversals, before and after looking at interfaces.
+ -- Check for this case before reporting a real ambiguity.
+
if Present (Valid_Candidate (Success, Call_Node, Hom))
and then Nkind (Call_Node) /= N_Function_Call
+ and then Hom /= Matching_Op
then
Error_Msg_NE ("ambiguous call to&", N, Hom);
Report_Ambiguity (Matching_Op);
Index: ../testsuite/gnat.dg/class_wide3.adb
===================================================================
--- ../testsuite/gnat.dg/class_wide3.adb (revision 0)
+++ ../testsuite/gnat.dg/class_wide3.adb (revision 0)
@@ -0,0 +1,8 @@
+with Ada.Text_IO; use Ada.Text_IO;
+with Class_Wide3_Pkg; use Class_Wide3_Pkg;
+
+procedure Class_Wide3 is
+ DC : Disc_Child := (N => 1, I => 3, J => 5);
+begin
+ DC.Put_Line;
+end Class_Wide3;
Index: ../testsuite/gnat.dg/class_wide3_pkg.ads
===================================================================
--- ../testsuite/gnat.dg/class_wide3_pkg.ads (revision 0)
+++ ../testsuite/gnat.dg/class_wide3_pkg.ads (revision 0)
@@ -0,0 +1,16 @@
+package Class_Wide3_Pkg is
+
+ type Iface is interface;
+ type Iface_Ptr is access all Iface'Class;
+
+ procedure Put_Line (I : Iface'Class);
+
+ type Root is tagged record
+ I : Integer;
+ end record;
+
+ type Disc_Child (N : Integer) is new Root and Iface with record
+ J : Integer;
+ end record;
+
+end Class_Wide3_Pkg;
