[binutils-gdb] [Ada/varobj] number of children of null pointer to dynamic array.

[Joel Brobecker <brobecke at sourceware dot org>]

https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=4a0ca9ec1ee3bc18da72ce42cdd7c2959e58aa76

commit 4a0ca9ec1ee3bc18da72ce42cdd7c2959e58aa76
Author: Joel Brobecker <brobecker@adacore.com>
Date:   Wed Jan 14 18:39:24 2015 +0400

    [Ada/varobj] number of children of null pointer to dynamic array.
    
    This is preparation work to avoid a regression in the Ada/varobj.
    An upcoming patch is going to add support for types in DWARF
    which have dynamic properties whose value is a reference to another
    DIE.
    
    Consider for instance the following declaration:
    
       type Variant_Type (N : Int := 0) is record
          F : String(1 .. N) := (others => 'x');
       end record;
       type Variant_Type_Access is access all Variant_Type;
       VTA : Variant_Type_Access := null;
    
    This declares a variable "VTA" which is an access (=pointer)
    to a variant record Variant_Type. This record contains two
    components, the first being "N" (the discriminant), and the
    second being "F", an array whose lower bound is 1, and whose
    upper bound depends on the value of "N" (the discriminant).
    
    Of interest to us, here, is that second component ("F"), and
    in particular its bounds. The debugging info, and in particular
    the info for the array looks like the following...
    
            .uleb128 0x9    # (DIE (0x91) DW_TAG_array_type)
            .long   .LASF16 # DW_AT_name: "bar__variant_type__T2b"
            .long   0xac    # DW_AT_GNAT_descriptive_type
            .long   0x2cb   # DW_AT_type
            .long   0xac    # DW_AT_sibling
            .uleb128 0xa    # (DIE (0xa2) DW_TAG_subrange_type)
            .long   0xc4    # DW_AT_type
            .long   0x87    # DW_AT_upper_bound
            .byte   0       # end of children of DIE 0x91
    
    ... where the upper bound of the array's subrange type is a reference
    to "n"'s DIE (0x87):
    
            .uleb128 0x8    # (DIE (0x87) DW_TAG_member)
            .ascii "n\0"    # DW_AT_name
            [...]
    
    Once the patch to handle this dynamic property gets applied,
    this is what happens when creating a varobj for variable "VTA"
    (whose value is null), and then trying to list its children:
    
        (gdb)
        -var-create vta * vta
        ^done,name="vta",numchild="2",value="0x0",
              type="bar.variant_type_access",has_more="0"
        (gdb)
        -var-list-children 1 vta
        ^done,numchild="2",
              children=[child={name="vta.n",[...]},
                        child={name="vta.f",exp="f",
                               numchild="43877616",  <<<<-----
                               value="[43877616]",   <<<<-----
                               type="array (1 .. n) of character"}],
              has_more="0"
    
    It has an odd number of children.
    
    In this case, we cannot really determine the number of children,
    since that number depends on the value of a field in a record
    for which we do not have a value. Up to now, the value we've been
    displaying is zero - meaning we have an empty array.
    
    What happens in this case, is that, because the VTA is a null pointer,
    we're not able to resolve the pointer's target type, and therefore
    end up asking ada_varobj_get_array_number_of_children to return
    the number of elements in that array; for that, it relies blindly
    on get_array_bounds, which assumes the type is no longer dynamic,
    and therefore the reads the bound without seeing that it's value
    is actually a reference rather than a resolved constant.
    
    This patch prevents the issue by explicitly handling the case of
    dynamic arrays, and returning zero child in that case.
    
    gdb/ChangeLog:
    
            * ada-varobj.c (ada_varobj_get_array_number_of_children):
            Return zero if PARENT_VALUE is NULL and parent_type's
            range type is dynamic.
    
    gdb/testsuite/ChangeLog:
    
            * gdb.ada/mi_var_array: New testcase.
    
    Tested on x86_64-linux.

Diff:
---
 gdb/ChangeLog                              |  6 ++++
 gdb/ada-varobj.c                           | 12 +++++++
 gdb/testsuite/ChangeLog                    |  4 +++
 gdb/testsuite/gdb.ada/mi_var_array.exp     | 52 ++++++++++++++++++++++++++++++
 gdb/testsuite/gdb.ada/mi_var_array/bar.adb | 29 +++++++++++++++++
 gdb/testsuite/gdb.ada/mi_var_array/pck.adb | 21 ++++++++++++
 gdb/testsuite/gdb.ada/mi_var_array/pck.ads | 19 +++++++++++
 7 files changed, 143 insertions(+)

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 205d124..27682ff 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,5 +1,11 @@
 2015-01-29  Joel Brobecker  <brobecker@adacore.com>
 
