[pushed] Fix Ada overloading with 'null'

Message ID 20210428164315.2952122-1-tromey@adacore.com
State New
Headers show
Series
  • [pushed] Fix Ada overloading with 'null'
Related show

Commit Message

Tom Tromey April 28, 2021, 4:43 p.m.
Currently, the Ada expression parser treats 'null' as an integer 0.
However, this causes overloading to fail in certain cases.

This patch changes the Ada expression parser to use a special type for
'null'.  I chose pointer-to-int0, because I think that's not likely to
be needed for any other Ada expression.  Note this works because a
"mod 1" type has an underlying non-zero byte size; the test includes a
check for this.

The output is changed so that "print null", by default, shows "null".
And, ada_type_match is changed both to recognize the special null type
and to remove a bit of weird code related to how pointers are treated
for overload type matching.

Tested on x86-64 Fedora 32.  Because this only touches Ada, and Joel
already approved it internally at AdaCore, I am checking it in.

gdb/ChangeLog
2021-04-28  Tom Tromey  <tromey@adacore.com>

	* ada-exp.y (primary): Use new type for null pointer.
	* ada-lang.c (ada_type_match): Remove "may_deref"
	parameter.  Handle null pointer.
	(ada_args_match): Update.
	* ada-valprint.c (ada_value_print_ptr, ada_value_print):
	Handle null pointer.

gdb/testsuite/ChangeLog
2021-04-28  Tom Tromey  <tromey@adacore.com>

	* gdb.ada/null_overload.exp: New file.
	* gdb.ada/null_overload/foo.adb: New file.
---
 gdb/ChangeLog                               |  9 +++++
 gdb/ada-exp.y                               |  6 ++-
 gdb/ada-lang.c                              | 23 +++++------
 gdb/ada-valprint.c                          | 15 +++++++-
 gdb/testsuite/ChangeLog                     |  5 +++
 gdb/testsuite/gdb.ada/null_overload.exp     | 37 ++++++++++++++++++
 gdb/testsuite/gdb.ada/null_overload/foo.adb | 42 +++++++++++++++++++++
 7 files changed, 121 insertions(+), 16 deletions(-)
 create mode 100644 gdb/testsuite/gdb.ada/null_overload.exp
 create mode 100644 gdb/testsuite/gdb.ada/null_overload/foo.adb

-- 
2.26.3

Patch

diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y
index 7b1b60fd46b..3652376b623 100644
--- a/gdb/ada-exp.y
+++ b/gdb/ada-exp.y
@@ -891,7 +891,11 @@  primary	:	FLOAT
 	;
 
 primary	:	NULL_PTR
-			{ write_int (pstate, 0, type_int (pstate)); }
+			{
+			  struct type *null_ptr_type
+			    = lookup_pointer_type (parse_type (pstate)->builtin_int0);
+			  write_int (pstate, 0, null_ptr_type);
+			}
 	;
 
 primary	:	STRING
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 28f14c9ae53..0b50a788ac9 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -95,8 +95,6 @@  static struct type *desc_index_type (struct type *, int);
 
 static int desc_arity (struct type *);
 
-static int ada_type_match (struct type *, struct type *, int);
-
 static int ada_args_match (struct symbol *, struct value **, int);
 
 static struct value *make_array_descriptor (struct type *, struct value *);
@@ -3492,14 +3490,12 @@  ada_resolve_variable (struct symbol *sym, const struct block *block,
   return candidates[i];
 }
 
-/* Return non-zero if formal type FTYPE matches actual type ATYPE.  If
-   MAY_DEREF is non-zero, the formal may be a pointer and the actual
-   a non-pointer.  */
+/* 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 int
-ada_type_match (struct type *ftype, struct type *atype, int may_deref)
+ada_type_match (struct type *ftype, struct type *atype)
 {
   ftype = ada_check_typedef (ftype);
   atype = ada_check_typedef (atype);
@@ -3514,12 +3510,13 @@  ada_type_match (struct type *ftype, struct type *atype, int may_deref)
     default:
       return ftype->code () == atype->code ();
     case TYPE_CODE_PTR:
-      if (atype->code () == TYPE_CODE_PTR)
-	return ada_type_match (TYPE_TARGET_TYPE (ftype),
-			       TYPE_TARGET_TYPE (atype), 0);
-      else
-	return (may_deref
-		&& ada_type_match (TYPE_TARGET_TYPE (ftype), atype, 0));
+      if (atype->code () != TYPE_CODE_PTR)
+	return 0;
+      atype = TYPE_TARGET_TYPE (atype);
+      /* This can only happen if the actual argument is 'null'.  */
+      if (atype->code () == TYPE_CODE_INT && TYPE_LENGTH (atype) == 0)
+	return 1;
+      return ada_type_match (TYPE_TARGET_TYPE (ftype), atype);
     case TYPE_CODE_INT:
     case TYPE_CODE_ENUM:
     case TYPE_CODE_RANGE:
