Do not auto-dereference null pointers in Ada MI varobj

The Ada varobj code automatically dereferences access types.  This is
often handy, but it also does so for null pointers -- showing children
with empty values.

These children are weird, but even weirder when a variant type is
involved, because only the non-varying parts of the type are
displayed.  This behavior conflicts a bit with my ongoing quest to
move the Ada code to use DWARF rather than gnat encodings, in that
reproducing this behavior with the DWARF code seems rather hacky.

So, this patch instead changes the Ada varobj code so that it does not
automatically dereference null pointers.

As this patch only affects Ada, and it was already reviewed internally
by Joel, I am checking it in.

2020-09-02  Tom Tromey  <tromey@adacore.com>

	* ada-varobj.c (ada_varobj_get_ptr_number_of_children): Return 0
	for null pointers.
	(ada_varobj_adjust_for_child_access): Special-case null pointers.

gdb/testsuite/ChangeLog
2020-09-02  Tom Tromey  <tromey@adacore.com>

	* gdb.ada/mi_var_access.exp: Test children of access variable.
	* gdb.ada/mi_var_access/mi_access.adb: Add new stop markers.
	* gdb.ada/mi_var_array.exp: Update.

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index ab003afa3e44cb0cbb55c3552d0bd167b5241bf8..8ace83b3271987bd35b6e54d4bb9ac109cd36ebc 100644 (file)
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,9 @@
+2020-09-02  Tom Tromey  <tromey@adacore.com>
+
+       * ada-varobj.c (ada_varobj_get_ptr_number_of_children): Return 0
+       for null pointers.
+       (ada_varobj_adjust_for_child_access): Special-case null pointers.
+
 2020-09-01  Simon Marchi  <simon.marchi@polymtl.ca>
 
        * bcache.h (struct bcache) <insert>: Change type of `added` to

diff --git a/gdb/ada-varobj.c b/gdb/ada-varobj.c
index a72653af37ab553740ce5765e23af7fd7971351e..f2a291ad5e5c88d10350c5b464096467986c14ed 100644 (file)
--- a/gdb/ada-varobj.c
+++ b/gdb/ada-varobj.c
@@ -209,6 +209,8 @@ ada_varobj_adjust_for_child_access (struct value **value,
   if ((*type)->code () == TYPE_CODE_PTR
       && (TYPE_TARGET_TYPE (*type)->code () == TYPE_CODE_STRUCT
           || TYPE_TARGET_TYPE (*type)->code () == TYPE_CODE_UNION)
+      && *value != nullptr
+      && value_as_address (*value) != 0
       && !ada_is_array_descriptor_type (TYPE_TARGET_TYPE (*type))
       && !ada_is_constrained_packed_array_type (TYPE_TARGET_TYPE (*type)))
     ada_varobj_ind (*value, *type, value, type);
@@ -333,6 +335,10 @@ ada_varobj_get_ptr_number_of_children (struct value *parent_value,
       || child_type->code () == TYPE_CODE_VOID)
     return 0;
 
+  /* Only show children for non-null pointers.  */
+  if (parent_value == nullptr || value_as_address (parent_value) == 0)
+    return 0;
+
   /* All other types have 1 child.  */
   return 1;
 }

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 7e60a11c3dd9786684f20c73708afad547b41e6c..63dcad7d99e305ffd2bee027a913f3e665a1f3b4 100644 (file)
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2020-09-02  Tom Tromey  <tromey@adacore.com>
+
+       * gdb.ada/mi_var_access.exp: Test children of access variable.
+       * gdb.ada/mi_var_access/mi_access.adb: Add new stop markers.
+       * gdb.ada/mi_var_array.exp: Update.
+
 2020-08-31  Kevin Buettner  <kevinb@redhat.com>
 
        * gdb.base/corefile.exp (warning-free): XFAIL test when running

diff --git a/gdb/testsuite/gdb.ada/mi_var_access.exp b/gdb/testsuite/gdb.ada/mi_var_access.exp
index 5ffc0ae877268ef479a55f48f045ff8e2fd0476f..14e899221e35bc030ec840db73a998a49c6b38a4 100644 (file)
--- a/gdb/testsuite/gdb.ada/mi_var_access.exp
+++ b/gdb/testsuite/gdb.ada/mi_var_access.exp
@@ -50,3 +50,25 @@ mi_continue_to_line \
 mi_gdb_test "-var-create A_String_Access * A_String_Access" \
     "\\^done,name=\"A_String_Access\",numchild=\"1\",.*" \
     "Create varobj"
