[PATCH] Check record types for compatibility in ada_type_match

[Tom Tromey <tromey@adacore.com>]

While investigating some gdb test suite failures when run against
gnat-llvm, I found this oddity in operator_call.exp:

    (gdb) print p < p
    Multiple matches for "<"
    [0] cancel
    [1] system.dwarf_lines."<" (system.dwarf_lines.search_entry; system.dwarf_lines.search_entry) return boolean at s-dwalin.adb:265
    [2] twovecs."<" (twovecs.twovec; twovecs.twovec) return boolean at twovecs.adb:61

While operator_call.exp generally doesn't work yet with gnat-llvm,
this particular failure seemed wrong, because the types here aren't
even remotely related or compatible -- that is, this call should not
be ambiguous.

Looking into this, I found that ada_type_match assumes that all record
types are identical.

I think gdb can do a bit better than this, without trying to implement
full Ada overload resolution (which IIUC would require type
inferencing as well).

In particular we can at least filter out the matches that are wholly
unsuitable.  That is what this patch does.
---
 gdb/ada-lang.c                                | 58 ++++++++++++++-
 gdb/testsuite/gdb.ada/record-overloads.exp    | 70 +++++++++++++++++++
 .../gdb.ada/record-overloads/pck.adb          | 43 ++++++++++++
 .../gdb.ada/record-overloads/pck.ads          | 50 +++++++++++++
 .../gdb.ada/record-overloads/prog.adb         | 32 +++++++++
 5 files changed, 252 insertions(+), 1 deletion(-)
 create mode 100644 gdb/testsuite/gdb.ada/record-overloads.exp
 create mode 100644 gdb/testsuite/gdb.ada/record-overloads/pck.adb
 create mode 100644 gdb/testsuite/gdb.ada/record-overloads/pck.ads
 create mode 100644 gdb/testsuite/gdb.ada/record-overloads/prog.adb

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 174e04af04c..f1aa13fff97 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -4029,6 +4029,57 @@ ada_type_match_arrays (struct type *ftype, struct type *atype)
   return ada_type_match (f_elt_type, a_elt_type);
 }
 
+/* Helper for ada_type_match that checks that two record types are
+   compatible.  As with that function, FTYPE is the formal type and
+   ATYPE is the actual type.
+
+   Note that it is ok if this function is not precise, as long as
+   there aren't too many false negatives.  That is, it's better to
+   return 'true', because that will result in a menu being presented
+   to the user.  */
+
+static bool
+ada_type_match_records (type *ftype, type *atype)
+{
+  /* In the case of tagged types, we look through the parent types;
+     hence the loop.  */
+  while (atype != nullptr)
+    {
+      if (ftype == atype)
+	return true;
+
+      /* Note that the formal type might be dynamic in some way.  So,
+	 the checks we can do easily are fairly limited.  However, in
+	 Ada simply checking the name should be sufficient, because
+	 Ada doesn't allow anonymous record types; nor does it allow
+	 two record types with the same name.  And, if this is somehow
+	 violated (through shared library shenanigans or something),
+	 then it's fine to conservatively return 'true'.  Note we use
+	 the safe name here, because although Ada doesn't allow
+	 anonymous types, with a little effort the user could arrange
+	 for any type as the actual type.  */
+      if (streq (ftype->safe_name (), atype->safe_name ()))
+	return true;
+
+      /* Currently, gdb does not implement dispatching calls, and
+	 class-wide types aren't well-represented in the DWARF anyway.
+	 So as a heuristic, return true if the formal type is a parent
+	 of the actual type.  This works out OK because gdb finds the
+	 true runtime type of the actual parameter.
+
+	 This could be improved by further examining the overload set
+	 for a best match.  However this isn't done today, which is
+	 why the heuristic is needed.  */
+      if (!ada_is_tagged_type (atype, false))
+	break;
+
+      /* If this returns nullptr, the loop will stop.  */
+      atype = ada_parent_type (atype);
+    }
+
+  return false;
+}
+
 /* Return non-zero if formal type FTYPE matches actual type ATYPE.
    The term "match" here is rather loose.  The match is heuristic and
    liberal -- while it tries to reject matches that are obviously
@@ -4046,6 +4097,10 @@ ada_type_match (struct type *ftype, struct type *atype)
   if (atype->code () == TYPE_CODE_REF)
     atype = ada_check_typedef (atype->target_type ());
 
+  /* Also remove aligner types.  */
+  ftype = ada_aligned_type (ftype);
+  atype = ada_aligned_type (atype);
+
   switch (ftype->code ())
     {
     default:
@@ -4074,7 +4129,8 @@ ada_type_match (struct type *ftype, struct type *atype)
     case TYPE_CODE_STRUCT:
       if (!ada_is_array_descriptor_type (ftype))
 	return (atype->code () == TYPE_CODE_STRUCT
-		&& !ada_is_array_descriptor_type (atype));
+		&& !ada_is_array_descriptor_type (atype)
+		&& ada_type_match_records (ftype, atype));
 
       [[fallthrough]];
     case TYPE_CODE_ARRAY:
