[RFA/Ada] Crash when trying to set value of packed array element

[RFA/Ada] Crash when trying to set value of packed array element

[Joel Brobecker]

Consider the following declaration:

   type Small is new Integer range 0 .. 2 ** 4 - 1;
   type Simple_Array is array (1 .. 4) of Small;
   pragma Pack (Simple_Array);

   SA : Simple_Array := (1, 2, 3, 4);

Trying to change the value of one of the elements in the packed array
causes the debugger to crash:

    (gdb) set sa(3) := 9
    [1]    4880 segmentation fault  gdb -q foo

The circumstances leading to the crash are as follow:

   . ada_evaluate_subexp creates a value corresponding to "sa(3)".

   . ada_evaluate_subexp then tries to assign 9 to this value, and
     for this calls value_assign (via ada_value_assign).

   . Because the array is packed, the destination value is 3 bits long,
     and as a result, value_assign uses the parent to determine that
     element byte address and offset:

      | if (value_bitsize (toval))
      |   {
      |     struct value *parent = value_parent (toval);
      |
      |     changed_addr = value_address (parent) + value_offset (toval);

The destination value (corresponding to "sa(3)") was incorrectly created
by ada-lang.c:ada_value_primitive_packed_val, because the "parent" was
left as NULL. So, when we try to dereference it to get the parent address,
GDB crashed.

The first part of the fix therefore consists in setting that field.
This required the addition of a new "setter" in value.[hc].  It fixes
the crash, but is still not sufficient for the assignment to actually
work.

The second part of the problem came from the fact that value_assign
seems to expect the "child"'s address to be equal to the parent's address,
with the difference being the offset. Unfortunately, this requirement was
not followed by ada_value_primitive_packed_val, so the second part of
the fix consisted in fixing that.

Still, this was not sufficient, because it caused a regression when
trying to perform an aggregate assignment of a packed array of packed
record.  The key element here is the nesting of packed entities.
Looking at the way ada_value_primitive_packed_val creates the value
of each sub-component, one can see that the value's offset is set
to the offset compared to the start of the parent. This was meant to
match what value_primitive_field does as well.

So, with our array of records, if the record offset was 2, and if
the field we're interested in that record is at offset 1, the record
value's offset would be set to 2, and the field value's offset would
be set to 1. But the address for both values would be left to the
array's address. This is where things start breaking down, because
the value_address function for our field value would return the
address of the array + 1, instead of + 3.

This is what causes the final issue, here, because ada-lang.c's
value_assign_to_component needs to compute the offset of the
subcomponent compared to the top-level aggregate's start address
(the array in our case). And it does so by subtracting the array's
address from the sub-component's address.  When you have two levels
of packed components, and the mid-level component is at an offset of
the top-level component, things didn't work, because the component's
address was miscomputed (the parent's offset is missing).

The fix consists is fixing value_address to match the work done by
value_primitive_field (where we ignore the parent's offset).

I'm not completely happy with the last part, but it did feel like
the safest thing to be doing without running the risk of changing
some semantics on my own.  What I can do as a followup, is see if
I can change the offset to make sure that address (value) is always
equal to value->address + value->offset, even in this packed-of-packed
case. I'd then be able to undo the change in value_address....

gdb/ChangeLog:

        * value.h (set_value_parent): Add declaration.
        * value.c (set_value_parent): New function.
        (value_address): If VALUE->PARENT is not NULL, then use it as
        the base address instead of VALUE->LOCATION.address.
        * ada-lang.c (ada_value_primitive_packed_val): Keep V's address
        the same as OBJ's address.  Adjust V's offset accordingly.
        Set V's parent.

gdb/testsuite/ChangeLog:

        * gdb.ada/set_pckd_arr_elt: New testcase.

Tested on x86_64-linux. OK to commit?

Thanks,
-- 
Joel

---
 gdb/ada-lang.c                                 |   17 +++++----
 gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp     |   47 ++++++++++++++++++++++++
 gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb |   22 +++++++++++
 gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb |   21 +++++++++++
 gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads |   22 +++++++++++
 gdb/value.c                                    |   11 +++++-
 gdb/value.h                                    |    1 +
 7 files changed, 133 insertions(+), 8 deletions(-)
 create mode 100644 gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp
 create mode 100644 gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb
 create mode 100644 gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb
 create mode 100644 gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 349ca17..f6f51ec 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -2297,10 +2297,9 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
     }
   else if (VALUE_LVAL (obj) == lval_memory && value_lazy (obj))
     {
-      v = value_at (type,
-                    value_address (obj) + offset);
+      v = value_at (type, value_address (obj));
       bytes = (unsigned char *) alloca (len);
-      read_memory (value_address (v), bytes, len);
+      read_memory (value_address (v) + offset, bytes, len);
     }
   else
     {
@@ -2310,18 +2309,22 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
 
   if (obj != NULL)
     {
-      CORE_ADDR new_addr;
+      long new_offset = offset;
 
       set_value_component_location (v, obj);
-      new_addr = value_address (obj) + offset;
       set_value_bitpos (v, bit_offset + value_bitpos (obj));
       set_value_bitsize (v, bit_size);
       if (value_bitpos (v) >= HOST_CHAR_BIT)
         {
-	  ++new_addr;
+	  ++new_offset;
           set_value_bitpos (v, value_bitpos (v) - HOST_CHAR_BIT);
         }
-      set_value_address (v, new_addr);
+      set_value_offset (v, new_offset);
+
+      /* Also set the parent value.  This is needed when trying to
+	 assign a new value (in inferior memory).  */
+      set_value_parent (v, obj);
+      value_incref (obj);
     }
   else
     set_value_bitsize (v, bit_size);
diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp b/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp
new file mode 100644
index 0000000..7f6f1d3
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp
@@ -0,0 +1,47 @@
+# Copyright 2012 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 }
+
+set testdir "set_pckd_arr_elt"
+set testfile "${testdir}/foo"
+set srcfile ${srcdir}/${subdir}/${testfile}.adb
+set binfile ${objdir}/${subdir}/${testfile}
+
+file mkdir ${objdir}/${subdir}/${testdir}
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
+    return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
+runto "foo.adb:$bp_location"
+
+gdb_test "print sa(3) := 9" " = 9"
+
+# To verify that the assignment was made correctly, we use the fact
+# that the program passes this very same element as an argument to
+# one of the functions.  So we insert a breakpoint on that function,
+# and verify that the argument value is correct.
+
+gdb_breakpoint "update_small"
+
+gdb_test "continue" \
+        "Breakpoint .*, pck\\.update_small \\(s=9\\) at .*pck.adb:.*" \
+        "continue to update_small"
+
diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb
new file mode 100644
index 0000000..7f4f45d
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb
@@ -0,0 +1,22 @@
+--  Copyright 2012 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 Foo is
+   SA : Simple_Array := (1, 2, 3, 4);
+begin
+   Update_Small (SA (3));  -- STOP
+end Foo;
diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb
new file mode 100644
index 0000000..a2bec81
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb
@@ -0,0 +1,21 @@
+--  Copyright 2012 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 Update_Small (S : in out Small) is
+   begin
+      null;
+   end Update_Small;
+end Pck;
diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads
new file mode 100644
index 0000000..6be95e2
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads
@@ -0,0 +1,22 @@
+--  Copyright 2012 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 Pck is
+   type Small is new Integer range 0 .. 2 ** 6 - 1;
+   type Simple_Array is array (1 .. 4) of Small;
+   pragma Pack (Simple_Array);
+
+   procedure Update_Small (S : in out Small);
+end Pck;
diff --git a/gdb/value.c b/gdb/value.c
index 85ea970..75cc3bb 100644
--- a/gdb/value.c
+++ b/gdb/value.c
@@ -805,6 +805,12 @@ value_parent (struct value *value)
   return value->parent;
 }
 
+void
+set_value_parent (struct value *value, struct value *parent)
+{
+  value->parent = parent;
+}
+
 gdb_byte *
 value_contents_raw (struct value *value)
 {
@@ -1100,7 +1106,10 @@ value_address (const struct value *value)
   if (value->lval == lval_internalvar
       || value->lval == lval_internalvar_component)
     return 0;
-  return value->location.address + value->offset;
+  if (value->parent != NULL)
+    return value_address (value->parent) + value->offset;
+  else
+    return value->location.address + value->offset;
 }
 
 CORE_ADDR
diff --git a/gdb/value.h b/gdb/value.h
index d4c4a83..c173b0e 100644
--- a/gdb/value.h
+++ b/gdb/value.h
@@ -74,6 +74,7 @@ extern void set_value_bitpos (struct value *, int bit);
    bitfields.  */
 
 struct value *value_parent (struct value *);
+extern void set_value_parent (struct value *value, struct value *parent);
 
 /* Describes offset of a value within lval of a structure in bytes.
    If lval == lval_memory, this is an offset to the address.  If lval
-- 
1.7.1

Ping: [RFA/Ada] Crash when trying to set value of packed array element

[Joel Brobecker]

Hello,

Looks like this patch fell through the (review) cracks. As explained
in the introduction to the patch, I feel like I'm a bit on thin ice
adjusting the code to match the current behavior, rather than the
behavior that I think would be more logical. On the other hand,
it's another case of mild cowardice, making a fix that I feel has
the least potential for negative impact...

Let me know which direction you think I should take. I'm happy to
commit this as a first step, thus fixing the problem at hand, with
the understanding that a followup patch would be required to change
the interface to what I think might be more logical.

Thank you,
-- 
Joel

On Wed, Feb 29, 2012 at 03:03:09PM -0800, Joel Brobecker wrote:
> Consider the following declaration:
> 
>    type Small is new Integer range 0 .. 2 ** 4 - 1;
>    type Simple_Array is array (1 .. 4) of Small;
>    pragma Pack (Simple_Array);
> 
>    SA : Simple_Array := (1, 2, 3, 4);
> 
> Trying to change the value of one of the elements in the packed array
> causes the debugger to crash:
> 
>     (gdb) set sa(3) := 9
>     [1]    4880 segmentation fault  gdb -q foo
> 
> The circumstances leading to the crash are as follow:
> 
>    . ada_evaluate_subexp creates a value corresponding to "sa(3)".
> 
>    . ada_evaluate_subexp then tries to assign 9 to this value, and
>      for this calls value_assign (via ada_value_assign).
> 
>    . Because the array is packed, the destination value is 3 bits long,
>      and as a result, value_assign uses the parent to determine that
>      element byte address and offset:
> 
>       | if (value_bitsize (toval))
>       |   {
>       |     struct value *parent = value_parent (toval);
>       |
>       |     changed_addr = value_address (parent) + value_offset (toval);
> 
> The destination value (corresponding to "sa(3)") was incorrectly created
> by ada-lang.c:ada_value_primitive_packed_val, because the "parent" was
> left as NULL. So, when we try to dereference it to get the parent address,
> GDB crashed.
> 
> The first part of the fix therefore consists in setting that field.
> This required the addition of a new "setter" in value.[hc].  It fixes
> the crash, but is still not sufficient for the assignment to actually
> work.
> 
> The second part of the problem came from the fact that value_assign
> seems to expect the "child"'s address to be equal to the parent's address,
> with the difference being the offset. Unfortunately, this requirement was
> not followed by ada_value_primitive_packed_val, so the second part of
> the fix consisted in fixing that.
> 
> Still, this was not sufficient, because it caused a regression when
> trying to perform an aggregate assignment of a packed array of packed
> record.  The key element here is the nesting of packed entities.
> Looking at the way ada_value_primitive_packed_val creates the value
> of each sub-component, one can see that the value's offset is set
> to the offset compared to the start of the parent. This was meant to
> match what value_primitive_field does as well.
> 
> So, with our array of records, if the record offset was 2, and if
> the field we're interested in that record is at offset 1, the record
> value's offset would be set to 2, and the field value's offset would
> be set to 1. But the address for both values would be left to the
> array's address. This is where things start breaking down, because
> the value_address function for our field value would return the
> address of the array + 1, instead of + 3.
> 
> This is what causes the final issue, here, because ada-lang.c's
> value_assign_to_component needs to compute the offset of the
> subcomponent compared to the top-level aggregate's start address
> (the array in our case). And it does so by subtracting the array's
> address from the sub-component's address.  When you have two levels
> of packed components, and the mid-level component is at an offset of
> the top-level component, things didn't work, because the component's
> address was miscomputed (the parent's offset is missing).
> 
> The fix consists is fixing value_address to match the work done by
> value_primitive_field (where we ignore the parent's offset).
> 
> I'm not completely happy with the last part, but it did feel like
> the safest thing to be doing without running the risk of changing
> some semantics on my own.  What I can do as a followup, is see if
> I can change the offset to make sure that address (value) is always
> equal to value->address + value->offset, even in this packed-of-packed
> case. I'd then be able to undo the change in value_address....
> 
> gdb/ChangeLog:
> 
>         * value.h (set_value_parent): Add declaration.
>         * value.c (set_value_parent): New function.
>         (value_address): If VALUE->PARENT is not NULL, then use it as
>         the base address instead of VALUE->LOCATION.address.
>         * ada-lang.c (ada_value_primitive_packed_val): Keep V's address
>         the same as OBJ's address.  Adjust V's offset accordingly.
>         Set V's parent.
> 
> gdb/testsuite/ChangeLog:
> 
>         * gdb.ada/set_pckd_arr_elt: New testcase.
> 
> Tested on x86_64-linux. OK to commit?
> 
> Thanks,
> -- 
> Joel
> 
> ---
>  gdb/ada-lang.c                                 |   17 +++++----
>  gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp     |   47 ++++++++++++++++++++++++
>  gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb |   22 +++++++++++
>  gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb |   21 +++++++++++
>  gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads |   22 +++++++++++
>  gdb/value.c                                    |   11 +++++-
>  gdb/value.h                                    |    1 +
>  7 files changed, 133 insertions(+), 8 deletions(-)
>  create mode 100644 gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp
>  create mode 100644 gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb
>  create mode 100644 gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb
>  create mode 100644 gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads
> 
> diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
> index 349ca17..f6f51ec 100644
> --- a/gdb/ada-lang.c
> +++ b/gdb/ada-lang.c
> @@ -2297,10 +2297,9 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
>      }
>    else if (VALUE_LVAL (obj) == lval_memory && value_lazy (obj))
>      {
> -      v = value_at (type,
> -                    value_address (obj) + offset);
> +      v = value_at (type, value_address (obj));
>        bytes = (unsigned char *) alloca (len);
> -      read_memory (value_address (v), bytes, len);
> +      read_memory (value_address (v) + offset, bytes, len);
>      }
>    else
>      {
> @@ -2310,18 +2309,22 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
>  
>    if (obj != NULL)
>      {
> -      CORE_ADDR new_addr;
> +      long new_offset = offset;
>  
>        set_value_component_location (v, obj);
> -      new_addr = value_address (obj) + offset;
>        set_value_bitpos (v, bit_offset + value_bitpos (obj));
>        set_value_bitsize (v, bit_size);
>        if (value_bitpos (v) >= HOST_CHAR_BIT)
>          {
> -	  ++new_addr;
> +	  ++new_offset;
>            set_value_bitpos (v, value_bitpos (v) - HOST_CHAR_BIT);
>          }
> -      set_value_address (v, new_addr);
> +      set_value_offset (v, new_offset);
> +
> +      /* Also set the parent value.  This is needed when trying to
> +	 assign a new value (in inferior memory).  */
> +      set_value_parent (v, obj);
> +      value_incref (obj);
>      }
>    else
>      set_value_bitsize (v, bit_size);
> diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp b/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp
> new file mode 100644
> index 0000000..7f6f1d3
> --- /dev/null
> +++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp
> @@ -0,0 +1,47 @@
> +# Copyright 2012 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 }
> +
> +set testdir "set_pckd_arr_elt"
> +set testfile "${testdir}/foo"
> +set srcfile ${srcdir}/${subdir}/${testfile}.adb
> +set binfile ${objdir}/${subdir}/${testfile}
> +
> +file mkdir ${objdir}/${subdir}/${testdir}
> +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
> +    return -1
> +}
> +
> +clean_restart ${testfile}
> +
> +set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
> +runto "foo.adb:$bp_location"
> +
> +gdb_test "print sa(3) := 9" " = 9"
> +
> +# To verify that the assignment was made correctly, we use the fact
> +# that the program passes this very same element as an argument to
> +# one of the functions.  So we insert a breakpoint on that function,
> +# and verify that the argument value is correct.
> +
> +gdb_breakpoint "update_small"
> +
> +gdb_test "continue" \
> +        "Breakpoint .*, pck\\.update_small \\(s=9\\) at .*pck.adb:.*" \
> +        "continue to update_small"
> +
> diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb
> new file mode 100644
> index 0000000..7f4f45d
> --- /dev/null
> +++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb
> @@ -0,0 +1,22 @@
> +--  Copyright 2012 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 Foo is
> +   SA : Simple_Array := (1, 2, 3, 4);
> +begin
> +   Update_Small (SA (3));  -- STOP
> +end Foo;
> diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb
> new file mode 100644
> index 0000000..a2bec81
> --- /dev/null
> +++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb
> @@ -0,0 +1,21 @@
> +--  Copyright 2012 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 Update_Small (S : in out Small) is
> +   begin
> +      null;
> +   end Update_Small;
> +end Pck;
> diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads
> new file mode 100644
> index 0000000..6be95e2
> --- /dev/null
> +++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads
> @@ -0,0 +1,22 @@
> +--  Copyright 2012 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 Pck is
> +   type Small is new Integer range 0 .. 2 ** 6 - 1;
> +   type Simple_Array is array (1 .. 4) of Small;
> +   pragma Pack (Simple_Array);
> +
> +   procedure Update_Small (S : in out Small);
> +end Pck;
> diff --git a/gdb/value.c b/gdb/value.c
> index 85ea970..75cc3bb 100644
> --- a/gdb/value.c
> +++ b/gdb/value.c
> @@ -805,6 +805,12 @@ value_parent (struct value *value)
>    return value->parent;
>  }
>  
> +void
> +set_value_parent (struct value *value, struct value *parent)
> +{
> +  value->parent = parent;
> +}
> +
>  gdb_byte *
>  value_contents_raw (struct value *value)
>  {
> @@ -1100,7 +1106,10 @@ value_address (const struct value *value)
>    if (value->lval == lval_internalvar
>        || value->lval == lval_internalvar_component)
>      return 0;
> -  return value->location.address + value->offset;
> +  if (value->parent != NULL)
> +    return value_address (value->parent) + value->offset;
> +  else
> +    return value->location.address + value->offset;
>  }
>  
>  CORE_ADDR
> diff --git a/gdb/value.h b/gdb/value.h
> index d4c4a83..c173b0e 100644
> --- a/gdb/value.h
> +++ b/gdb/value.h
> @@ -74,6 +74,7 @@ extern void set_value_bitpos (struct value *, int bit);
>     bitfields.  */
>  
>  struct value *value_parent (struct value *);
> +extern void set_value_parent (struct value *value, struct value *parent);
>  
>  /* Describes offset of a value within lval of a structure in bytes.
>     If lval == lval_memory, this is an offset to the address.  If lval

Re: [RFA/Ada] Crash when trying to set value of packed array element

[Jan Kratochvil]

Hi Joel,

On Thu, 01 Mar 2012 00:03:09 +0100, Joel Brobecker wrote:
> Still, this was not sufficient, because it caused a regression when
> trying to perform an aggregate assignment of a packed array of packed
> record.  The key element here is the nesting of packed entities.
> Looking at the way ada_value_primitive_packed_val creates the value
> of each sub-component, one can see that the value's offset is set
> to the offset compared to the start of the parent. This was meant to
> match what value_primitive_field does as well.
> 
> So, with our array of records, if the record offset was 2, and if
> the field we're interested in that record is at offset 1, the record
> value's offset would be set to 2, and the field value's offset would
> be set to 1. But the address for both values would be left to the
> array's address. This is where things start breaking down, because
> the value_address function for our field value would return the
> address of the array + 1, instead of + 3.
> 
> This is what causes the final issue, here, because ada-lang.c's
> value_assign_to_component needs to compute the offset of the
> subcomponent compared to the top-level aggregate's start address
> (the array in our case).

It depends on how is defined functionality of ada_value_primitive_packed_val.
Whether its parameter OFFSET is relative to the start of the array or whether
it is relative to the element.  I believe you want the latter and your patch
also implements the latter, otherwise I cannot imagine how callers would
handle it correctly.  In the latter case the parameter name OFFSET is
confusing and it should be renamed as it is _added_ to value_offset (OBJ).

In general I do not think we can ever fix it all on top of the current
infrastructure.  These OFFSETs, EMBEDDED_OFFSETs etc. should be dropped, there
should be support for discontiguos set of memory snapshot associated with
struct value (so that it supports for example even virtual method tables or
slices of multidimensional Fortran arrays).  I should find time for
archer-jankratochvil-vla.


> @@ -2310,18 +2309,22 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
>  
>    if (obj != NULL)
>      {
> -      CORE_ADDR new_addr;
> +      long new_offset = offset;

Nitpick - LONGEST (Siddhesh Poyarekar is working on a more thorough fix).


>  }
>  
> +void
> +set_value_parent (struct value *value, struct value *parent)

Missing function comment.


Thanks,
Jan

Re: [RFA/Ada] Crash when trying to set value of packed array element

[Joel Brobecker]

[-- Attachment #1: Type: text/plain, Size: 1395 bytes --]

Thanks for the review, Jan.

> In general I do not think we can ever fix it all on top of the current
> infrastructure.  These OFFSETs, EMBEDDED_OFFSETs etc. should be dropped, there
> should be support for discontiguos set of memory snapshot associated with
> struct value (so that it supports for example even virtual method tables or
> slices of multidimensional Fortran arrays).

Yeah, I agree. Although, I have been wondering how we could do without
offset, but something along those lines will be necessary (my naive
questions was: why not add offset to address and be done with it, but
of course, address might be a DWARF expression, for instance).

I checked in the patch with the missing function comment (see
attached).  But I have one question:

> > @@ -2310,18 +2309,22 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
> >  
> >    if (obj != NULL)
> >      {
> > -      CORE_ADDR new_addr;
> > +      long new_offset = offset;
> 
> Nitpick - LONGEST (Siddhesh Poyarekar is working on a more thorough fix).

I know you said it's a nitpick, but I don't understand why you think
it should be LONGEST. "offset" itself is a long, and the only use
of that new_offset is for set_value_offset, which takes an int. Are
the changes you are referring to going to make that a LONGEST?

I'll fix that as a followup patch if you confirm the above.

Thanks!
-- 
Joel

[-- Attachment #2: 0001-Ada-Crash-when-trying-to-set-value-of-packed-array-e.patch --]
[-- Type: text/x-diff, Size: 13851 bytes --]

From ea6732a149800b2f49eb7b4cd68f0e00a94e6db6 Mon Sep 17 00:00:00 2001
From: Joel Brobecker <brobecker@adacore.com>
Date: Sat, 18 Feb 2012 16:19:03 -0800
Subject: [PATCH] [Ada] Crash when trying to set value of packed array element

Consider the following declaration:

   type Small is new Integer range 0 .. 2 ** 4 - 1;
   type Simple_Array is array (1 .. 4) of Small;
   pragma Pack (Simple_Array);

   SA : Simple_Array := (1, 2, 3, 4);

Trying to change the value of one of the elements in the packed array
causes the debugger to crash:

    (gdb) set sa(3) := 9
    [1]    4880 segmentation fault  gdb -q foo

The circumstances leading to the crash are as follow:

   . ada_evaluate_subexp creates a value corresponding to "sa(3)".

   . ada_evaluate_subexp then tries to assign 9 to this value, and
     for this calls value_assign (via ada_value_assign).

   . Because the array is packed, the destination value is 3 bits long,
     and as a result, value_assign uses the parent to determine that
     element byte address and offset:

      | if (value_bitsize (toval))
      |   {
      |     struct value *parent = value_parent (toval);
      |
      |     changed_addr = value_address (parent) + value_offset (toval);

The destination value (corresponding to "sa(3)") was incorrectly created
by ada-lang.c:ada_value_primitive_packed_val, because the "parent" was
left as NULL. So, when we try to dereference it to get the parent address,
GDB crashed.

The first part of the fix therefore consists in setting that field.
This required the addition of a new "setter" in value.[hc].  It fixes
the crash, but is still not sufficient for the assignment to actually
work.

The second part of the problem came from the fact that value_assign
seems to expect the "child"'s address to be equal to the parent's address,
with the difference being the offset. Unfortunately, this requirement was
not followed by ada_value_primitive_packed_val, so the second part of
the fix consisted in fixing that.

Still, this was not sufficient, because it caused a regression when
trying to perform an aggregate assignment of a packed array of packed
record.  The key element here is the nesting of packed entities.
Looking at the way ada_value_primitive_packed_val creates the value
of each sub-component, one can see that the value's offset is set
to the offset compared to the start of the parent. This was meant to
match what value_primitive_field does as well.

So, with our array of records, if the record offset was 2, and if
the field we're interested in that record is at offset 1, the record
value's offset would be set to 2, and the field value's offset would
be set to 1. But the address for both values would be left to the
array's address. This is where things start breaking down, because
the value_address function for our field value would return the
address of the array + 1, instead of + 3.

This is what causes the final issue, here, because ada-lang.c's
value_assign_to_component needs to compute the offset of the
subcomponent compared to the top-level aggregate's start address
(the array in our case). And it does so by subtracting the array's
address from the sub-component's address.  When you have two levels
of packed components, and the mid-level component is at an offset of
the top-level component, things didn't work, because the component's
address was miscomputed (the parent's offset is missing).

The fix consists is fixing value_address to match the work done by
value_primitive_field (where we ignore the parent's offset).

gdb/ChangeLog:

        * value.h (set_value_parent): Add declaration.
        * value.c (set_value_parent): New function.
        (value_address): If VALUE->PARENT is not NULL, then use it as
        the base address instead of VALUE->LOCATION.address.
        * ada-lang.c (ada_value_primitive_packed_val): Keep V's address
        the same as OBJ's address.  Adjust V's offset accordingly.
        Set V's parent.

gdb/testsuite/ChangeLog:

        * gdb.ada/set_pckd_arr_elt: New testcase.
---
 gdb/ChangeLog                                  |   10 +++++
 gdb/ada-lang.c                                 |   17 +++++----
 gdb/testsuite/ChangeLog                        |    4 ++
 gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp     |   47 ++++++++++++++++++++++++
 gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb |   22 +++++++++++
 gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb |   21 +++++++++++
 gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads |   22 +++++++++++
 gdb/value.c                                    |   13 ++++++-
 gdb/value.h                                    |    1 +
 9 files changed, 149 insertions(+), 8 deletions(-)
 create mode 100644 gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp
 create mode 100644 gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb
 create mode 100644 gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb
 create mode 100644 gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index b813695..706788c 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,13 @@
+2012-03-16  Joel Brobecker  <brobecker@adacore.com>
+
+	* value.h (set_value_parent): Add declaration.
+	* value.c (set_value_parent): New function.
+	(value_address): If VALUE->PARENT is not NULL, then use it as
+	the base address instead of VALUE->LOCATION.address.
+	* ada-lang.c (ada_value_primitive_packed_val): Keep V's address
+	the same as OBJ's address.  Adjust V's offset accordingly.
+	Set V's parent.
+
 2012-03-16  Gary Benson  <gbenson@redhat.com>
 
 	PR breakpoints/10738
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 040d606..78a0261 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -2297,10 +2297,9 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
     }
   else if (VALUE_LVAL (obj) == lval_memory && value_lazy (obj))
     {
-      v = value_at (type,
-                    value_address (obj) + offset);
+      v = value_at (type, value_address (obj));
       bytes = (unsigned char *) alloca (len);
-      read_memory (value_address (v), bytes, len);
+      read_memory (value_address (v) + offset, bytes, len);
     }
   else
     {
@@ -2310,18 +2309,22 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
 
   if (obj != NULL)
     {
-      CORE_ADDR new_addr;
+      long new_offset = offset;
 
       set_value_component_location (v, obj);
-      new_addr = value_address (obj) + offset;
       set_value_bitpos (v, bit_offset + value_bitpos (obj));
       set_value_bitsize (v, bit_size);
       if (value_bitpos (v) >= HOST_CHAR_BIT)
         {
-	  ++new_addr;
+	  ++new_offset;
           set_value_bitpos (v, value_bitpos (v) - HOST_CHAR_BIT);
         }
-      set_value_address (v, new_addr);
+      set_value_offset (v, new_offset);
+
+      /* Also set the parent value.  This is needed when trying to
+	 assign a new value (in inferior memory).  */
+      set_value_parent (v, obj);
+      value_incref (obj);
     }
   else
     set_value_bitsize (v, bit_size);
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index ee59720..f4a75dd 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2012-03-16  Joel Brobecker  <brobecker@adacore.com>
+
+	* gdb.ada/set_pckd_arr_elt: New testcase.
+
 2012-03-16  Gary Benson  <gbenson@redhat.com>
 
 	PR breakpoints/10738
diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp b/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp
new file mode 100644
index 0000000..7f6f1d3
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp
@@ -0,0 +1,47 @@
+# Copyright 2012 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 }
+
+set testdir "set_pckd_arr_elt"
+set testfile "${testdir}/foo"
+set srcfile ${srcdir}/${subdir}/${testfile}.adb
+set binfile ${objdir}/${subdir}/${testfile}
+
+file mkdir ${objdir}/${subdir}/${testdir}
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
+    return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
+runto "foo.adb:$bp_location"
+
+gdb_test "print sa(3) := 9" " = 9"
+
+# To verify that the assignment was made correctly, we use the fact
+# that the program passes this very same element as an argument to
+# one of the functions.  So we insert a breakpoint on that function,
+# and verify that the argument value is correct.
+
+gdb_breakpoint "update_small"
+
+gdb_test "continue" \
+        "Breakpoint .*, pck\\.update_small \\(s=9\\) at .*pck.adb:.*" \
+        "continue to update_small"
+
diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb
new file mode 100644
index 0000000..7f4f45d
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb
@@ -0,0 +1,22 @@
+--  Copyright 2012 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 Foo is
+   SA : Simple_Array := (1, 2, 3, 4);
+begin
+   Update_Small (SA (3));  -- STOP
+end Foo;
diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb
new file mode 100644
index 0000000..a2bec81
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb
@@ -0,0 +1,21 @@
+--  Copyright 2012 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 Update_Small (S : in out Small) is
+   begin
+      null;
+   end Update_Small;
+end Pck;
diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads
new file mode 100644
index 0000000..6be95e2
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads
@@ -0,0 +1,22 @@
+--  Copyright 2012 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 Pck is
+   type Small is new Integer range 0 .. 2 ** 6 - 1;
+   type Simple_Array is array (1 .. 4) of Small;
+   pragma Pack (Simple_Array);
+
+   procedure Update_Small (S : in out Small);
+end Pck;
diff --git a/gdb/value.c b/gdb/value.c
index e8eb33f..c23803a 100644
--- a/gdb/value.c
+++ b/gdb/value.c
@@ -806,6 +806,14 @@ value_parent (struct value *value)
   return value->parent;
 }
 