+
+set bp_location [gdb_get_line_number "STOP2" ${testdir}/mi_access.adb]
+mi_continue_to_line \
+    "mi_access.adb:$bp_location" \
+    "stop at stop 2"
+
+mi_gdb_test "-var-update A_String_Access" \
+    [string_to_regexp {^done,changelist=[{name="A_String_Access",in_scope="true",type_changed="false",has_more="0"}]}] \
+    "update at stop 2"
+
+mi_gdb_test "-var-list-children A_String_Access" \
+    [string_to_regexp {^done,numchild="1",children=[child={name="A_String_Access.A_String_Access.all",exp="A_String_Access.all",numchild="3",type="array (3 .. 5) of character",thread-id="1"}],has_more="0"}] \
+    "list children at stop 2"
+
+set bp_location [gdb_get_line_number "STOP3" ${testdir}/mi_access.adb]
+mi_continue_to_line \
+    "mi_access.adb:$bp_location" \
+    "stop at stop 3"
+
+mi_gdb_test "-var-update A_String_Access" \
+    [string_to_regexp {^done,changelist=[{name="A_String_Access",in_scope="true",type_changed="true",new_type="pck.string_access",new_num_children="0",has_more="0"}]}] \
+    "update at stop 3"

diff --git a/gdb/testsuite/gdb.ada/mi_var_access/mi_access.adb b/gdb/testsuite/gdb.ada/mi_var_access/mi_access.adb
index d5f5f8814632e7dfbe30cc364d32da58010c2b45..b1dc7be1c3a4523b95711994ec87d268370e4d09 100644 (file)
--- a/gdb/testsuite/gdb.ada/mi_var_access/mi_access.adb
+++ b/gdb/testsuite/gdb.ada/mi_var_access/mi_access.adb
@@ -24,7 +24,7 @@ begin
    A_String (4) := '6';
    A_String_Access := Copy (A_String);
    A_Pointer.P := A_String_Access;
-   Do_Nothing (A_String_Access'Address);
+   Do_Nothing (A_String_Access'Address); -- STOP2
    A_String_Access (4) := 'a';
    Do_Nothing (A_Pointer'Address);
    A_String_Access := Copy("Hi");
@@ -32,6 +32,6 @@ begin
    Do_Nothing (A_String_Access'Address);
    A_String_Access := null;
    A_Pointer.P := null;
-   Do_Nothing (A_Pointer'Address);
+   Do_Nothing (A_Pointer'Address); -- STOP3
    Do_Nothing (A_String'Address);
 end Mi_Access;

diff --git a/gdb/testsuite/gdb.ada/mi_var_array.exp b/gdb/testsuite/gdb.ada/mi_var_array.exp
index fdc2249ba0273725eceac598e73e11b82aca16d0..4ef213b7a6ef9f7d0eea3e1c2fe7a25b32d441cf 100644 (file)
--- a/gdb/testsuite/gdb.ada/mi_var_array.exp
+++ b/gdb/testsuite/gdb.ada/mi_var_array.exp
@@ -52,14 +52,6 @@ foreach_with_prefix scenario {none all minimal} {
        "stop at start of main Ada procedure"
 
     mi_gdb_test "-var-create vta * vta" \
-       "\\^done,name=\"vta\",numchild=\"2\",.*" \
+       "\\^done,name=\"vta\",numchild=\"0\",.*" \
        "create bt varobj"
-
-    # In the "minimal" mode, we don't currently have the ability to
-    # print the subrange type properly.  So, we just allow anything
-    # for the array range here.  The correct result would be to fix
-    # this to read "(1 .. n)".
-    mi_gdb_test "-var-list-children vta" \
-       "\\^done,numchild=\"2\",children=\\\[child={name=\"vta.n\",exp=\"n\",numchild=\"0\",type=\"bar\\.int\",thread-id=\"$decimal\"},child={name=\"vta.f\",exp=\"f\",numchild=\"0\",type=\"array .* of character\",thread-id=\"$decimal\"}\\\],.*" \
-       "list vta's children"
 }