[RFA/commit/Ada] Wrong value printed by info locals for dynamic object.

[y at gnat dot com]

From: Joel Brobecker <brobecker@adacore.com>

Hello,

The problem is printing the wrong value for dynamic local variables
when using the "info locals" command. Consider the following code:

   procedure Print (I1 : Positive; I2 : Positive) is
      type My_String is array (I1 .. I2) of Character;
      I : My_String := (others => 'A');
      S : String (1 .. I2 + 3) := (others => ' ');
   begin
      S (I1 .. I2) := String (I); --  BREAK
      Put_Line (S);
   end Print;

Type My_String is a dynamic type because the bounds of that array are
determined at run-time based on the value of the I1 and I2 parameters.
After the debugger stopped at BREAK, we try printing all local variables.
Here is what we get:

        (gdb) info locals
        i = "["00"]["00"]"
        s = "["00"]["00"]["00"]["00"]["00"]["00"]["00"]["00"]"

OTOH, printing their value using the "print" command works:

        (gdb) print i
        $1 = "AA"
        (gdb) print s
        $2 = "        "

We traced the problem to trying to get the contents of a variable
(call to value_contents) before "fix'ing" it.  For those not familiar
with the Ada language support, "fixing" a value consists of swapping
the value's dynamic type with a static version that is appropriate
for our actual value.  As a result, the dynamic type was used to
determine the value's size, which is zero, and thus the value contents
was actually empty (and we happily committed a buffer overflow while
reading this empty contents buffer).

This patch fixes the two locations where we found this happening.
The reason why it's partly an RFA is that I'm slightly concerned
about adding an "if Ada ..." in otherwise common code (valprint.c).
But I don't see any other way, everything up to the call to val_print
is common code, and once we're inside val_print, we've already
extracted the contents of the value... For easier reference, the
core of common_val_print is pretty much:

  return val_print (value_type (val), value_contents_all (val),
                    value_embedded_offset (val), value_address (val),
                    stream, recurse, options, language);

Short of creating a language-specific value_contents routine, I think
that this was the best/easiest compromise... Thoughts on that?

gdb/ChangeLog:

        * valprint.c (common_val_print): Fix the value before extracting
        its contents.
	* ada-lang.c (ada_to_fixed_value): Make this function extern.
	* ada-lang.h (ada_to_fixed_value): New function declaration.
	* ada-valprint.c (ada_value_print): Use ada_to_fixed_value
	to avoid code duplication and fix a bug in the handling of
	fixed types contents.

gdb/testsuite/ChangeLog:

        * gdb.ada/dyn_loc: New testcase.

