[binutils-gdb] [Ada] array of variant record subscripting

[Joel Brobecker <brobecke at sourceware dot org>]

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

commit ca34b84ff68f5823e215a4d0b44b92f35cbb74a5
Author: Joel Brobecker <brobecker@adacore.com>
Date:   Thu Apr 2 11:09:15 2015 -0700

    [Ada] array of variant record subscripting
    
    Consider the following (Ada) array...
    
       A1 : Array_Type := (1 => (I => 0, S => <>),
                           2 => (I => 1, S => "A"),
                           3 => (I => 2, S => "AB"));
    
    ... where Array_Type is declared as follow:
    
       subtype Small_Type is Integer range 0 .. 10;
       type Record_Type (I : Small_Type := 0) is record
          S : String (1 .. I);
       end record;
       type Array_Type is array (Integer range <>) of Record_Type;
    
    Trying to print the value of each element individually does not
    always work. Printing the value of the first one does:
    
    (gdb) p a1(1)
        $1 = (i => 0, s => "")
    
    But printing the value of the subsequent ones often does not.
    For instance:
    
        (gdb) p a1(2)
        $2 = (i => 1, s => "")  <<<--- s should be "A"
        (gdb) p a1(3)
        $3 = (i => 2, s => "")  <<<--- s should be "AB"
    
    I traced the problem to ada_value_primitive_packed_val,
    which is trying to perform the array subscripting by
    extracting the value of the corresponding array element
    into a buffer where the contents is now byte-aligned.
    
    The element type that ada_value_primitive_packed_val gets passed
    is a dynamic type. As it happens, that dynamic type can get resolved
    thanks to:
    
          v = value_at (type, value_address (obj));
          type = value_type (v);
    
    However, obj represents the array, so the address given in the call
    to value_at represents the value of the first element. As a result,
    the solution of component S's upper bound always gets resolved based
    on the value of component I in the  first element of the array, whose
    value is 0, thus leading to GDB mistakely resolving the element type
    where S's upper bound is always 0.
    
    The proper fix would be to systematically resolve the element type
    first. But, this requires us to extract-and-realign the element's
    value so as to be able to pass it as "valaddr" to resolve_dynamic_type.
    In the meantime, it's easy to make the situation a little better by
    passing "value_address (obj) + offset" as the object address. This
    only works when BIT_OFFSET is nul, but that should be the case when
    the element type is anything but a scalar, which seems to be the only
    situation where it seems important to resolve the type now. And we're
    not that worse off otherwise.
    
    But we'll try to find a better solution in a separate patch.
    
    gdb/ChangeLog:
    
            * ada-lang.c (ada_value_primitive_packed_val): Use a more
            correct address in call to value_at.  Adjust call to
            value_address accordingly.

Diff:
---
 gdb/ChangeLog  | 6 ++++++
 gdb/ada-lang.c | 4 ++--
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 5b52c37..7c61032 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,5 +1,11 @@
 2015-05-05  Joel Brobecker  <brobecker@adacore.com>
 
+	* ada-lang.c (ada_value_primitive_packed_val): Use a more
+	correct address in call to value_at.  Adjust call to
+	value_address accordingly.
+
+2015-05-05  Joel Brobecker  <brobecker@adacore.com>
+
 	* ada-valprint.c (ada_val_print_1): Resolve TYPE before trying
 	to print it.
 
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 26f2c52..42f84e4 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -2417,10 +2417,10 @@ 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));
+      v = value_at (type, value_address (obj) + offset);
       type = value_type (v);
       bytes = (unsigned char *) alloca (len);
-      read_memory (value_address (v) + offset, bytes, len);
+      read_memory (value_address (v), bytes, len);
     }
   else
     {