From patchwork Fri Nov 6 09:28:06 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Keven Boell X-Patchwork-Id: 9577 Received: (qmail 114782 invoked by alias); 6 Nov 2015 09:28:12 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 114772 invoked by uid 89); 6 Nov 2015 09:28:11 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=0.9 required=5.0 tests=AWL, BAYES_50, KAM_LAZY_DOMAIN_SECURITY, T_RP_MATCHES_RCVD, UNSUBSCRIBE_BODY autolearn=no version=3.3.2 X-HELO: mga14.intel.com Received: from mga14.intel.com (HELO mga14.intel.com) (192.55.52.115) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Fri, 06 Nov 2015 09:28:09 +0000 Received: from orsmga003.jf.intel.com ([10.7.209.27]) by fmsmga103.fm.intel.com with ESMTP; 06 Nov 2015 01:28:08 -0800 X-ExtLoop1: 1 Received: from kboell-mobl2.ger.corp.intel.com (HELO [172.28.205.135]) ([172.28.205.135]) by orsmga003.jf.intel.com with ESMTP; 06 Nov 2015 01:28:08 -0800 Subject: Re: [PATCH] fort_dyn_array: enable dynamic array of types To: Joel Brobecker , Keven Boell References: <1446738991-23962-1-git-send-email-keven.boell@intel.com> <20151105165613.GS4009@adacore.com> Cc: gdb-patches@sourceware.org From: Keven Boell Message-ID: <563C72A6.3050202@linux.intel.com> Date: Fri, 6 Nov 2015 10:28:06 +0100 User-Agent: Mozilla/5.0 (Windows NT 6.2; WOW64; rv:38.0) Gecko/20100101 Thunderbird/38.3.0 MIME-Version: 1.0 In-Reply-To: <20151105165613.GS4009@adacore.com> X-IsSubscribed: yes Hi Joel, I've narrowed down the patch to the bare minimum and added a more descriptive commit message, which explains what the patch is supposed to do. I thought you were still familiar with the Fortran VLA patch series, were this patch was one part of it. All hunks get tested in the attached test case. Updated patch: --- This patch enables dynamic arrays nested in types in Fortran by adjusting the address of inner elements of a struct and using the data_location attribute to fetch values of nested VLA's in Fortran types. Example: type :: mytype REAL, ALLOCATABLE :: ivla1 (:, :) REAL, ALLOCATABLE :: ivla2 (:) END TYPE mytype [...] type(mytype) :: mytypev ALLOCATE (mytypev%ivla1 (2,2)) ALLOCATE (mytypev%ivla2 (2)) mytypev%ivla1(:, :) = 1 mytypev%ivla2(:) = 1 Old: (gdb) p mytypev%ivla1 $2 = (( 8.84481654e-39, 0) ( -nan(0x7ffffd), -nan(0x7fffff)) ) (gdb) p mytypev%ivla1(1,2) $3 = -nan(0x7ffffd) (gdb) New: (gdb) p mytypev%ivla1 $2 = (( 1, 321) ( 123, 1) ) (gdb) p mytypev%ivla1(1,2) $3 = 1 2015-03-20 Keven Boell * gdbtypes (resolve_dynamic_struct): Adjust address of inner types of a struct to reflect the offset of the inner's type data_location of a VLA. * value.c (set_value_component_location): Adjust the value address for single value prints. For dynamic types compute the address of the component value location in sub range types based on the location of the sub range type. This enables accessing single elements of a nested array. (value_primitive_field): Use lazy fetch to re-evaluate a field to get the actual value. testsuite/gdb.fortran: * vla-type.exp: New file. * vla-type.f90: New file. --- gdb/gdbtypes.c | 6 +- gdb/testsuite/gdb.fortran/vla-type.exp | 94 ++++++++++++++++++++++++++++++++ gdb/testsuite/gdb.fortran/vla-type.f90 | 89 ++++++++++++++++++++++++++++++ gdb/value.c | 39 +++++++++++-- 4 files changed, 221 insertions(+), 7 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 b9850cf..e8987c1 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -2064,7 +2064,11 @@ 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; + if (TYPE_CODE (TYPE_FIELD_TYPE (resolved_type, i)) != TYPE_CODE_RANGE) + pinfo.addr = addr_stack->addr + + (TYPE_FIELD_BITPOS (resolved_type, i) / 8); + else + pinfo.addr = addr_stack->addr; pinfo.next = addr_stack; TYPE_FIELD_TYPE (resolved_type, i) diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp new file mode 100755 index 0000000..ffd0ab4 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-type.exp @@ -0,0 +1,94 @@ +# Copyright 2015 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__] then { + perror "couldn't run to breakpoint MAIN__" + continue +} + +# 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" "\\$\\d+ = \\\( , \\\)" \ + "print twov before allocated" +gdb_test "print twov%ivla1" "\\$\\d+ = " \ + "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)" "\\$\\d+ = 1" "print onev%ivla(5, 11, 23)" +gdb_test "print onev%ivla(1, 2, 3)" "\\$\\d+ = 123" "print onev%ivla(1, 2, 3)" +gdb_test "print onev%ivla(3, 2, 1)" "\\$\\d+ = 321" "print onev%ivla(3, 2, 1)" +gdb_test "ptype onev" \ + "type = Type one\r\n\\s+real\\\(kind=4\\\) :: ivla\\\(11,22,33\\\)\r\nEnd Type one" \ + "ptype onev" + +# 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)" "\\$\\d+ = 1" \ + "print twov%ivla1(5, 11, 23)" +gdb_test "print twov%ivla1(1, 2, 3)" "\\$\\d+ = 123" \ + "print twov%ivla1(1, 2, 3)" +gdb_test "print twov%ivla1(3, 2, 1)" "\\$\\d+ = 321" \ + "print twov%ivla1(3, 2, 1)" +gdb_test "ptype twov" \ + "type = Type two\r\n\\s+real\\\(kind=4\\\) :: ivla1\\\(5,12,99\\\)\r\n\\s+real\\\(kind=4\\\) :: ivla2\\\(9,12\\\)\r\nEnd Type two" \ + "ptype twov" + +# 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)" "\\$\\d+ = 1" "print threev%ivla(1)" +gdb_test "print threev%ivla(5)" "\\$\\d+ = 42" "print threev%ivla(5)" +gdb_test "print threev%ivla(14)" "\\$\\d+ = 24" "print threev%ivla(14)" +gdb_test "print threev%ivar" "\\$\\d+ = 3.14\\d+?" "print threev%ivar" +gdb_test "ptype threev" \ + "type = Type three\r\n\\s+real\\\(kind=4\\\) :: ivar\r\n\\s+real\\\(kind=4\\\) :: ivla\\\(20\\\)\r\nEnd Type three" \ + "ptype threev" + +# 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)" "\\$\\d+ = 1" "print fourv%ivla(1)" +gdb_test "print fourv%ivla(2)" "\\$\\d+ = 2" "print fourv%ivla(2)" +gdb_test "print fourv%ivla(7)" "\\$\\d+ = 7" "print fourv%ivla(7)" +gdb_test "print fourv%ivla(12)" "no such vector element" "print fourv%ivla(12)" +gdb_test "print fourv%ivar" "\\$\\d+ = 3.14\\d+?" "print fourv%ivar" +gdb_test "ptype fourv" \ + "type = Type four\r\n\\s+real\\\(kind=4\\\) :: ivla\\\(10\\\)\r\n\\s+real\\\(kind=4\\\) :: ivar\r\nEnd Type four" \ + "ptype fourv" + +# 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)" "\\$\\d+ = 1" \ + "print fivev%tone%ivla(5, 5, 1)" +gdb_test "print fivev%tone%ivla(1, 2, 3)" "\\$\\d+ = 123" \ + "print fivev%tone%ivla(1, 2, 3)" +gdb_test "print fivev%tone%ivla(3, 2, 1)" "\\$\\d+ = 321" \ + "print fivev%tone%ivla(3, 2, 1)" +gdb_test "ptype fivev" \ + "type = Type five\r\n\\s+Type one\r\n\\s+real\\\(kind=4\\\) :: ivla\\\(10,10,10\\\)\r\n\\s+End Type one :: tone\r\nEnd Type five" \ + "ptype fivev" diff --git a/gdb/testsuite/gdb.fortran/vla-type.f90 b/gdb/testsuite/gdb.fortran/vla-type.f90 new file mode 100755 index 0000000..cf3f24b --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-type.f90 @@ -0,0 +1,89 @@ +! Copyright 2015 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 2 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, write to the Free Software +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +program vla_struct + type :: one + real, allocatable :: ivla (:, :, :) + end type one + type :: two + real, allocatable :: ivla1 (:, :, :) + real, allocatable :: ivla2 (:, :) + end type two + type :: three + real :: ivar + real, allocatable :: ivla (:) + end type three + type :: four + real, allocatable :: ivla (:) + real :: 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.14 ! 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.14 + 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 91bf49e..8d8ffde 100644 --- a/gdb/value.c +++ b/gdb/value.c @@ -1788,6 +1788,25 @@ set_value_component_location (struct value *component, if (funcs->copy_closure) component->location.computed.closure = funcs->copy_closure (whole); } + + /* For dynamic types compute the address of the component value location in + sub range types based on the location of the sub range type, if not being + an internal GDB variable or parts of it. */ + if (VALUE_LVAL (component) != lval_internalvar + && VALUE_LVAL (component) != lval_internalvar_component) + { + CORE_ADDR addr; + struct type *type = value_type (whole); + + addr = value_raw_address (component); + + if (TYPE_DATA_LOCATION (type) + && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST) + { + addr = TYPE_DATA_LOCATION_ADDR (type); + set_value_address (component, addr); + } + } } @@ -3095,13 +3114,21 @@ value_primitive_field (struct value *arg1, int offset, v = allocate_value_lazy (type); else { - v = allocate_value (type); - value_contents_copy_raw (v, value_embedded_offset (v), - arg1, value_embedded_offset (arg1) + offset, - type_length_units (type)); + if (TYPE_DATA_LOCATION (type) + && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST) + v = value_at_lazy (type, value_address (arg1) + offset); + else + { + v = allocate_value (type); + value_contents_copy_raw (v, value_embedded_offset (v), + arg1, value_embedded_offset (arg1) + offset, + type_length_units (type)); + } } - v->offset = (value_offset (arg1) + offset - + value_embedded_offset (arg1)); + if (!TYPE_DATA_LOCATION (type) + || !TYPE_DATA_LOCATION_KIND (type) == PROP_CONST) + v->offset = (value_offset (arg1) + offset + + value_embedded_offset (arg1)); } set_value_component_location (v, arg1); VALUE_REGNUM (v) = VALUE_REGNUM (arg1);