[PATCH 0/2] Improve Ada overload handling

[PATCH 0/2] Improve Ada overload handling

[Tom Tromey]

This short series slightly improves Ada overload handling, removing
the need for the overload menu in some cases.

While it may not be possible to fully implement Ada overload
resolution, I think more improvements along these lines can be made.

---
Tom Tromey (2):
      Boolify ada_type_match
      Refine Ada overload matching

 gdb/ada-lang.c                                | 55 +++++++++++++++++++--------
 gdb/testsuite/gdb.ada/overloads.exp           | 33 ++++++++++++++++
 gdb/testsuite/gdb.ada/overloads/overloads.adb | 41 ++++++++++++++++++++
 3 files changed, 113 insertions(+), 16 deletions(-)
---
base-commit: de501587c2ed91b4bc2a3d5228d59f6544427ab9
change-id: 20231205-ada-overload-2ae62e111367

Best regards,
-- 
Tom Tromey <tromey@adacore.com>

[PATCH 1/2] Boolify ada_type_match

[Tom Tromey]

This changes ada_type_match to return bool.
---
 gdb/ada-lang.c | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 1a591567cda..9d5c8d5534b 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -3934,7 +3934,7 @@ ada_resolve_variable (struct symbol *sym, const struct block *block,
 /* The term "match" here is rather loose.  The match is heuristic and
    liberal.  */
 
-static int
+static bool
 ada_type_match (struct type *ftype, struct type *atype)
 {
   ftype = ada_check_typedef (ftype);
@@ -3951,11 +3951,11 @@ ada_type_match (struct type *ftype, struct type *atype)
       return ftype->code () == atype->code ();
     case TYPE_CODE_PTR:
       if (atype->code () != TYPE_CODE_PTR)
-	return 0;
+	return false;
       atype = atype->target_type ();
       /* This can only happen if the actual argument is 'null'.  */
       if (atype->code () == TYPE_CODE_INT && atype->length () == 0)
-	return 1;
+	return true;
       return ada_type_match (ftype->target_type (), atype);
     case TYPE_CODE_INT:
     case TYPE_CODE_ENUM:
@@ -3965,9 +3965,9 @@ ada_type_match (struct type *ftype, struct type *atype)
 	case TYPE_CODE_INT:
 	case TYPE_CODE_ENUM:
 	case TYPE_CODE_RANGE:
-	  return 1;
+	  return true;
 	default:
-	  return 0;
+	  return false;
 	}
 
     case TYPE_CODE_ARRAY:

-- 
2.43.0

[PATCH 2/2] Refine Ada overload matching

[Tom Tromey]

Currently, the overload handling in Ada assumes that any two array
types are compatible.  However, this is obviously untrue, and a user
reported an oddity where comparing two Ada strings resulted in a call
to the "=" function for packed boolean arrays.

This patch improves the situation somewhat, by requiring that the two
arrays have the same arity and compatible base element types.  This is
still over-broad, but it seems safe and is better than the status quo.
---
 gdb/ada-lang.c                                | 45 ++++++++++++++++++++-------
 gdb/testsuite/gdb.ada/overloads.exp           | 33 ++++++++++++++++++++
 gdb/testsuite/gdb.ada/overloads/overloads.adb | 41 ++++++++++++++++++++++++
 3 files changed, 108 insertions(+), 11 deletions(-)

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 9d5c8d5534b..ac50ba5838c 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -3930,9 +3930,35 @@ ada_resolve_variable (struct symbol *sym, const struct block *block,
   return candidates[i];
 }
 
-/* Return non-zero if formal type FTYPE matches actual type ATYPE.  */
-/* The term "match" here is rather loose.  The match is heuristic and
-   liberal.  */
+static bool ada_type_match (struct type *ftype, struct type *atype);
+
+/* Helper for ada_type_match that checks that two array types are
+   compatible.  As with that function, FTYPE is the formal type and
+   ATYPE is the actual type.  */
+
+static bool
+ada_type_match_arrays (struct type *ftype, struct type *atype)
+{
+  if (ftype->code () != TYPE_CODE_ARRAY
+      && !ada_is_array_descriptor_type (ftype))
+    return false;
+  if (atype->code () != TYPE_CODE_ARRAY
+      && !ada_is_array_descriptor_type (atype))
+    return false;
+
+  if (ada_array_arity (ftype) != ada_array_arity (atype))
+    return false;
+
+  struct type *f_elt_type = ada_array_element_type (ftype, -1);
+  struct type *a_elt_type = ada_array_element_type (atype, -1);
+  return ada_type_match (f_elt_type, a_elt_type);
+}
+
+/* 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
+   incorrect, it may still let through some that do not strictly
+   correspond to Ada rules.  */
 
 static bool
 ada_type_match (struct type *ftype, struct type *atype)
@@ -3970,18 +3996,15 @@ ada_type_match (struct type *ftype, struct type *atype)
 	  return false;
 	}
 
