From 9920b4348edbdd83e3f91c85d7174cb92bba204d Mon Sep 17 00:00:00 2001 From: Bernhard Heckel Date: Tue, 26 Apr 2016 16:28:43 +0200 Subject: [PATCH] fort_dyn_array: Enable dynamic member types inside a structure. Fortran supports dynamic types for which bounds, size and location can vary during their lifetime. As a result of the dynamic behaviour, they have to be resolved at every query. This patch will resolve the type of a structure field when it is dynamic. 2016-04-26 Bernhard Heckel 2016-04-26 Keven Boell 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: * NEWS: Add new supported features for fortran. * gdbtypes.c (remove_dyn_prop): New. (resolve_dynamic_struct): Keep type length for fortran structs. * 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/ChangeLog | 14 ++++ gdb/NEWS | 3 + gdb/gdbtypes.c | 44 ++++++++++- gdb/gdbtypes.h | 3 + gdb/testsuite/ChangeLog | 5 ++ gdb/testsuite/gdb.fortran/vla-type.exp | 102 +++++++++++++++++++++++++ gdb/testsuite/gdb.fortran/vla-type.f90 | 88 +++++++++++++++++++++ gdb/value.c | 39 +++++++++- 8 files changed, 292 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/ChangeLog b/gdb/ChangeLog index 5c94832b10..be192e798a 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,17 @@ +2016-04-26 Bernhard Heckel + Keven Boell + + * NEWS: Add new supported features for fortran. + * gdbtypes.c (remove_dyn_prop): New. + (resolve_dynamic_struct): Keep type length for fortran structs. + * 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. + 2016-04-25 Pedro Alves Yao Qi diff --git a/gdb/NEWS b/gdb/NEWS index 39d99b7cb5..7bf1e1acde 100644 --- a/gdb/NEWS +++ b/gdb/NEWS @@ -3,6 +3,9 @@ *** Changes since GDB 7.11 +* Fortran: Support structures with fields of dynamic types and + arrays of dynamic types. + * GDB now supports multibit bitfields and enums in target register descriptions. diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 65758bf0df..c8fd0c13bc 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -2064,7 +2064,9 @@ 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 +2092,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; + /* The length of a type won't change for fortran, but it does for C and Ada. + For fortran the size of dynamic fields might change over time but not the + type length of the structure. If we 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 +2231,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 TYPE in case it exists. */ + +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) + { + /* Update 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 1518a7ad82..c651c88a5b 100644 --- a/gdb/gdbtypes.h +++ b/gdb/gdbtypes.h @@ -1826,6 +1826,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/ChangeLog b/gdb/testsuite/ChangeLog index c919c47528..bb5258283c 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2016-04-26 Bernhard Heckel + + * gdb.fortran/vla-type.f90: New file. + * gdb.fortran/vla-type.exp: New file. + 2016-04-25 Yao Qi * gdb.base/branch-to-self.c: New file. diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp new file mode 100755 index 0000000000..24191fe082 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-type.exp @@ -0,0 +1,102 @@ +# 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 . + +standard_testfile ".f90" +load_lib "fortran.exp" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Depending on the compiler being used, the type names can be printed differently. +set int [fortran_int4] + +# 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" " = \\\( , \\\)" \ + "print twov before allocated" +gdb_test "print twov%ivla1" " = " \ + "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+$int :: 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+$int :: ivla1\\\(5,12,99\\\)" \ + "\\s+$int :: 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+$int :: ivar" \ + "\\s+$int :: 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+$int :: ivla\\\(10\\\)" \ + "\\s+$int :: 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+$int :: 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 0000000000..a1066177e3 --- /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 . + +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 9657b89870..e1e7f5e842 100644 --- a/gdb/value.c +++ b/gdb/value.c @@ -1541,8 +1541,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 (NULL != 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 @@ -1857,6 +1862,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) @@ -1872,9 +1879,15 @@ 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 (NULL != TYPE_DATA_LOCATION (type) + && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST) + set_value_address (component, TYPE_DATA_LOCATION_ADDR (type)); } - /* Access to the value history. */ /* Record a new value in the value history. @@ -2427,6 +2440,15 @@ 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. + The resolved dynamic location is used prior then any other address + when accessing the value. + If we keep it, we would still refer to the origin value. + Remove the location property in case it exist. */ + remove_dyn_prop (DYN_PROP_DATA_LOCATION, value_type (new_data.value)); + break; } @@ -3168,6 +3190,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 (NULL != 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 */ -- 2.34.1