From patchwork Mon Sep 11 12:57:43 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: "Wiederhake, Tim" X-Patchwork-Id: 22827 Received: (qmail 122793 invoked by alias); 11 Sep 2017 12:58:04 -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 122487 invoked by uid 89); 11 Sep 2017 12:58:04 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-25.6 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_LAZY_DOMAIN_SECURITY, RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy=5078, 40026, 954 X-HELO: mga04.intel.com Received: from mga04.intel.com (HELO mga04.intel.com) (192.55.52.120) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 11 Sep 2017 12:58:01 +0000 Received: from fmsmga006.fm.intel.com ([10.253.24.20]) by fmsmga104.fm.intel.com with ESMTP/TLS/DHE-RSA-AES256-GCM-SHA384; 11 Sep 2017 05:57:56 -0700 X-ExtLoop1: 1 Received: from irvmail001.ir.intel.com ([163.33.26.43]) by fmsmga006.fm.intel.com with ESMTP; 11 Sep 2017 05:57:55 -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 v8BCvtOk016540; Mon, 11 Sep 2017 13:57:55 +0100 Received: from ulvlx001.iul.intel.com (localhost [127.0.0.1]) by ulvlx001.iul.intel.com with ESMTP id v8BCvsIb029674; Mon, 11 Sep 2017 14:57:54 +0200 Received: (from twiederh@localhost) by ulvlx001.iul.intel.com with LOCAL id v8BCvswI029670; Mon, 11 Sep 2017 14:57:54 +0200 From: Tim Wiederhake To: gdb-patches@sourceware.org Cc: Christoph Weinmann Subject: [PATCH 5/5] Fortran: Enable parsing of stride parameter for subranges. Date: Mon, 11 Sep 2017 14:57:43 +0200 Message-Id: <1505134663-29374-6-git-send-email-tim.wiederhake@intel.com> In-Reply-To: <1505134663-29374-1-git-send-email-tim.wiederhake@intel.com> References: <1505134663-29374-1-git-send-email-tim.wiederhake@intel.com> X-IsSubscribed: yes From: Christoph Weinmann Allow the user to provide a stride parameter for Fortran subarrays. The stride parameter can be any integer except '0'. The default stride value is '1'. xxxx-yy-zz Christoph Weinmann Tim Wiederhake gdb/ChangeLog: * expression.h (enum range_type): Add stride flag. * f-exp.y (subrange): Parse stride values. * f-lang.c (f90_value_slice, f90_value_subarray): Allow strides != 1. * parse.c (operator_length_standard): Parse stride values. gdb/testsuite/ChangeLog: * gdb.fortran/static-arrays.exp: Add tests for strides. * gdb.fortran/static-arrays.f90: Same. --- gdb/expression.h | 8 +-- gdb/f-exp.y | 29 +++++++++++ gdb/f-lang.c | 76 +++++++++++++++++++---------- gdb/parse.c | 3 ++ gdb/testsuite/gdb.fortran/static-arrays.exp | 34 ++++++++++--- gdb/testsuite/gdb.fortran/static-arrays.f90 | 9 ++++ 6 files changed, 124 insertions(+), 35 deletions(-) diff --git a/gdb/expression.h b/gdb/expression.h index c794198..d1cfe70 100644 --- a/gdb/expression.h +++ b/gdb/expression.h @@ -155,14 +155,16 @@ extern void dump_raw_expression (struct expression *, struct ui_file *, const char *); extern void dump_prefix_expression (struct expression *, struct ui_file *); -/* Flags to indicate which boundarys are set in an OP_RANGE expression. Values - can be or'ed together. */ +/* Flags to indicate which boundaries are set in an OP_RANGE expression. + Additionally, the user can specify a stride. Values can be or'ed + together. */ enum range_type { SUBARRAY_NO_BOUND = 0x0, /* "( : )" */ SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" */ - SUBARRAY_HIGH_BOUND = 0x2 /* "(:high)" */ + SUBARRAY_HIGH_BOUND = 0x2, /* "(:high)" */ + SUBARRAY_STRIDE = 0x4 /* "(::stride)" */ }; #endif /* !defined (EXPRESSION_H) */ diff --git a/gdb/f-exp.y b/gdb/f-exp.y index 96b9b05..2c0a3d0 100644 --- a/gdb/f-exp.y +++ b/gdb/f-exp.y @@ -285,6 +285,35 @@ subrange: ':' %prec ABOVE_COMMA write_exp_elt_opcode (pstate, OP_RANGE); } ; +/* Each subrange type can have a stride argument. */ +subrange: exp ':' exp ':' exp %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_RANGE); + write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND + | SUBARRAY_HIGH_BOUND + | SUBARRAY_STRIDE); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + +subrange: exp ':' ':' exp %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_RANGE); + write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND + | SUBARRAY_STRIDE); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + +subrange: ':' exp ':' exp %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_RANGE); + write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND + | SUBARRAY_STRIDE); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + +subrange: ':' ':' exp %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_RANGE); + write_exp_elt_longcst (pstate, SUBARRAY_STRIDE); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + complexnum: exp ',' exp { } ; diff --git a/gdb/f-lang.c b/gdb/f-lang.c index 832a3e7..8064adb 100644 --- a/gdb/f-lang.c +++ b/gdb/f-lang.c @@ -392,7 +392,7 @@ f77_get_array_dims (const struct type *array_type) /* F90_VALUE_SLICE is called for each array dimension to calculate the number of elements as defined by the subscript expression - array(SLICE_LOW : SLICE_LOW + SLICE_LEN). + array(SLICE_LOW : SLICE_LOW + SLICE_LEN : SLICE_STRIDE). MULTI_DIM is used to determine if we are working on a one-dimensional or multi-dimensional array. The latter case happens in all slicing operations following the first subscript that is a range, as a range subscript does not @@ -400,20 +400,26 @@ f77_get_array_dims (const struct type *array_type) static struct value * f90_value_slice (struct value *src_array, LONGEST slice_low, LONGEST slice_len, - bool multi_dim) + LONGEST slice_stride, bool multi_dim) { - /* If the array is not multidimensional, we use the generic code path to - generate the slice. */ - if (!multi_dim) + /* If the array is not multidimensional and the stride is one, we can use + generic code to generate the slice. */ + if (!multi_dim && slice_stride == 1) return value_slice (src_array, slice_low, slice_len); + gdb_assert (slice_stride != 0); + type *const src_ary_type = check_typedef (value_type (src_array)); type *const src_row_type = check_typedef (TYPE_TARGET_TYPE (src_ary_type)); - type *const src_elm_type = check_typedef (TYPE_TARGET_TYPE (src_row_type)); - type *const src_idx_type = check_typedef (TYPE_INDEX_TYPE (src_row_type)); + type *const src_tgt_type = multi_dim ? src_row_type : src_ary_type; + type *const src_elm_type = check_typedef (TYPE_TARGET_TYPE (src_tgt_type)); + type *const src_idx_type = check_typedef (TYPE_INDEX_TYPE (src_tgt_type)); + const LONGEST num_elements = ((slice_len - 1) / slice_stride) + 1; const LONGEST slice_offset = slice_low - TYPE_LOW_BOUND (src_idx_type); const LONGEST row_count - = TYPE_LENGTH (src_ary_type) / TYPE_LENGTH (src_row_type); + = TYPE_LENGTH (src_ary_type) / TYPE_LENGTH (src_tgt_type); + + gdb_assert (num_elements >= 0); /* FIXME-type-allocation: need a way to free this type when we are done with it. */ @@ -421,25 +427,28 @@ f90_value_slice (struct value *src_array, LONGEST slice_low, LONGEST slice_len, = create_static_range_type (NULL, TYPE_TARGET_TYPE (src_idx_type), TYPE_LOW_BOUND (src_idx_type), TYPE_LOW_BOUND (src_idx_type) - + slice_len * row_count - 1); + + num_elements * row_count - 1); type *const dst_ary_type - = create_array_type (NULL, TYPE_TARGET_TYPE (src_row_type), dst_rng_type); + = create_array_type (NULL, TYPE_TARGET_TYPE (src_tgt_type), dst_rng_type); - TYPE_CODE (dst_ary_type) = TYPE_CODE (src_row_type); + TYPE_CODE (dst_ary_type) = TYPE_CODE (src_tgt_type); value *const dst_array = allocate_value (dst_ary_type); for (LONGEST i = 0; i < row_count; ++i) - { - const LONGEST dst_offset = TYPE_LENGTH (src_elm_type) * i * slice_len; + for (LONGEST j = 0; j < num_elements; ++j) + { + const LONGEST dst_offset + = TYPE_LENGTH (src_elm_type) * (j + i * num_elements); - const LONGEST src_offset - = TYPE_LENGTH (src_row_type) * i - + TYPE_LENGTH (src_elm_type) * slice_offset; + const LONGEST src_offset + = TYPE_LENGTH (src_row_type) * i + + TYPE_LENGTH (src_elm_type) * j * slice_stride + + TYPE_LENGTH (src_elm_type) * slice_offset; - value_contents_copy (dst_array, dst_offset, src_array, src_offset, - TYPE_LENGTH (src_elm_type) * slice_len); - } + value_contents_copy (dst_array, dst_offset, src_array, src_offset, + TYPE_LENGTH (src_elm_type)); + } const LONGEST offset = TYPE_LENGTH (src_row_type) * row_count @@ -476,13 +485,15 @@ f90_value_subarray (struct value *array, struct expression *exp, int *pos, int type; LONGEST low; LONGEST high; + LONGEST stride; }; }; subscript (LONGEST index_) : kind (SUBSCRIPT_INDEX), index (index_) {} - subscript (int type_, LONGEST low_, LONGEST high_) : - kind (SUBSCRIPT_RANGE), type (type_), low (low_), high (high_) {} + subscript (int type_, LONGEST low_, LONGEST high_, LONGEST stride_) : + kind (SUBSCRIPT_RANGE), type (type_), low (low_), high (high_), + stride (stride_) {} }; if (nargs != f77_get_array_dims (value_type (array))) @@ -500,6 +511,7 @@ f90_value_subarray (struct value *array, struct expression *exp, int *pos, const int type = longest_to_int (exp->elts[*pos + 1].longconst); LONGEST lo = 0; LONGEST hi = 0; + LONGEST stride = 1; *pos += 3; @@ -507,8 +519,11 @@ f90_value_subarray (struct value *array, struct expression *exp, int *pos, lo = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); if ((type & SUBARRAY_HIGH_BOUND) != 0) hi = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); + if ((type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE) + stride = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, + noside)); - subscript_array.emplace_back (type, lo, hi); + subscript_array.emplace_back (type, lo, hi, stride); } else { @@ -538,15 +553,22 @@ f90_value_subarray (struct value *array, struct expression *exp, int *pos, if ((it->type & SUBARRAY_HIGH_BOUND) == 0) it->high = hi; + if (it->stride == 0) + error (_("Stride must not be 0.")); + if (it->low < lo || it->low > hi || it->high < lo || it->high > hi) error (_("slice out of range")); - if (it->high - it->low + 1 < 0) + /* For a negative stride the lower boundary must be greater than the + upper boundary. For a positive stride the lower boundary must be + less than the upper boundary. */ + if ((it->stride < 0 && (it->low - it->high - 1 < 0)) + || (it->stride > 0 && (it->high - it->low + 1 < 0))) error (_("slice out of range")); new_array = f90_value_slice (new_array, it->low, it->high - it->low + 1, - multi_dim); + it->stride, multi_dim); /* A range subscript does not decrease the number of dimensions in array. Therefore we cannot use VALUE_SUBSCRIPTED_RVALUE anymore @@ -566,7 +588,7 @@ f90_value_subarray (struct value *array, struct expression *exp, int *pos, if (it->index < lo || it->index > hi) error (_("no such vector element")); - new_array = f90_value_slice (new_array, it->index, 1, multi_dim); + new_array = f90_value_slice (new_array, it->index, 1, 1, multi_dim); } } @@ -584,7 +606,9 @@ f90_value_subarray (struct value *array, struct expression *exp, int *pos, continue; type *const range_type = - create_static_range_type (NULL, elt_type, s.low, s.high); + create_static_range_type (NULL, elt_type, s.low, + s.low + ((s.high - s.low) / s.stride)); + type *const interim_array_type = create_array_type (NULL, elt_type, range_type); diff --git a/gdb/parse.c b/gdb/parse.c index dcf1b31..2a774ce 100644 --- a/gdb/parse.c +++ b/gdb/parse.c @@ -1013,6 +1013,9 @@ operator_length_standard (const struct expression *expr, int endpos, if ((range_type & SUBARRAY_HIGH_BOUND) != 0) args++; + if ((range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE) + args++; + break; default: diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp index 0a9f1ab..660173a 100644 --- a/gdb/testsuite/gdb.fortran/static-arrays.exp +++ b/gdb/testsuite/gdb.fortran/static-arrays.exp @@ -250,12 +250,17 @@ gdb_test "p ar4\( 1 \)" " = 1" gdb_test "p ar4\( 4 \)" " = 4" -# Check assignment -gdb_test_no_output "set \$my_ary = ar1\(2:4\)" -gdb_test "p \$my_ary" " = \\(2, 3, 4\\)" "p my_ary one" -gdb_test_no_output "set ar1\(2\) = 1" -gdb_test "p ar1\(2:4\)" " = \\(1, 3, 4\\)" -gdb_test "p \$my_ary" " = \\(2, 3, 4\\)" "p my_ary two" +# Check strides +gdb_test "p ar5(1:6: 3, 1, -6)" " = \\(200, 500\\)" +gdb_test "p ar5(1:7: 3, 1, -6)" " = \\(200, 500, 800\\)" +gdb_test "p ar5(6:1:-3, 1, -6)" " = \\(700, 400\\)" +gdb_test "p ar5(7:1:-3, 1, -6)" " = \\(800, 500, 200\\)" +gdb_test "p ar5(1, 1, -6:-12:-3)" " = \\(200, 197, 194\\)" +gdb_test "p ar5(1, 1, -6:-11:-3)" " = \\(200, 197\\)" +gdb_test "p ar5(1, 1, -12: -6: 3)" " = \\(194, 197, 200\\)" +gdb_test "p ar5(1, 1, -11: -6: 3)" " = \\(195, 198\\)" + +gdb_test "p ar5\(9:2:-2, -6:2:3, -6:-15:-3\)" " = \\(\\( \\( 930, 730, 530, 330\\) \\( 960, 760, 560, 360\\) \\( 990, 790, 590, 390\\) \\) \\( \\( 927, 727, 527, 327\\) \\( 957, 757, 557, 357\\) \\( 987, 787, 587, 387\\) \\) \\( \\( 924, 724, 524, 324\\) \\( 954, 754, 554, 354\\) \\( 984, 784, 584, 384\\) \\) \\( \\( 921, 721, 521, 321\\) \\( 951, 751, 551, 351\\) \\( 981, 781, 581, 381\\) \\) \\)" # Corner cases and error messages @@ -273,3 +278,20 @@ gdb_test "p ar2\(3:1, :\)" "slice out of range" gdb_test "p ar4\(-3:-3\)" " = \\(-3\\)" gdb_test "p ar4\(-2:-3\)" " = \\(\\)" gdb_test "p ar4\( 1:-1\)" "slice out of range" + +gdb_test "p ar1\(1:3:\)" "A syntax error in expression, near `\\)'." +gdb_test "p ar1\(1:3:0\)" "Stride must not be 0." +gdb_test "p ar1\(3:1:2\)" "slice out of range" +gdb_test "p ar1\(1:3:-2\)" "slice out of range" +gdb_test "p ar5(1:7:-3, 1, -6)" "slice out of range" +gdb_test "p ar5(7:1: 3, 1, -6)" "slice out of range" +gdb_test "p ar5(1,1,-6:-14: 3)" "slice out of range" +gdb_test "p ar5(1,1,-14:-6:-3)" "slice out of range" + + +# Check assignment +gdb_test_no_output "set \$my_ary = ar1\(2:4\)" +gdb_test "p \$my_ary" " = \\(2, 3, 4\\)" "p my_ary one" +gdb_test_no_output "set ar1\(2\) = 1" +gdb_test "p ar1\(2:4\)" " = \\(1, 3, 4\\)" +gdb_test "p \$my_ary" " = \\(2, 3, 4\\)" "p my_ary two" diff --git a/gdb/testsuite/gdb.fortran/static-arrays.f90 b/gdb/testsuite/gdb.fortran/static-arrays.f90 index a4606b2..9186e23 100644 --- a/gdb/testsuite/gdb.fortran/static-arrays.f90 +++ b/gdb/testsuite/gdb.fortran/static-arrays.f90 @@ -18,6 +18,7 @@ subroutine sub integer, dimension(4,4) :: ar2 integer, dimension(4,4,4) :: ar3 integer, dimension(-4:4) :: ar4 + integer, dimension(10,-7:3, -15:-5) :: ar5 integer :: i,j,k ! Resulting array ar3 looks like ((( 111, 112, 113, 114,...))) @@ -35,6 +36,14 @@ subroutine sub ar4(i) = i end do + do i = 1, 10, 1 + do j = -7, 3, 1 + do k = -15, -5, 1 + ar5(i,j,k) = i*100 + (j+8)*10 + (k+16) + end do + end do + end do + ar1(1) = 11 !BP1 return end