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;