Re: [PATCH] Check record types for compatibility in ada_type_match

[Tom de Vries <tdevries@suse.de>]

On 8/26/26 10:13 PM, Tom Tromey wrote:
> 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.

Hi Tom,

this sounds like a good idea to me.

I have just one question below.

> ---
>   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.  */
> +

I don't fully understand the reasoning here.  AFAIU, if there is only 
one match, no menu will be presented.  In that case, is returning true 
still a conservative choice?

Thanks,
- Tom


> +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