From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 64601 invoked by alias); 6 Apr 2016 09:58:26 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Received: (qmail 64570 invoked by uid 89); 6 Apr 2016 09:58:25 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.6 required=5.0 tests=AWL,BAYES_00,KAM_LAZY_DOMAIN_SECURITY,RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy=lifetime X-HELO: mga11.intel.com Received: from mga11.intel.com (HELO mga11.intel.com) (192.55.52.93) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 06 Apr 2016 09:58:15 +0000 Received: from fmsmga004.fm.intel.com ([10.253.24.48]) by fmsmga102.fm.intel.com with ESMTP; 06 Apr 2016 02:58:15 -0700 X-ExtLoop1: 1 Received: from irvmail001.ir.intel.com ([163.33.26.43]) by fmsmga004.fm.intel.com with ESMTP; 06 Apr 2016 02:58:14 -0700 Received: from ulvlx001.iul.intel.com (ulvlx001.iul.intel.com [172.28.207.17]) by irvmail001.ir.intel.com (8.14.3/8.13.6/MailSET/Hub) with ESMTP id u369wDNG013359; Wed, 6 Apr 2016 10:58:13 +0100 Received: from ulvlx001.iul.intel.com (localhost [127.0.0.1]) by ulvlx001.iul.intel.com with ESMTP id u369wDDc019202; Wed, 6 Apr 2016 11:58:13 +0200 Received: (from heckel@localhost) by ulvlx001.iul.intel.com with œ id u369wD4Q019198; Wed, 6 Apr 2016 11:58:13 +0200 From: Bernhard Heckel To: yao@codesourcery.com Cc: gdb-patches@sourceware.org, brobecker@adacore.com, Bernhard Heckel Subject: [PATCH V2 1/3] fort_dyn_array: Enable dynamic member types inside a structure. Date: Wed, 06 Apr 2016 09:58:00 -0000 Message-Id: <1459936659-19039-2-git-send-email-bernhard.heckel@intel.com> In-Reply-To: <1459936659-19039-1-git-send-email-bernhard.heckel@intel.com> References: <1459936659-19039-1-git-send-email-bernhard.heckel@intel.com> X-IsSubscribed: yes X-SW-Source: 2016-04/txt/msg00120.txt.bz2 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 2015-03-20 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/NEWS | 3 ++ 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 ++++++++++-- 6 files changed, 264 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 be15902..056d56c 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. + * Intel MPX bound violation handling. Segmentation faults caused by a Intel MPX boundary violation diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index f129b0e..b0b49d0 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; + /* 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 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 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 . + +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" " = \\\( , \\\)" \ + "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+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 . + +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..751f430 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)); } - /* 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 */ -- 2.7.1.339.g0233b80