---
 gdb/ada-lang.c                         |    4 +--
 gdb/ada-lang.h                         |    2 +
 gdb/ada-valprint.c                     |    9 ++---
 gdb/testsuite/gdb.ada/dyn_loc.exp      |   53 ++++++++++++++++++++++++++++++++
 gdb/testsuite/gdb.ada/dyn_loc/p.adb    |   21 ++++++++++++
 gdb/testsuite/gdb.ada/dyn_loc/pack.adb |   29 +++++++++++++++++
 gdb/testsuite/gdb.ada/dyn_loc/pack.ads |   20 ++++++++++++
 gdb/valprint.c                         |    8 +++++
 8 files changed, 137 insertions(+), 9 deletions(-)
 create mode 100644 gdb/testsuite/gdb.ada/dyn_loc.exp
 create mode 100644 gdb/testsuite/gdb.ada/dyn_loc/p.adb
 create mode 100644 gdb/testsuite/gdb.ada/dyn_loc/pack.adb
 create mode 100644 gdb/testsuite/gdb.ada/dyn_loc/pack.ads

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index bc9ca69..c3cd971 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -226,8 +226,6 @@ static int find_struct_field (char *, struct type *, int,
 static struct value *ada_to_fixed_value_create (struct type *, CORE_ADDR,
                                                 struct value *);
 
-static struct value *ada_to_fixed_value (struct value *);
-
 static int ada_resolve_function (struct ada_symbol_info *, int,
                                  struct value **, int, const char *,
                                  struct type *);
@@ -7449,7 +7447,7 @@ ada_to_fixed_value_create (struct type *type0, CORE_ADDR address,
    that correctly describes it.  Does not necessarily create a new
    value.  */
 
-static struct value *
+struct value *
 ada_to_fixed_value (struct value *val)
 {
   return ada_to_fixed_value_create (value_type (val),
diff --git a/gdb/ada-lang.h b/gdb/ada-lang.h
index 77a63b7..017cff2 100644
--- a/gdb/ada-lang.h
+++ b/gdb/ada-lang.h
@@ -312,6 +312,8 @@ extern struct type *ada_to_fixed_type (struct type *, const gdb_byte *,
 				       CORE_ADDR, struct value *,
                                        int check_tag);
 
+extern struct value *ada_to_fixed_value (struct value *val);
+
 extern struct type *ada_template_to_fixed_record_type_1 (struct type *type,
 							 const gdb_byte *valaddr,
 							 CORE_ADDR address,
diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c
index 5590100..a1090dc 100644
--- a/gdb/ada-valprint.c
+++ b/gdb/ada-valprint.c
@@ -924,12 +924,9 @@ int
 ada_value_print (struct value *val0, struct ui_file *stream,
 		 const struct value_print_options *options)
 {
-  const gdb_byte *valaddr = value_contents (val0);
-  CORE_ADDR address = value_address (val0);
-  struct type *type =
-    ada_to_fixed_type (value_type (val0), valaddr, address, NULL, 1);
-  struct value *val =
-    value_from_contents_and_address (type, valaddr, address);
+  struct value *val = ada_to_fixed_value (val0);
+  CORE_ADDR address = value_address (val);
+  struct type *type = value_type (val);
   struct value_print_options opts;
 
   /* If it is a pointer, indicate what it points to.  */
diff --git a/gdb/testsuite/gdb.ada/dyn_loc.exp b/gdb/testsuite/gdb.ada/dyn_loc.exp
new file mode 100644
index 0000000..953bd5f
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/dyn_loc.exp
@@ -0,0 +1,53 @@
+# Copyright 2010 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/>.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+load_lib "ada.exp"
+
+set testdir "dyn_loc"
+set testfile "${testdir}/p"
+set srcfile ${srcdir}/${subdir}/${testfile}.adb
+set binfile ${objdir}/${subdir}/${testfile}
+
+file mkdir ${objdir}/${subdir}/${testdir}
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } {
+  return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "BREAK" ${testdir}/pack.adb]
+if ![runto "pack.adb:$bp_location" ] then {
+  return -1
+}
+
+set eol "\[\r\n\]+"
+
+set test "info locals"
+gdb_test_multiple "$test" "$test" {
+    -re "i = \"AA\"${eol}s = \"        \"" {
+        pass $test
+    }
+    -re "i = \"AA\"${eol}.*${eol}s = \"        \"" {
+        # The debugger printed the two local variable correctly, but
+        # it probably failed to NOT print some variables internally
+        # generated by the compiler.  This is a known issue.
+        xfail $test
+    }
+}
+
diff --git a/gdb/testsuite/gdb.ada/dyn_loc/p.adb b/gdb/testsuite/gdb.ada/dyn_loc/p.adb
new file mode 100644
index 0000000..f8fd801
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/dyn_loc/p.adb
@@ -0,0 +1,21 @@
+--  Copyright 2010 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 Pack; use Pack;
+
+procedure P is
+begin
+   Print (4, 5);
+end P;
diff --git a/gdb/testsuite/gdb.ada/dyn_loc/pack.adb b/gdb/testsuite/gdb.ada/dyn_loc/pack.adb
new file mode 100644
index 0000000..deb3d06
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/dyn_loc/pack.adb
@@ -0,0 +1,29 @@
+--  Copyright 2010 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 Ada.Text_IO; use Ada.Text_IO;
+
+package body Pack is
+
+   procedure Print (I1 : Positive; I2 : Positive) is
+      type My_String is array (I1 .. I2) of Character;
+      I : My_String := (others => 'A');
+      S : String (1 .. I2 + 3) := (others => ' ');
+   begin
+      S (I1 .. I2) := String (I); --  BREAK
+      Put_Line (S);
+   end Print;
+
+end Pack;
diff --git a/gdb/testsuite/gdb.ada/dyn_loc/pack.ads b/gdb/testsuite/gdb.ada/dyn_loc/pack.ads
new file mode 100644
index 0000000..8925c79
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/dyn_loc/pack.ads
@@ -0,0 +1,20 @@
+--  Copyright 2010 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 Pack is
+
+   procedure Print (I1 : Positive; I2 : Positive);
+
+end Pack;
diff --git a/gdb/valprint.c b/gdb/valprint.c
index 3f21ae4..d6ecc04 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -35,6 +35,7 @@
 #include "exceptions.h"
 #include "dfp.h"
 #include "python/python.h"
+#include "ada-lang.h"
 
 #include <errno.h>
 
@@ -361,6 +362,13 @@ common_val_print (struct value *val, struct ui_file *stream, int recurse,
   if (!value_check_printable (val, stream))
     return 0;
 
+  if (language->la_language == language_ada)
+    /* The value might have a dynamic type, which would cause trouble
+       below when trying to extract the value contents (since the value
+       size is determined from the type size which is unknown).  So
+       get a fixed representation of our value.  */
+    val = ada_to_fixed_value (val);
+
   return val_print (value_type (val), value_contents_all (val),
 		    value_embedded_offset (val), value_address (val),
 		    stream, recurse, options, language);
-- 
1.6.3.3