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

[Joel Brobecker <brobecker at adacore dot com>]

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