-    case TYPE_CODE_ARRAY:
-      return (atype->code () == TYPE_CODE_ARRAY
-	      || ada_is_array_descriptor_type (atype));
-
     case TYPE_CODE_STRUCT:
-      if (ada_is_array_descriptor_type (ftype))
-	return (atype->code () == TYPE_CODE_ARRAY
-		|| ada_is_array_descriptor_type (atype));
-      else
+      if (!ada_is_array_descriptor_type (ftype))
 	return (atype->code () == TYPE_CODE_STRUCT
 		&& !ada_is_array_descriptor_type (atype));
 
+      [[fallthrough]];
+    case TYPE_CODE_ARRAY:
+      return ada_type_match_arrays (ftype, atype);
+
     case TYPE_CODE_UNION:
     case TYPE_CODE_FLT:
       return (atype->code () == ftype->code ());
diff --git a/gdb/testsuite/gdb.ada/overloads.exp b/gdb/testsuite/gdb.ada/overloads.exp
new file mode 100644
index 00000000000..41749a3774f
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/overloads.exp
@@ -0,0 +1,33 @@
+# Copyright 2021-2023 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 overloads
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
+    return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "START" ${testdir}/overloads.adb]
+runto "overloads.adb:$bp_location"
+
+# Before the fix, these would show overload menus.
+gdb_test "print Oload(PA)" " = 23"
+gdb_test "print Oload(CA)" " = 91"
diff --git a/gdb/testsuite/gdb.ada/overloads/overloads.adb b/gdb/testsuite/gdb.ada/overloads/overloads.adb
new file mode 100644
index 00000000000..698d662712b
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/overloads/overloads.adb
@@ -0,0 +1,41 @@
+--  Copyright 2023 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/>.
+
+procedure Overloads is
+
+   type Packed_Array is array (4 .. 7) of Boolean;
+   pragma pack (Packed_Array);
+
+   type Char_Array is array (1 .. 4) of Character;
+
+   function Oload (P : Packed_Array) return Integer is
+   begin
+      return 23;
+   end Oload;
+
+   function Oload (C : Char_Array) return Integer is
+   begin
+      return 91;
+   end Oload;
+
+   PA : Packed_Array := (True, False, True, False);
+   CA : Char_Array := ('A', 'B', 'C', 'D');
+
+   B1 : constant Integer := Oload (PA);
+   B2 : constant Integer := Oload (CA);
+
+begin
+   null; -- START
+end Overloads;

-- 
2.43.0

Re: [PATCH 0/2] Improve Ada overload handling

[Tom Tromey]

>>>>> "Tom" == Tom Tromey <tromey@adacore.com> writes:

Tom> This short series slightly improves Ada overload handling, removing
Tom> the need for the overload menu in some cases.

Tom> While it may not be possible to fully implement Ada overload
Tom> resolution, I think more improvements along these lines can be made.

I'm checking this in now.

Tom