+/* See value.h.  */
+
+void
+set_value_parent (struct value *value, struct value *parent)
+{
+  value->parent = parent;
+}
+
 gdb_byte *
 value_contents_raw (struct value *value)
 {
@@ -1101,7 +1109,10 @@ value_address (const struct value *value)
   if (value->lval == lval_internalvar
       || value->lval == lval_internalvar_component)
     return 0;
-  return value->location.address + value->offset;
+  if (value->parent != NULL)
+    return value_address (value->parent) + value->offset;
+  else
+    return value->location.address + value->offset;
 }
 
 CORE_ADDR
diff --git a/gdb/value.h b/gdb/value.h
index 3ce0f88..d501b52 100644
--- a/gdb/value.h
+++ b/gdb/value.h
@@ -74,6 +74,7 @@ extern void set_value_bitpos (struct value *, int bit);
    bitfields.  */
 
 struct value *value_parent (struct value *);
+extern void set_value_parent (struct value *value, struct value *parent);
 
 /* Describes offset of a value within lval of a structure in bytes.
    If lval == lval_memory, this is an offset to the address.  If lval
-- 
1.7.1

Re: [RFA/Ada] Crash when trying to set value of packed array element

[Jan Kratochvil]

On Fri, 16 Mar 2012 18:59:33 +0100, Joel Brobecker wrote:
> > > -      CORE_ADDR new_addr;
> > > +      long new_offset = offset;
> > 
> > Nitpick - LONGEST (Siddhesh Poyarekar is working on a more thorough fix).
> 
> I know you said it's a nitpick, but I don't understand why you think
> it should be LONGEST. "offset" itself is a long, and the only use
> of that new_offset is for set_value_offset, which takes an int. Are
> the changes you are referring to going to make that a LONGEST?

Yes; not sure if in the first phase but I hope so.


> I'll fix that as a followup patch if you confirm the above.

I do not think it matters if it is checked in as is, there is a huge amount of
such cases needing to be caught anyway.


Thanks,
Jan

Re: [RFA/Ada] Crash when trying to set value of packed array element

[Siddhesh Poyarekar]

On Fri, Mar 16, 2012 at 07:11:40PM +0100, Jan Kratochvil wrote:
> On Fri, 16 Mar 2012 18:59:33 +0100, Joel Brobecker wrote:
> > > > -      CORE_ADDR new_addr;
> > > > +      long new_offset = offset;
> > > 
> > > Nitpick - LONGEST (Siddhesh Poyarekar is working on a more thorough fix).
> > 
> > I know you said it's a nitpick, but I don't understand why you think
> > it should be LONGEST. "offset" itself is a long, and the only use
> > of that new_offset is for set_value_offset, which takes an int. Are
> > the changes you are referring to going to make that a LONGEST?
> 
> Yes; not sure if in the first phase but I hope so.

Yes, offset has been expanded to LONGEST in the first phase patch.

--
Siddhesh

Re: [RFA/Ada] Crash when trying to set value of packed array element

[Joel Brobecker]

> > I'll fix that as a followup patch if you confirm the above.
> 
> I do not think it matters if it is checked in as is, there is a huge
> amount of such cases needing to be caught anyway.

OK - I am happy to change it whenever, or let you guys change it
when you change the type of that field.

-- 
Joel