* [PATCH V4 1/3] fort_dyn_array: Enable dynamic member types inside a structure.
2016-04-15 6:42 [PATCH V4 0/3] fortran: Enable arrays of structures with dynamic member types Bernhard Heckel
@ 2016-04-15 6:42 ` Bernhard Heckel
2016-04-21 6:03 ` [PING][PATCH V4 0/3] fortran: Enable arrays of structures with dynamic member types Bernhard Heckel
` (2 subsequent siblings)
3 siblings, 0 replies; 6+ messages in thread
From: Bernhard Heckel @ 2016-04-15 6:42 UTC (permalink / raw)
To: qiyaoltc; +Cc: gdb-patches, brobecker, Bernhard Heckel
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-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:
* 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/NEWS | 3 ++
gdb/gdbtypes.c | 44 +++++++++++++--
gdb/gdbtypes.h | 3 ++
gdb/testsuite/gdb.fortran/vla-type.exp | 98 ++++++++++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/vla-type.f90 | 88 ++++++++++++++++++++++++++++++
gdb/value.c | 39 ++++++++++++--
6 files changed, 269 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/NEWS b/gdb/NEWS
index 39d99b7..7bf1e1a 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 65758bf..c8fd0c1 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 1518a7a..c651c88 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/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 3b66946..927304a 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));
}
-\f
/* 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.7.1.339.g0233b80
^ permalink raw reply [flat|nested] 6+ messages in thread