Re: [PATCH 1/3][PING] fort_dyn_array: Enable dynamic member types inside a structure.

Heckel, Bernhard
2016-04-04T09:22:03Z

On 17/03/2016 09:43, Bernhard Heckel wrote:
> fort_dyn_array: Enable dynamic member types inside a structure.
>
> 2016-02-24 Bernhard Heckel <bernhard.heckel@intel.com>
> 2015-03-20 Keven Boell <keven.boell@intel.com>
>
> Before:
> (gdb) print threev%ivla(1)
> Cannot access memory at address 0x3
> (gdb) print threev%ivla(5)
> no such vector element
>
> After:
> (gdb) print threev%ivla(1)
> $9 = 1
> (gdb) print threev%ivla(5)
> $10 = 42
>
> gdb/Changelog:
>
> * gdbtypes.c (remove_dyn_prop): New.
> * gdbtypes.h: Forward declaration of new function.
> * value.c (value_address): Return dynamic resolved location of a value.
> (set_value_component_location): Adjust the value address
> for single value prints.
> (value_primitive_field): Support value types with a dynamic location.
> (set_internalvar): Remove dynamic location property of
> internal variables.
>
> gdb/testsuite/Changelog:
>
> * gdb.fortran/vla-type.f90: New file.
> * gdb.fortran/vla-type.exp: New file.
>
> ---
> gdb/gdbtypes.c | 43 +++++++++++++--
> gdb/gdbtypes.h | 3 ++
> gdb/testsuite/gdb.fortran/vla-type.exp | 98 ++++++++++++++++++++++++++++++++++
> gdb/testsuite/gdb.fortran/vla-type.f90 | 88 ++++++++++++++++++++++++++++++
> gdb/value.c | 35 ++++++++++--
> 5 files changed, 261 insertions(+), 6 deletions(-)
> create mode 100755 gdb/testsuite/gdb.fortran/vla-type.exp
> create mode 100755 gdb/testsuite/gdb.fortran/vla-type.f90
>
> diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
> index f129b0e..066fe88 100644
> --- a/gdb/gdbtypes.c
> +++ b/gdb/gdbtypes.c
> @@ -2064,7 +2064,8 @@ resolve_dynamic_struct (struct type *type,
>
> pinfo.type = check_typedef (TYPE_FIELD_TYPE (type, i));
> pinfo.valaddr = addr_stack->valaddr;
> - pinfo.addr = addr_stack->addr;
> + pinfo.addr = addr_stack->addr
> + + (TYPE_FIELD_BITPOS (resolved_type, i) / TARGET_CHAR_BIT);
> pinfo.next = addr_stack;
>
> TYPE_FIELD_TYPE (resolved_type, i)
> @@ -2090,8 +2091,13 @@ resolve_dynamic_struct (struct type *type,
> resolved_type_bit_length = new_bit_length;
> }
>
> - TYPE_LENGTH (resolved_type)
> - = (resolved_type_bit_length + TARGET_CHAR_BIT - 1) / TARGET_CHAR_BIT;
> + /* Type length won't change for fortran. Keep what we got from DWARF.
> + Dynamic fields might change over time but not the struct definition.
> + If we would adapt it we run into problems when
> + calculating the element offset for arrays of structs. */
> + if (current_language->la_language != language_fortran)
> + TYPE_LENGTH (resolved_type)
> + = (resolved_type_bit_length + TARGET_CHAR_BIT - 1) / TARGET_CHAR_BIT;
>
> /* The Ada language uses this field as a cache for static fixed types: reset
> it as RESOLVED_TYPE must have its own static fixed type. */
> @@ -2224,6 +2230,37 @@ add_dyn_prop (enum dynamic_prop_node_kind prop_kind, struct dynamic_prop prop,
> TYPE_DYN_PROP_LIST (type) = temp;
> }
>
> +/* Remove dynamic property from a type in case it exist. */
> +
> +void
> +remove_dyn_prop (enum dynamic_prop_node_kind prop_kind,
> + struct type *type)
> +{
> + struct dynamic_prop_list *prev_node, *curr_node;
> +
> + curr_node = TYPE_DYN_PROP_LIST (type);
> + prev_node = NULL;
> +
> + while (NULL != curr_node)
> + {
> + if (curr_node->prop_kind == prop_kind)
> + {
> + /* Upadate the linked list but don't free anything.
> + The property was allocated on objstack and it is not known
> + if we are on top of it. Nevertheless, everything is released
> + when the complete objstack is freed. */
> + if (NULL == prev_node)
> + TYPE_DYN_PROP_LIST (type) = curr_node->next;
> + else
> + prev_node->next = curr_node->next;
> +
> + return;
> + }
> +
> + prev_node = curr_node;
> + curr_node = curr_node->next;
> + }
> +}
>
> /* Find the real type of TYPE. This function returns the real type,
> after removing all layers of typedefs, and completing opaque or stub
> diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
> index e775a1d..b118610 100644
> --- a/gdb/gdbtypes.h
> +++ b/gdb/gdbtypes.h
> @@ -1823,6 +1823,9 @@ extern void add_dyn_prop
> (enum dynamic_prop_node_kind kind, struct dynamic_prop prop,
> struct type *type, struct objfile *objfile);
>
> +extern void remove_dyn_prop (enum dynamic_prop_node_kind prop_kind,
> + struct type *type);
> +
> extern struct type *check_typedef (struct type *);
>
> extern void check_stub_method_group (struct type *, int);
> diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp
> new file mode 100755
> index 0000000..1d09451
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/vla-type.exp
> @@ -0,0 +1,98 @@
> +# Copyright 2016 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/>.
> +
> +standard_testfile ".f90"
> +
> +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
> + {debug f90 quiet}] } {
> + return -1
> +}
> +
> +if ![runto_main] {
> + untested "could not run to main"
> + return -1
> +}
> +
> +# Check if not allocated VLA in type does not break
> +# the debugger when accessing it.
> +gdb_breakpoint [gdb_get_line_number "before-allocated"]
> +gdb_continue_to_breakpoint "before-allocated"
> +gdb_test "print twov" " = \\\( <not allocated>, <not allocated> \\\)" \
> + "print twov before allocated"
> +gdb_test "print twov%ivla1" " = <not allocated>" \
> + "print twov%ivla1 before allocated"
> +
> +# Check type with one VLA's inside
> +gdb_breakpoint [gdb_get_line_number "onev-filled"]
> +gdb_continue_to_breakpoint "onev-filled"
> +gdb_test "print onev%ivla(5, 11, 23)" " = 1"
> +gdb_test "print onev%ivla(1, 2, 3)" " = 123"
> +gdb_test "print onev%ivla(3, 2, 1)" " = 321"
> +gdb_test "ptype onev" \
> + [multi_line "type = Type one" \
> + "\\s+integer\\\(kind=4\\\) :: ivla\\\(11,22,33\\\)" \
> + "End Type one" ]
> +
> +# Check type with two VLA's inside
> +gdb_breakpoint [gdb_get_line_number "twov-filled"]
> +gdb_continue_to_breakpoint "twov-filled"
> +gdb_test "print twov%ivla1(5, 11, 23)" " = 1"
> +gdb_test "print twov%ivla1(1, 2, 3)" " = 123"
> +gdb_test "print twov%ivla1(3, 2, 1)" " = 321"
> +gdb_test "ptype twov" \
> + [multi_line "type = Type two" \
> + "\\s+integer\\\(kind=4\\\) :: ivla1\\\(5,12,99\\\)" \
> + "\\s+integer\\\(kind=4\\\) :: ivla2\\\(9,12\\\)" \
> + "End Type two" ]
> +
> +# Check type with attribute at beginn of type
> +gdb_breakpoint [gdb_get_line_number "threev-filled"]
> +gdb_continue_to_breakpoint "threev-filled"
> +gdb_test "print threev%ivla(1)" " = 1"
> +gdb_test "print threev%ivla(5)" " = 42"
> +gdb_test "print threev%ivla(14)" " = 24"
> +gdb_test "print threev%ivar" " = 3"
> +gdb_test "ptype threev" \
> + [multi_line "type = Type three" \
> + "\\s+integer\\\(kind=4\\\) :: ivar" \
> + "\\s+integer\\\(kind=4\\\) :: ivla\\\(20\\\)" \
> + "End Type three" ]
> +
> +# Check type with attribute at end of type
> +gdb_breakpoint [gdb_get_line_number "fourv-filled"]
> +gdb_continue_to_breakpoint "fourv-filled"
> +gdb_test "print fourv%ivla(1)" " = 1"
> +gdb_test "print fourv%ivla(2)" " = 2"
> +gdb_test "print fourv%ivla(7)" " = 7"
> +gdb_test "print fourv%ivla(12)" "no such vector element"
> +gdb_test "print fourv%ivar" " = 3"
> +gdb_test "ptype fourv" \
> + [multi_line "type = Type four" \
> + "\\s+integer\\\(kind=4\\\) :: ivla\\\(10\\\)" \
> + "\\s+integer\\\(kind=4\\\) :: ivar" \
> + "End Type four" ]
> +
> +# Check nested types containing a VLA
> +gdb_breakpoint [gdb_get_line_number "fivev-filled"]
> +gdb_continue_to_breakpoint "fivev-filled"
> +gdb_test "print fivev%tone%ivla(5, 5, 1)" " = 1"
> +gdb_test "print fivev%tone%ivla(1, 2, 3)" " = 123"
> +gdb_test "print fivev%tone%ivla(3, 2, 1)" " = 321"
> +gdb_test "ptype fivev" \
> + [multi_line "type = Type five" \
> + "\\s+Type one" \
> + "\\s+integer\\\(kind=4\\\) :: ivla\\\(10,10,10\\\)" \
> + "\\s+End Type one :: tone" \
> + "End Type five" ]
> diff --git a/gdb/testsuite/gdb.fortran/vla-type.f90 b/gdb/testsuite/gdb.fortran/vla-type.f90
> new file mode 100755
> index 0000000..a106617
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/vla-type.f90
> @@ -0,0 +1,88 @@
> +! Copyright 2016 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/>.
> +
> +program vla_struct
> + type :: one
> + integer, allocatable :: ivla (:, :, :)
> + end type one
> + type :: two
> + integer, allocatable :: ivla1 (:, :, :)
> + integer, allocatable :: ivla2 (:, :)
> + end type two
> + type :: three
> + integer :: ivar
> + integer, allocatable :: ivla (:)
> + end type three
> + type :: four
> + integer, allocatable :: ivla (:)
> + integer :: ivar
> + end type four
> + type :: five
> + type(one) :: tone
> + end type five
> +
> + type(one), target :: onev
> + type(two) :: twov
> + type(three) :: threev
> + type(four) :: fourv
> + type(five) :: fivev
> + logical :: l
> + integer :: i, j
> +
> + allocate (onev%ivla (11,22,33)) ! before-allocated
> + l = allocated(onev%ivla)
> +
> + onev%ivla(:, :, :) = 1
> + onev%ivla(1, 2, 3) = 123
> + onev%ivla(3, 2, 1) = 321
> +
> + allocate (twov%ivla1 (5,12,99)) ! onev-filled
> + l = allocated(twov%ivla1)
> + allocate (twov%ivla2 (9,12))
> + l = allocated(twov%ivla2)
> +
> + twov%ivla1(:, :, :) = 1
> + twov%ivla1(1, 2, 3) = 123
> + twov%ivla1(3, 2, 1) = 321
> +
> + twov%ivla2(:, :) = 1
> + twov%ivla2(1, 2) = 12
> + twov%ivla2(2, 1) = 21
> +
> + threev%ivar = 3 ! twov-filled
> + allocate (threev%ivla (20))
> + l = allocated(threev%ivla)
> +
> + threev%ivla(:) = 1
> + threev%ivla(5) = 42
> + threev%ivla(14) = 24
> +
> + allocate (fourv%ivla (10)) ! threev-filled
> + l = allocated(fourv%ivla)
> +
> + fourv%ivar = 3
> + fourv%ivla(:) = 1
> + fourv%ivla(2) = 2
> + fourv%ivla(7) = 7
> +
> + allocate (fivev%tone%ivla (10, 10, 10)) ! fourv-filled
> + l = allocated(fivev%tone%ivla)
> + fivev%tone%ivla(:, :, :) = 1
> + fivev%tone%ivla(1, 2, 3) = 123
> + fivev%tone%ivla(3, 2, 1) = 321
> +
> + ! dummy statement for bp
> + l = allocated(fivev%tone%ivla) ! fivev-filled
> +end program vla_struct
> diff --git a/gdb/value.c b/gdb/value.c
> index 738b2b2..e7b01cf 100644
> --- a/gdb/value.c
> +++ b/gdb/value.c
> @@ -1530,8 +1530,13 @@ value_address (const struct value *value)
> return 0;
> if (value->parent != NULL)
> return value_address (value->parent) + value->offset;
> - else
> - return value->location.address + value->offset;
> + if (TYPE_DATA_LOCATION (value_type (value)))
> + {
> + gdb_assert (PROP_CONST == TYPE_DATA_LOCATION_KIND (value_type (value)));
> + return TYPE_DATA_LOCATION_ADDR (value_type (value));
> + }
> +
> + return value->location.address + value->offset;
> }
>
> CORE_ADDR
> @@ -1846,6 +1851,8 @@ void
> set_value_component_location (struct value *component,
> const struct value *whole)
> {
> + struct type *type;
> +
> gdb_assert (whole->lval != lval_xcallable);
>
> if (whole->lval == lval_internalvar)
> @@ -1861,9 +1868,14 @@ set_value_component_location (struct value *component,
> if (funcs->copy_closure)
> component->location.computed.closure = funcs->copy_closure (whole);
> }
> +
> + /* If type has a dynamic resolved location property update it's value address. */
> + type = value_type (whole);
> + if (TYPE_DATA_LOCATION (type)
> + && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
> + set_value_address (component, TYPE_DATA_LOCATION_ADDR (type));
> }
>
> -\f
> /* Access to the value history. */
>
> /* Record a new value in the value history.
> @@ -2416,6 +2428,12 @@ set_internalvar (struct internalvar *var, struct value *val)
> call error () until new_data is installed into the var->u to avoid
> leaking memory. */
> release_value (new_data.value);
> +
> + /* Internal variables which are created from values with a dynamic location
> + don't need the location property of the origin anymore.
> + Remove the location property in case it exist. */
> + remove_dyn_prop(DYN_PROP_DATA_LOCATION, value_type(new_data.value));
> +
> break;
> }
>
> @@ -3157,6 +3175,17 @@ value_primitive_field (struct value *arg1, int offset,
> v->offset = value_offset (arg1);
> v->embedded_offset = offset + value_embedded_offset (arg1) + boffset;
> }
> + else if (TYPE_DATA_LOCATION (type))
> + {
> + /* Field is a dynamic data member. */
> +
> + gdb_assert (0 == offset);
> + /* We expect an already resolved data location. */
> + gdb_assert (PROP_CONST == TYPE_DATA_LOCATION_KIND (type));
> + /* For dynamic data types defer memory allocation
> + until we actual access the value. */
> + v = allocate_value_lazy (type);
> + }
> else
> {
> /* Plain old data member */

--

Intel Deutschland GmbH
Registered Address: Am Campeon 10-12, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de
Managing Directors: Christin Eisenschmid, Christian Lamprechter
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928

Intel Deutschland GmbH
Registered Address: Am Campeon 10-12, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de
Managing Directors: Christin Eisenschmid, Christian Lamprechter
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928