Refine Ada overload matching

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.
This commit is contained in:
Tom Tromey 2023-11-28 14:26:56 -07:00
parent 1414fbf941
commit d56fdf1b97
3 changed files with 108 additions and 11 deletions

View file

@ -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 ());

View file

@ -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"

View file

@ -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;