From patchwork Tue Nov 27 18:31:31 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sebastian Basierski X-Patchwork-Id: 30327 Received: (qmail 14080 invoked by alias); 27 Nov 2018 19:40:16 -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 13985 invoked by uid 89); 27 Nov 2018 19:40:16 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.9 required=5.0 tests=BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_SHORT, SPF_FAIL autolearn=ham version=3.3.2 spammy=complaint, 1198, prop, Property X-HELO: mga02.intel.com Received: from mga02.intel.com (HELO mga02.intel.com) (134.134.136.20) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 27 Nov 2018 19:40:09 +0000 Received: from fmsmga003.fm.intel.com ([10.253.24.29]) by orsmga101.jf.intel.com with ESMTP/TLS/DHE-RSA-AES256-GCM-SHA384; 27 Nov 2018 11:40:07 -0800 Received: from ubuntu.imu.intel.com ([10.217.246.11]) by FMSMGA003.fm.intel.com with ESMTP; 27 Nov 2018 11:40:07 -0800 From: Sebastian Basierski To: gdb-patches@sourceware.org Subject: [PATCH 03/11] vla: add stride support to fortran arrays. Date: Tue, 27 Nov 2018 19:31:31 +0100 Message-Id: <20181127183139.71170-4-sbasierski@pl.sii.eu> In-Reply-To: <20181127183139.71170-1-sbasierski@pl.sii.eu> References: <20181127183139.71170-1-sbasierski@pl.sii.eu> From: Keven Boell 2014-05-28 Bernhard Heckel Sanimir Agovic Keven Boell gdb/Changelog: * dwarf2read.c (read_subrange_type): Read dynamic stride attributes. * gdbtypes.c (create_array_type_with_stride): Add stride support (create_range_type): Add stride parameter. (create_static_range_type): Pass default stride parameter. (resolve_dynamic_range): Evaluate stride baton. * gdbtypes.h (TYPE_BYTE_STRIDE): New macro. (TYPE_BYTE_STRIDE_BLOCK): New macro. (TYPE_BYTE_STRIDE_LOCLIST): New macro. (TYPE_BYTE_STRIDE_KIND): New macro. * valarith.c (value_subscripted_rvalue): Use stride. gdb/testsuite/Changelog: * vla-stride.exp: New file. * vla-stride.f90: New file. --- gdb/dwarf2read.c | 14 ++++++-- gdb/f-valprint.c | 8 ++++- gdb/gdbtypes.c | 29 ++++++++++++---- gdb/gdbtypes.h | 15 ++++++++ gdb/testsuite/gdb.fortran/vla-stride.exp | 44 ++++++++++++++++++++++++ gdb/testsuite/gdb.fortran/vla-stride.f90 | 29 ++++++++++++++++ gdb/valarith.c | 10 ++++-- 7 files changed, 138 insertions(+), 11 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/vla-stride.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-stride.f90 diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c index 78f96ea0d1..902aad3fbc 100644 --- a/gdb/dwarf2read.c +++ b/gdb/dwarf2read.c @@ -17841,7 +17841,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) struct type *base_type, *orig_base_type; struct type *range_type; struct attribute *attr; - struct dynamic_prop low, high; + struct dynamic_prop low, high, stride; int low_default_is_valid; int high_bound_is_count = 0; const char *name; @@ -17861,7 +17861,9 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) low.kind = PROP_CONST; high.kind = PROP_CONST; + stride.kind = PROP_CONST; high.data.const_val = 0; + stride.data.const_val = 0; /* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow omitting DW_AT_lower_bound. */ @@ -17894,6 +17896,14 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) break; } + attr = dwarf2_attr (die, DW_AT_byte_stride, cu); + if (attr) + if (!attr_to_dynamic_prop (attr, die, cu, &stride)) + complaint (_("Missing DW_AT_byte_stride " + "- DIE at 0x%s [in module %s]"), + sect_offset_str (die->sect_off), + objfile_name (cu->per_cu->dwarf2_per_objfile->objfile)); + attr = dwarf2_attr (die, DW_AT_lower_bound, cu); if (attr) attr_to_dynamic_prop (attr, die, cu, &low); @@ -17986,7 +17996,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask)) high.data.const_val |= negative_mask; - range_type = create_range_type (NULL, orig_base_type, &low, &high); + range_type = create_range_type (NULL, orig_base_type, &low, &high, &stride); if (high_bound_is_count) TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1; diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c index 903f2af638..b4067a8460 100644 --- a/gdb/f-valprint.c +++ b/gdb/f-valprint.c @@ -119,8 +119,14 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type, if (nss != ndimensions) { - size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type)); + size_t dim_size; size_t offs = 0; + LONGEST byte_stride = abs (TYPE_BYTE_STRIDE (range_type)); + + if (byte_stride) + dim_size = byte_stride; + else + dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type)); for (i = lowerbound; (i < upperbound + 1 && (*elts) < options->print_max); diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 8adf899f9a..6730ae28e5 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -911,7 +911,8 @@ operator== (const range_bounds &l, const range_bounds &r) struct type * create_range_type (struct type *result_type, struct type *index_type, const struct dynamic_prop *low_bound, - const struct dynamic_prop *high_bound) + const struct dynamic_prop *high_bound, + const struct dynamic_prop *stride) { if (result_type == NULL) result_type = alloc_type_copy (index_type); @@ -926,6 +927,7 @@ create_range_type (struct type *result_type, struct type *index_type, TYPE_ZALLOC (result_type, sizeof (struct range_bounds)); TYPE_RANGE_DATA (result_type)->low = *low_bound; TYPE_RANGE_DATA (result_type)->high = *high_bound; + TYPE_RANGE_DATA (result_type)->stride = *stride; if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0) TYPE_UNSIGNED (result_type) = 1; @@ -954,7 +956,7 @@ struct type * create_static_range_type (struct type *result_type, struct type *index_type, LONGEST low_bound, LONGEST high_bound) { - struct dynamic_prop low, high; + struct dynamic_prop low, high, stride; low.kind = PROP_CONST; low.data.const_val = low_bound; @@ -962,7 +964,11 @@ create_static_range_type (struct type *result_type, struct type *index_type, high.kind = PROP_CONST; high.data.const_val = high_bound; - result_type = create_range_type (result_type, index_type, &low, &high); + stride.kind = PROP_CONST; + stride.data.const_val = 0; + + result_type = create_range_type (result_type, index_type, + &low, &high, &stride); return result_type; } @@ -1180,16 +1186,20 @@ create_array_type_with_stride (struct type *result_type, && (!type_not_associated (result_type) && !type_not_allocated (result_type))) { - LONGEST low_bound, high_bound; + LONGEST low_bound, high_bound, byte_stride; if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0) low_bound = high_bound = 0; element_type = check_typedef (element_type); + byte_stride = abs (TYPE_BYTE_STRIDE (range_type)); + /* Be careful when setting the array length. Ada arrays can be empty arrays with the high_bound being smaller than the low_bound. In such cases, the array length should be zero. */ if (high_bound < low_bound) TYPE_LENGTH (result_type) = 0; + else if (byte_stride > 0) + TYPE_LENGTH (result_type) = byte_stride * (high_bound - low_bound + 1); else if (bit_stride > 0) TYPE_LENGTH (result_type) = (bit_stride * (high_bound - low_bound + 1) + 7) / 8; @@ -1990,7 +2000,7 @@ resolve_dynamic_range (struct type *dyn_range_type, CORE_ADDR value; struct type *static_range_type, *static_target_type; const struct dynamic_prop *prop; - struct dynamic_prop low_bound, high_bound; + struct dynamic_prop low_bound, high_bound, stride; gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE); @@ -2022,12 +2032,19 @@ resolve_dynamic_range (struct type *dyn_range_type, high_bound.data.const_val = 0; } + prop = &TYPE_RANGE_DATA (dyn_range_type)->stride; + if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1)) + { + stride.kind = PROP_CONST; + stride.data.const_val = value; + } + static_target_type = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type), addr_stack, 0); static_range_type = create_range_type (copy_type (dyn_range_type), static_target_type, - &low_bound, &high_bound); + &low_bound, &high_bound, &stride); TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1; return static_range_type; } diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h index a115857c0a..738b88d762 100644 --- a/gdb/gdbtypes.h +++ b/gdb/gdbtypes.h @@ -613,6 +613,10 @@ struct range_bounds struct dynamic_prop high; + /* * Stride of range. */ + + struct dynamic_prop stride; + /* True if HIGH range bound contains the number of elements in the subrange. This affects how the final hight bound is computed. */ @@ -1330,6 +1334,14 @@ extern bool set_type_align (struct type *, ULONGEST); TYPE_RANGE_DATA(range_type)->high.kind #define TYPE_LOW_BOUND_KIND(range_type) \ TYPE_RANGE_DATA(range_type)->low.kind +#define TYPE_BYTE_STRIDE(range_type) \ + TYPE_RANGE_DATA(range_type)->stride.data.const_val +#define TYPE_BYTE_STRIDE_BLOCK(range_type) \ + TYPE_RANGE_DATA(range_type)->stride.data.locexpr +#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \ + TYPE_RANGE_DATA(range_type)->stride.data.loclist +#define TYPE_BYTE_STRIDE_KIND(range_type) \ + TYPE_RANGE_DATA(range_type)->stride.kind /* Property accessors for the type data location. */ #define TYPE_DATA_LOCATION(thistype) \ @@ -1364,6 +1376,8 @@ extern bool set_type_align (struct type *, ULONGEST); TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype)) #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \ TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype)) +#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \ + (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0) #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \ (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype)))) @@ -1899,6 +1913,7 @@ extern struct type *create_array_type_with_stride struct dynamic_prop *, unsigned int); extern struct type *create_range_type (struct type *, struct type *, + const struct dynamic_prop *, const struct dynamic_prop *, const struct dynamic_prop *); diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp new file mode 100644 index 0000000000..ed732da4ed --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-stride.exp @@ -0,0 +1,44 @@ +# Copyright 2018 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 +} + +gdb_breakpoint [gdb_get_line_number "re-reverse-elements"] +gdb_continue_to_breakpoint "re-reverse-elements" +gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \ + "print re-reverse-elements" +gdb_test "print pvla(1)" " = 1" "print first re-reverse-element" +gdb_test "print pvla(10)" " = 10" "print last re-reverse-element" + +gdb_breakpoint [gdb_get_line_number "odd-elements"] +gdb_continue_to_breakpoint "odd-elements" +gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements" +gdb_test "print pvla(1)" " = 1" "print first odd-element" +gdb_test "print pvla(5)" " = 9" "print last odd-element" + +gdb_breakpoint [gdb_get_line_number "single-element"] +gdb_continue_to_breakpoint "single-element" +gdb_test "print pvla" " = \\\(5\\\)" "print single-element" +gdb_test "print pvla(1)" " = 5" "print one single-element" diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90 new file mode 100644 index 0000000000..51d56e27cb --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-stride.f90 @@ -0,0 +1,29 @@ +! Copyright 2018 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_stride + integer, target, allocatable :: vla (:) + integer, pointer :: pvla (:) + + allocate(vla(10)) + vla = (/ (I, I = 1,10) /) + + pvla => vla(10:1:-1) + pvla => pvla(10:1:-1) + pvla => vla(1:10:2) ! re-reverse-elements + pvla => vla(5:4:-2) ! odd-elements + + pvla => null() ! single-element +end program vla_stride diff --git a/gdb/valarith.c b/gdb/valarith.c index 807cdd5dbd..26cd17cc46 100644 --- a/gdb/valarith.c +++ b/gdb/valarith.c @@ -187,11 +187,17 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound) struct type *array_type = check_typedef (value_type (array)); struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type)); ULONGEST elt_size = type_length_units (elt_type); - ULONGEST elt_offs = elt_size * (index - lowerbound); + LONGEST elt_offs = index - lowerbound; + LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type)); + + if (elt_stride != 0) + elt_offs *= elt_stride; + else + elt_offs *= elt_size; if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) - && elt_offs >= type_length_units (array_type)) + && abs (elt_offs) >= type_length_units (array_type)) || (VALUE_LVAL (array) != lval_memory && TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type))) {