@@ -3580,7 +3577,7 @@  ada_args_match (struct symbol *func, struct value **actuals, int n_actuals)
 	  struct type *ftype = ada_check_typedef (func_type->field (i).type ());
 	  struct type *atype = ada_check_typedef (value_type (actuals[i]));
 
-	  if (!ada_type_match (ftype, atype, 1))
+	  if (!ada_type_match (ftype, atype))
 	    return 0;
 	}
     }
diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c
index 61c903bbed5..d516a4d134e 100644
--- a/gdb/ada-valprint.c
+++ b/gdb/ada-valprint.c
@@ -719,6 +719,14 @@  ada_value_print_ptr (struct value *val,
 		     struct ui_file *stream, int recurse,
 		     const struct value_print_options *options)
 {
+  if (!options->format
+      && TYPE_TARGET_TYPE (value_type (val))->code () == TYPE_CODE_INT
+      && TYPE_LENGTH (TYPE_TARGET_TYPE (value_type (val))) == 0)
+    {
+      fputs_filtered ("null", stream);
+      return;
+    }
+
   common_val_print (val, stream, recurse, options, language_def (language_c));
 
   struct type *type = ada_check_typedef (value_type (val));
@@ -1096,8 +1104,11 @@  ada_value_print (struct value *val0, struct ui_file *stream,
   struct type *type = ada_check_typedef (value_type (val));
   struct value_print_options opts;
 
-  /* If it is a pointer, indicate what it points to.  */
-  if (type->code () == TYPE_CODE_PTR)
+  /* If it is a pointer, indicate what it points to; but not for
+     "void *" pointers.  */
+  if (type->code () == TYPE_CODE_PTR
+      && !(TYPE_TARGET_TYPE (type)->code () == TYPE_CODE_INT
+	   && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) == 0))
     {
       /* Hack:  don't print (char *) for char strings.  Their
 	 type is indicated by the quoted string anyway.  */
diff --git a/gdb/testsuite/gdb.ada/null_overload.exp b/gdb/testsuite/gdb.ada/null_overload.exp
new file mode 100644
index 00000000000..e5b40de22f1
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/null_overload.exp
@@ -0,0 +1,37 @@ 
+# Copyright 2021 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"
+
+if { [skip_ada_tests] } { return -1 }
+
+standard_ada_testfile foo
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
+    return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb]
+runto "foo.adb:$bp_location"
+
+gdb_test "print f(null)" " = true"
+gdb_test "print f(r_access'(null))" " = true"
+gdb_test "print f(0)" " = false"
+
+gdb_test "print null" " = null"
+gdb_test "print/d null" " = 0"
+gdb_test "print U_Ptr" " = \\\(access foo\\.u_0\\\) 0x0"
diff --git a/gdb/testsuite/gdb.ada/null_overload/foo.adb b/gdb/testsuite/gdb.ada/null_overload/foo.adb
new file mode 100644
index 00000000000..9a18606af39
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/null_overload/foo.adb
@@ -0,0 +1,42 @@ 
+--  Copyright 2021 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 Foo is
+
+   type R_Type is null record;
+   type R_Access is access R_Type;
+
+   type U_0 is mod 1;
+   type U_P_T is access all U_0;
+
+   function F (R : R_Access) return Boolean is
+   begin
+      return True;
+   end F;
+
+   function F (I : Integer) return Boolean is
+   begin
+      return False;
+   end F;
+
+   B1 : constant Boolean := F (null);
+   B2 : constant Boolean := F (0);
+
+   U : U_0 := 0;
+   U_Ptr : U_P_T := null;
+
+begin
+   null; -- START
+end Foo;