From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 57283 invoked by alias); 4 Apr 2016 09:22:03 -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 57269 invoked by uid 89); 4 Apr 2016 09:22:02 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.9 required=5.0 tests=BAYES_00,RP_MATCHES_RCVD,SPF_PASS autolearn=ham version=3.3.2 spammy=sk:allocat, H*r:sk:orsmga1, UD:next, 1,98 X-HELO: mga03.intel.com Received: from mga03.intel.com (HELO mga03.intel.com) (134.134.136.65) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 04 Apr 2016 09:21:52 +0000 Received: from fmsmga003.fm.intel.com ([10.253.24.29]) by orsmga103.jf.intel.com with ESMTP; 04 Apr 2016 02:21:49 -0700 X-ExtLoop1: 1 Received: from heckel-mobl3.ger.corp.intel.com (HELO [172.28.205.63]) ([172.28.205.63]) by FMSMGA003.fm.intel.com with ESMTP; 04 Apr 2016 02:21:48 -0700 Subject: Re: [PATCH 1/3][PING] fort_dyn_array: Enable dynamic member types inside a structure. To: gdb-patches@sourceware.org References: <1458204189-13267-1-git-send-email-bernhard.heckel@intel.com> <1458204189-13267-2-git-send-email-bernhard.heckel@intel.com> From: "Heckel, Bernhard" Message-ID: <5702322B.2000201@intel.com> Date: Mon, 04 Apr 2016 09:22:00 -0000 User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64; rv:38.0) Gecko/20100101 Thunderbird/38.6.0 MIME-Version: 1.0 In-Reply-To: <1458204189-13267-2-git-send-email-bernhard.heckel@intel.com> Content-Type: text/plain; charset="windows-1252"; format="flowed" Content-Transfer-Encoding: quoted-printable X-IsSubscribed: yes X-SW-Source: 2016-04/txt/msg00028.txt.bz2 On 17/03/2016 09:43, Bernhard Heckel wrote: > fort_dyn_array: Enable dynamic member types inside a structure. > > 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 =3D 1 > (gdb) print threev%ivla(5) > $10 =3D 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, >=20=20=20 > pinfo.type =3D check_typedef (TYPE_FIELD_TYPE (type, i)); > pinfo.valaddr =3D addr_stack->valaddr; > - pinfo.addr =3D addr_stack->addr; > + pinfo.addr =3D addr_stack->addr > + + (TYPE_FIELD_BITPOS (resolved_type, i) / TARGET_CHAR_BIT); > pinfo.next =3D addr_stack; >=20=20=20 > TYPE_FIELD_TYPE (resolved_type, i) > @@ -2090,8 +2091,13 @@ resolve_dynamic_struct (struct type *type, > resolved_type_bit_length =3D new_bit_length; > } >=20=20=20 > - TYPE_LENGTH (resolved_type) > - =3D (resolved_type_bit_length + TARGET_CHAR_BIT - 1) / TARGET_CHAR_B= IT; > + /* 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 !=3D language_fortran) > + TYPE_LENGTH (resolved_type) > + =3D (resolved_type_bit_length + TARGET_CHAR_BIT - 1) / TARGET_CHAR= _BIT; >=20=20=20 > /* 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_kin= d, struct dynamic_prop prop, > TYPE_DYN_PROP_LIST (type) =3D temp; > } >=20=20=20 > +/* 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 =3D TYPE_DYN_PROP_LIST (type); > + prev_node =3D NULL; > + > + while (NULL !=3D curr_node) > + { > + if (curr_node->prop_kind =3D=3D 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 =3D=3D prev_node) > + TYPE_DYN_PROP_LIST (type) =3D curr_node->next; > + else > + prev_node->next =3D curr_node->next; > + > + return; > + } > + > + prev_node =3D curr_node; > + curr_node =3D curr_node->next; > + } > +} >=20=20=20 > /* 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); >=20=20=20 > +extern void remove_dyn_prop (enum dynamic_prop_node_kind prop_kind, > + struct type *type); > + > extern struct type *check_typedef (struct type *); >=20=20=20 > extern void check_stub_method_group (struct type *, int); > diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.f= ortran/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" " =3D \\\( , \\\)" \ > + "print twov before allocated" > +gdb_test "print twov%ivla1" " =3D " \ > + "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)" " =3D 1" > +gdb_test "print onev%ivla(1, 2, 3)" " =3D 123" > +gdb_test "print onev%ivla(3, 2, 1)" " =3D 321" > +gdb_test "ptype onev" \ > + [multi_line "type =3D Type one" \ > + "\\s+integer\\\(kind=3D4\\\) :: 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)" " =3D 1" > +gdb_test "print twov%ivla1(1, 2, 3)" " =3D 123" > +gdb_test "print twov%ivla1(3, 2, 1)" " =3D 321" > +gdb_test "ptype twov" \ > + [multi_line "type =3D Type two" \ > + "\\s+integer\\\(kind=3D4\\\) :: ivla1\\\(5,12,99\\\= )" \ > + "\\s+integer\\\(kind=3D4\\\) :: 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)" " =3D 1" > +gdb_test "print threev%ivla(5)" " =3D 42" > +gdb_test "print threev%ivla(14)" " =3D 24" > +gdb_test "print threev%ivar" " =3D 3" > +gdb_test "ptype threev" \ > + [multi_line "type =3D Type three" \ > + "\\s+integer\\\(kind=3D4\\\) :: ivar" \ > + "\\s+integer\\\(kind=3D4\\\) :: 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)" " =3D 1" > +gdb_test "print fourv%ivla(2)" " =3D 2" > +gdb_test "print fourv%ivla(7)" " =3D 7" > +gdb_test "print fourv%ivla(12)" "no such vector element" > +gdb_test "print fourv%ivar" " =3D 3" > +gdb_test "ptype fourv" \ > + [multi_line "type =3D Type four" \ > + "\\s+integer\\\(kind=3D4\\\) :: ivla\\\(10\\\)" \ > + "\\s+integer\\\(kind=3D4\\\) :: 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)" " =3D 1" > +gdb_test "print fivev%tone%ivla(1, 2, 3)" " =3D 123" > +gdb_test "print fivev%tone%ivla(3, 2, 1)" " =3D 321" > +gdb_test "ptype fivev" \ > + [multi_line "type =3D Type five" \ > + "\\s+Type one" \ > + "\\s+integer\\\(kind=3D4\\\) :: 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.f= ortran/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 =3D allocated(onev%ivla) > + > + onev%ivla(:, :, :) =3D 1 > + onev%ivla(1, 2, 3) =3D 123 > + onev%ivla(3, 2, 1) =3D 321 > + > + allocate (twov%ivla1 (5,12,99)) ! onev-filled > + l =3D allocated(twov%ivla1) > + allocate (twov%ivla2 (9,12)) > + l =3D allocated(twov%ivla2) > + > + twov%ivla1(:, :, :) =3D 1 > + twov%ivla1(1, 2, 3) =3D 123 > + twov%ivla1(3, 2, 1) =3D 321 > + > + twov%ivla2(:, :) =3D 1 > + twov%ivla2(1, 2) =3D 12 > + twov%ivla2(2, 1) =3D 21 > + > + threev%ivar =3D 3 ! twov-filled > + allocate (threev%ivla (20)) > + l =3D allocated(threev%ivla) > + > + threev%ivla(:) =3D 1 > + threev%ivla(5) =3D 42 > + threev%ivla(14) =3D 24 > + > + allocate (fourv%ivla (10)) ! threev-filled > + l =3D allocated(fourv%ivla) > + > + fourv%ivar =3D 3 > + fourv%ivla(:) =3D 1 > + fourv%ivla(2) =3D 2 > + fourv%ivla(7) =3D 7 > + > + allocate (fivev%tone%ivla (10, 10, 10)) ! fourv-filled > + l =3D allocated(fivev%tone%ivla) > + fivev%tone%ivla(:, :, :) =3D 1 > + fivev%tone%ivla(1, 2, 3) =3D 123 > + fivev%tone%ivla(3, 2, 1) =3D 321 > + > + ! dummy statement for bp > + l =3D 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 !=3D 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 =3D=3D TYPE_DATA_LOCATION_KIND (value_type = (value))); > + return TYPE_DATA_LOCATION_ADDR (value_type (value)); > + } > + > + return value->location.address + value->offset; > } >=20=20=20 > 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 !=3D lval_xcallable); >=20=20=20 > if (whole->lval =3D=3D lval_internalvar) > @@ -1861,9 +1868,14 @@ set_value_component_location (struct value *compon= ent, > if (funcs->copy_closure) > component->location.computed.closure =3D funcs->copy_closure (w= hole); > } > + > + /* If type has a dynamic resolved location property update it's value = address. */ > + type =3D value_type (whole); > + if (TYPE_DATA_LOCATION (type) > + && TYPE_DATA_LOCATION_KIND (type) =3D=3D PROP_CONST) > + set_value_address (component, TYPE_DATA_LOCATION_ADDR (type)); > } >=20=20=20 > -=0C > /* Access to the value history. */ >=20=20=20 > /* Record a new value in the value history. > @@ -2416,6 +2428,12 @@ set_internalvar (struct internalvar *var, struct v= alue *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; > } >=20=20=20 > @@ -3157,6 +3175,17 @@ value_primitive_field (struct value *arg1, int off= set, > v->offset =3D value_offset (arg1); > v->embedded_offset =3D offset + value_embedded_offset (arg1) + bo= ffset; > } > + else if (TYPE_DATA_LOCATION (type)) > + { > + /* Field is a dynamic data member. */ > + > + gdb_assert (0 =3D=3D offset); > + /* We expect an already resolved data location. */ > + gdb_assert (PROP_CONST =3D=3D TYPE_DATA_LOCATION_KIND (type)); > + /* For dynamic data types defer memory allocation > + until we actual access the value. */ > + v =3D allocate_value_lazy (type); > + } > else > { > /* Plain old data member */ --=20 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