+	* ada-varobj.c (ada_varobj_get_array_number_of_children):
+	Return zero if PARENT_VALUE is NULL and parent_type's
+	range type is dynamic.
+
+2015-01-29  Joel Brobecker  <brobecker@adacore.com>
+
 	* gdbtypes.c (is_dynamic_type_internal) <TYPE_CODE_RANGE>: Return
 	nonzero if the type's subtype is dynamic.
 	(resolve_dynamic_range): Also resolve the range's subtype.
diff --git a/gdb/ada-varobj.c b/gdb/ada-varobj.c
index 25b1a38..690ee49 100644
--- a/gdb/ada-varobj.c
+++ b/gdb/ada-varobj.c
@@ -240,6 +240,18 @@ ada_varobj_get_array_number_of_children (struct value *parent_value,
 {
   LONGEST lo, hi;
 
+  if (parent_value == NULL
+      && is_dynamic_type (TYPE_INDEX_TYPE (parent_type)))
+    {
+      /* This happens when listing the children of an object
+	 which does not exist in memory (Eg: when requesting
+	 the children of a null pointer, which is allowed by
+	 varobj).  The array index type being dynamic, we cannot
+	 determine how many elements this array has.  Just assume
+	 it has none.  */
+      return 0;
+    }
+
   if (!get_array_bounds (parent_type, &lo, &hi))
     {
       /* Could not get the array bounds.  Pretend this is an empty array.  */
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index e8c80da..beb77ea 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2015-01-29  Joel Brobecker  <brobecker@adacore.com>
+
+	* gdb.ada/mi_var_array: New testcase.
+
 2015-01-27  Doug Evans  <dje@google.com>
 
 	* gdb.python/py-objfile.exp: Add tests for objfile.username.
diff --git a/gdb/testsuite/gdb.ada/mi_var_array.exp b/gdb/testsuite/gdb.ada/mi_var_array.exp
new file mode 100644
index 0000000..836e5fe
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/mi_var_array.exp
@@ -0,0 +1,52 @@
+# Copyright 2015 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"
+
+standard_ada_testfile bar
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
+  return -1
+}
+
+load_lib mi-support.exp
+set MIFLAGS "-i=mi"
+
+gdb_exit
+if [mi_gdb_start] {
+    continue
+}
+
+mi_delete_breakpoints
+mi_gdb_reinitialize_dir $srcdir/$subdir
+mi_gdb_load ${binfile}
+
+if ![mi_run_to_main] then {
+   fail "Cannot run to main, testcase aborted"
+   return 0
+}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb]
+mi_continue_to_line \
+    "bar.adb:$bp_location" \
+    "stop at start of main Ada procedure"
+
+mi_gdb_test "-var-create vta * vta" \
+    "\\^done,name=\"vta\",numchild=\"2\",.*" \
+    "Create bt varobj"
+
+mi_gdb_test "-var-list-children vta" \
+    "\\^done,numchild=\"2\",children=\\\[child={name=\"vta.n\",exp=\"n\",numchild=\"0\",type=\"bar\\.int\"},child={name=\"vta.f\",exp=\"f\",numchild=\"0\",type=\"array \\(1 .. n\\) of character\"}\\\],.*" \
+    "list vta's children"
diff --git a/gdb/testsuite/gdb.ada/mi_var_array/bar.adb b/gdb/testsuite/gdb.ada/mi_var_array/bar.adb
new file mode 100644
index 0000000..b39d97c
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/mi_var_array/bar.adb
@@ -0,0 +1,29 @@
+--  Copyright 2015 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 Bar is
+   M : Integer := 35;
+   subtype Int is Integer range 0 .. M;
+   type Variant_Type (N : Int := 0) is record
+      F : String(1 .. N) := (others => 'x');
+   end record;
+   type Variant_Type_Access is access all Variant_Type;
+
+   VTA : Variant_Type_Access;
+begin
+   Do_Nothing (VTA'Address);  --  STOP
+end Bar;
diff --git a/gdb/testsuite/gdb.ada/mi_var_array/pck.adb b/gdb/testsuite/gdb.ada/mi_var_array/pck.adb
new file mode 100644
index 0000000..3f490ee
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/mi_var_array/pck.adb
@@ -0,0 +1,21 @@
+--  Copyright 2015 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
+   procedure Do_Nothing (A : System.Address) is
+   begin
+      null;
+   end Do_Nothing;
+end Pck;
diff --git a/gdb/testsuite/gdb.ada/mi_var_array/pck.ads b/gdb/testsuite/gdb.ada/mi_var_array/pck.ads
new file mode 100644
index 0000000..0ee9ef9
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/mi_var_array/pck.ads
@@ -0,0 +1,19 @@
+--  Copyright 2015 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 System;
+package Pck is
+   procedure Do_Nothing (A : System.Address);
+end Pck;