diff --git a/gdb/testsuite/gdb.ada/record-overloads.exp b/gdb/testsuite/gdb.ada/record-overloads.exp
new file mode 100644
index 00000000000..05318cedd30
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/record-overloads.exp
@@ -0,0 +1,70 @@
+# Copyright 2026 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+load_lib "ada.exp"
+
+require allow_ada_tests
+
+standard_ada_testfile prog
+
+foreach_gnat_encoding scenario flags {all minimal} {
+    lappend flags debug
+
+    if {[gdb_compile_ada "${srcfile}" "${binfile}-${scenario}" \
+	     executable $flags] != ""} {
+	return
+    }
+
+    clean_restart ${testfile}-${scenario}
+
+    set bp_location [gdb_get_line_number "START" ${testdir}/prog.adb]
+    runto "prog.adb:$bp_location"
+
+    gdb_test "print oload(r1)" [quotemeta {@DECIMAL = 0}]
+    gdb_test "print oload(r2)" [quotemeta {@DECIMAL = 1}]
+
+    # This one is not ambiguous.
+    gdb_test "print oload(rb)" [quotemeta {@DECIMAL = 2}]
+
+    # Neither is this one, because gdb can see that RCB's runtime type
+    # is Rec_Base.
+    gdb_test "print oload(rcb)" [quotemeta {@DECIMAL = 2}]
+
+    gdb_test "print oload(rcf)" [quotemeta {@DECIMAL = 4}]
+
+    proc test_menu {var} {
+	set menu [multi_line "Multiple matches for oload" \
+		      "\\\[0\\\] cancel" \
+		      "\\\[1\\\] pck.oload (.*rec_base).*" \
+		      "\\\[2\\\] pck.oload (.*rec_derived).*" \
+		      "> $"]
+	gdb_test_multiple "print oload($var)" "menu for $var" {
+	    -re "$menu" {
+		pass "$gdb_test_name"
+	    }
+	    default {
+		fail "$gdb_test_name"
+	    }
+	}
+	# Cancel the call.
+	gdb_test 0 cancelled "cancel call for $var"
+    }
+
+    # These should not be ambiguous, but currently are: RD because gdb
+    # can't tell the difference between a type and a class-wide type;
+    # and RCD because gdb does not implement dispatching.
+    test_menu rd
+    test_menu rcd
+}
diff --git a/gdb/testsuite/gdb.ada/record-overloads/pck.adb b/gdb/testsuite/gdb.ada/record-overloads/pck.adb
new file mode 100644
index 00000000000..e4cad65d8b2
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/record-overloads/pck.adb
@@ -0,0 +1,43 @@
+--  Copyright 2026 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package body Pck is
+
+   function Oload (C : Rec_1) return Integer is
+   begin
+      return 0;
+   end Oload;
+
+   function Oload (C : Rec_2) return Integer is
+   begin
+      return 1;
+   end Oload;
+
+   function Oload (C : Rec_Base) return Integer is
+   begin
+      return 2;
+   end Oload;
+
+   function Oload (C : Rec_Derived) return Integer is
+   begin
+      return 3;
+   end Oload;
+
+   function Oload (C : Rec_Dyn) return Integer is
+   begin
+      return 4;
+   end Oload;
+
+end Pck;
diff --git a/gdb/testsuite/gdb.ada/record-overloads/pck.ads b/gdb/testsuite/gdb.ada/record-overloads/pck.ads
new file mode 100644
index 00000000000..2863637e008
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/record-overloads/pck.ads
@@ -0,0 +1,50 @@
+--  Copyright 2026 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package Pck is
+
+   type Rec_1 is record
+      X : Integer;
+   end record;
+
+   type Rec_2 is record
+      X : Integer;
+   end record;
+
+   function Oload (C : Rec_1) return Integer;
+   function Oload (C : Rec_2) return Integer;
+
+   type Rec_Base is tagged record
+      X : Integer;
+   end record;
+
+   function Oload (C : Rec_Base) return Integer;
+
+   type Rec_Derived is new Rec_Base with null record;
+
+   function Oload (C : Rec_Derived) return Integer;
+
+   type Rec_Dyn (Cond : Boolean := True) is record
+      case Cond is
+         when True =>
+            TV : Integer;
+         when False =>
+            FV : Integer;
+      end case;
+   end record;
+
+   function Oload (C : Rec_Dyn) return Integer;
+
+end Pck;
diff --git a/gdb/testsuite/gdb.ada/record-overloads/prog.adb b/gdb/testsuite/gdb.ada/record-overloads/prog.adb
new file mode 100644
index 00000000000..2951845ccb0
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/record-overloads/prog.adb
@@ -0,0 +1,32 @@
+--  Copyright 2026 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+with Pck; use Pck;
+
+procedure Prog is
+
+   R1 : Rec_1 := (X => 23);
+   R2 : Rec_2 := (X => 23);
+   RB : Rec_Base := (X => 23);
+   RD : Rec_Derived := (X => 23);
+
+   RCB : Rec_Base'Class := RB;
+   RCD : Rec_Base'Class := RD;
+
+   RCF : Rec_Dyn := (Cond => False, FV => 23);
+
+begin
+   null; -- START
+end Prog;

base-commit: 625a5c311e6df32aa28214d017c65303bb5d6451
-- 
2.55.0