From 046f33b5893ab417d7973e33216826794e3a0c6e Mon Sep 17 00:00:00 2001 From: Jan Kratochvil Date: Sat, 9 Jan 2016 11:58:30 +0100 Subject: [PATCH] VLA (Fortran dynamic arrays) strides (multi-dimensional subarrays) from Intel. --- gdb-fortran-stride-intel-1of6.patch | 611 ++++++++++++++++++ gdb-fortran-stride-intel-2of6.patch | 45 ++ gdb-fortran-stride-intel-3of6.patch | 162 +++++ gdb-fortran-stride-intel-4of6.patch | 142 ++++ gdb-fortran-stride-intel-5of6.patch | 402 ++++++++++++ gdb-fortran-stride-intel-6of6-nokfail.patch | 36 ++ ...ortran-stride-intel-6of6-testcasefix.patch | 52 ++ gdb-fortran-stride-intel-6of6.patch | 474 ++++++++++++++ gdb-vla-intel.patch | 18 - gdb.spec | 21 +- 10 files changed, 1944 insertions(+), 19 deletions(-) create mode 100644 gdb-fortran-stride-intel-1of6.patch create mode 100644 gdb-fortran-stride-intel-2of6.patch create mode 100644 gdb-fortran-stride-intel-3of6.patch create mode 100644 gdb-fortran-stride-intel-4of6.patch create mode 100644 gdb-fortran-stride-intel-5of6.patch create mode 100644 gdb-fortran-stride-intel-6of6-nokfail.patch create mode 100644 gdb-fortran-stride-intel-6of6-testcasefix.patch create mode 100644 gdb-fortran-stride-intel-6of6.patch diff --git a/gdb-fortran-stride-intel-1of6.patch b/gdb-fortran-stride-intel-1of6.patch new file mode 100644 index 0000000..f17c83a --- /dev/null +++ b/gdb-fortran-stride-intel-1of6.patch @@ -0,0 +1,611 @@ +From: Christoph Weinmann +[PATCH 1/6] fortran: allow multi-dimensional subarrays +https://sourceware.org/ml/gdb-patches/2015-12/msg00007.html +Message-Id: <1448976075-11456-2-git-send-email-christoph.t.weinmann@intel.com> + +Add an argument count for subrange expressions in Fortran. +Based on the counted value calculate a new array with the +elements specified by the user. First parse the user input, +secondly copy the desired array values into the return +array, thirdly re-create the necessary ranges and bounds. + +1| program prog +2| integer :: ary(10,5) = (/ (i,i=1,10) (j, j=1,5) /) +3| end program prog + +(gdb) print ary(2:4,1:3) +old> Syntax error in expression near ':3' +new> $3 = ( ( 21, 31, 41) ( 22, 32, 42) ( 23, 33, 43) ) + +2013-11-25 Christoph Weinmann + + * eval.c (multi_f77_subscript): Remove function. + * eval.c (evaluate_subrange_expr): When evaluating + an array or string expression, call + value_f90_subarray. + * eval.c (value_f90_subarray): Add argument parsing + and compute result array based on user input. + * f-exp.y: Increment argument counter for every subrange + expression entered by the user. + * valops.c (value_slice): Call value_slice_1 with + additional default argument. + * valops.c (value_slice_1): Add functionality to + copy and return result values based on input. + * value.h: Add function definition. + + + +Signed-off-by: Christoph Weinmann +--- + gdb/eval.c | 309 ++++++++++++++++++++++++++++++++++++++++++++++------------ + gdb/f-exp.y | 2 + + gdb/valops.c | 157 ++++++++++++++++++++++++------ + gdb/value.h | 2 + + 4 files changed, 375 insertions(+), 95 deletions(-) + +diff --git a/gdb/eval.c b/gdb/eval.c +index 84e2e34..2ceccbc 100644 +--- a/gdb/eval.c ++++ b/gdb/eval.c +@@ -399,29 +399,253 @@ init_array_element (struct value *array, struct value *element, + return index; + } + ++/* Evaluates any operation on Fortran arrays or strings with at least ++ one user provided parameter. Expects the input ARRAY to be either ++ an array, or a string. Evaluates EXP by incrementing POS, and ++ writes the content from the elt stack into a local struct. NARGS ++ specifies number of literal or range arguments the user provided. ++ NARGS must be the same number as ARRAY has dimensions. */ ++ + static struct value * +-value_f90_subarray (struct value *array, +- struct expression *exp, int *pos, enum noside noside) ++value_f90_subarray (struct value *array, struct expression *exp, ++ int *pos, int nargs, enum noside noside) + { +- int pc = (*pos) + 1; ++ int i, dim_count = 0; + LONGEST low_bound, high_bound; + struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array))); +- enum f90_range_type range_type +- = (enum f90_range_type) longest_to_int (exp->elts[pc].longconst); +- +- *pos += 3; ++ struct value *new_array = array; ++ struct type *array_type = check_typedef (value_type (new_array)); ++ struct type *temp_type; ++ ++ /* Local struct to hold user data for Fortran subarray dimensions. */ ++ struct subscript_store ++ { ++ /* For every dimension, we are either working on a range or an index ++ expression, so we store this info separately for later. */ ++ enum ++ { ++ SUBSCRIPT_RANGE, /* e.g. "(lowbound:highbound)" */ ++ SUBSCRIPT_INDEX /* e.g. "(literal)" */ ++ } kind; ++ ++ /* We also store either the lower and upper bound info, or the index ++ number. Before evaluation of the input values, we do not know if we are ++ actually working on a range of ranges, or an index in a range. So as a ++ first step we store all input in a union. The array calculation itself ++ deals with this later on. */ ++ union ++ { ++ struct subscript_range ++ { ++ enum f90_range_type f90_range_type; ++ LONGEST low, high; ++ } ++ range; ++ LONGEST number; ++ }; ++ } *subscript_array; ++ ++ /* Check if the number of arguments provided by the user matches ++ the number of dimension of the array. A string has only one ++ dimension. */ ++ if (nargs != calc_f77_array_dims (value_type (new_array))) ++ error (_("Wrong number of subscripts")); ++ ++ subscript_array = alloca (sizeof (*subscript_array) * nargs); ++ ++ /* Parse the user input into the SUBSCRIPT_ARRAY to store it. We need ++ to evaluate it first, as the input is from left-to-right. The ++ array is stored from right-to-left. So we have to use the user ++ input in reverse order. Later on, we need the input information to ++ re-calculate the output array. For multi-dimensional arrays, we ++ can be dealing with any possible combination of ranges and indices ++ for every dimension. */ ++ for (i = 0; i < nargs; i++) ++ { ++ struct subscript_store *index = &subscript_array[i]; + +- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) +- low_bound = TYPE_LOW_BOUND (range); +- else +- low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); ++ /* The user input is a range, with or without lower and upper bound. ++ E.g.: "p arry(2:5)", "p arry( :5)", "p arry( : )", etc. */ ++ if (exp->elts[*pos].opcode == OP_F90_RANGE) ++ { ++ int pc = (*pos) + 1; ++ struct subscript_range *range; ++ ++ index->kind = SUBSCRIPT_RANGE; ++ range = &index->range; ++ ++ *pos += 3; ++ range->f90_range_type = longest_to_int (exp->elts[pc].longconst); ++ ++ /* If a lower bound was provided by the user, the bit has been ++ set and we can assign the value from the elt stack. Same for ++ upper bound. */ ++ if ((range->f90_range_type == HIGH_BOUND_DEFAULT) ++ || range->f90_range_type == NONE_BOUND_DEFAULT) ++ range->low = value_as_long (evaluate_subexp (NULL_TYPE, exp, ++ pos, noside)); ++ if ((range->f90_range_type == LOW_BOUND_DEFAULT) ++ || range->f90_range_type == NONE_BOUND_DEFAULT) ++ range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp, ++ pos, noside)); ++ } ++ /* User input is an index. E.g.: "p arry(5)". */ ++ else ++ { ++ struct value *val; + +- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) +- high_bound = TYPE_HIGH_BOUND (range); +- else +- high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); ++ index->kind = SUBSCRIPT_INDEX; ++ ++ /* Evaluate each subscript; it must be a legal integer in F77. This ++ ensures the validity of the provided index. */ ++ val = evaluate_subexp_with_coercion (exp, pos, noside); ++ index->number = value_as_long (val); ++ } ++ ++ } ++ ++ /* Traverse the array from right to left and evaluate each corresponding ++ user input. VALUE_SUBSCRIPT is called for every index, until a range ++ expression is evaluated. After a range expression has been evaluated, ++ every subsequent expression is also treated as a range. */ ++ for (i = nargs - 1; i >= 0; i--) ++ { ++ struct subscript_store *index = &subscript_array[i]; ++ struct type *index_type = TYPE_INDEX_TYPE (array_type); ++ ++ switch (index->kind) ++ { ++ case SUBSCRIPT_RANGE: ++ { ++ ++ /* When we hit the first range specified by the user, we must ++ treat any subsequent user entry as a range. We simply ++ increment DIM_COUNT which tells us how many times we are ++ calling VALUE_SLICE_1. */ ++ struct subscript_range *range = &index->range; ++ ++ /* If no lower bound was provided by the user, we take the ++ default boundary. Same for the high bound. */ ++ if ((range->f90_range_type == LOW_BOUND_DEFAULT) ++ || (range->f90_range_type == BOTH_BOUND_DEFAULT)) ++ range->low = TYPE_LOW_BOUND (index_type); ++ ++ if ((range->f90_range_type == HIGH_BOUND_DEFAULT) ++ || (range->f90_range_type == BOTH_BOUND_DEFAULT)) ++ range->high = TYPE_HIGH_BOUND (index_type); ++ ++ /* Both user provided low and high bound have to be inside the ++ array bounds. Throw an error if not. */ ++ if (range->low < TYPE_LOW_BOUND (index_type) ++ || range->low > TYPE_HIGH_BOUND (index_type) ++ || range->high < TYPE_LOW_BOUND (index_type) ++ || range->high > TYPE_HIGH_BOUND (index_type)) ++ error (_("provided bound(s) outside array bound(s)")); ++ ++ /* DIM_COUNT counts every user argument that is treated as a range. ++ This is necessary for expressions like 'print array(7, 8:9). ++ Here the first argument is a literal, but must be treated as a ++ range argument to allow the correct output representation. */ ++ dim_count++; ++ ++ new_array ++ = value_slice_1 (new_array, ++ longest_to_int (range->low), ++ longest_to_int (range->high - range->low + 1), ++ dim_count); ++ } ++ break; ++ ++ case SUBSCRIPT_INDEX: ++ { ++ /* DIM_COUNT only stays '0' when no range argument was processed ++ before, starting from the last dimension. This way we can ++ reduce the number of dimensions from the result array. ++ However, if a range has been processed before an index, we ++ treat the index like a range with equal low- and high bounds ++ to get the value offset right. */ ++ if (dim_count == 0) ++ new_array ++ = value_subscripted_rvalue (new_array, index->number, ++ f77_get_lowerbound (value_type ++ (new_array))); ++ else ++ { ++ /* Check for valid index input. */ ++ if (index->number < TYPE_LOW_BOUND (index_type) ++ || index->number > TYPE_HIGH_BOUND (index_type)) ++ error (_("error no such vector element")); ++ ++ dim_count++; ++ new_array = value_slice_1 (new_array, ++ longest_to_int (index->number), ++ 1, /* length is '1' element */ ++ dim_count); ++ } ++ ++ } ++ break; ++ } ++ } ++ ++ /* With DIM_COUNT > 1 we currently have a one dimensional array, but expect ++ an array of arrays, depending on how many ranges have been provided by ++ the user. So we need to rebuild the array dimensions for printing it ++ correctly. ++ Starting from right to left in the user input, after we hit the first ++ range argument every subsequent argument is also treated as a range. ++ E.g.: ++ "p ary(3, 7, 2:15)" in Fortran has only 1 dimension, but we calculated 3 ++ ranges. ++ "p ary(3, 7:12, 4)" in Fortran has only 1 dimension, but we calculated 2 ++ ranges. ++ "p ary(2:4, 5, 7)" in Fortran has only 1 dimension, and we calculated 1 ++ range. */ ++ if (dim_count > 1) ++ { ++ struct value *v = NULL; + +- return value_slice (array, low_bound, high_bound - low_bound + 1); ++ temp_type = TYPE_TARGET_TYPE (value_type (new_array)); ++ ++ /* Every SUBSCRIPT_RANGE in the user input signifies an actual range in ++ the output array. So we traverse the SUBSCRIPT_ARRAY again, looking ++ for a range entry. When we find one, we use the range info to create ++ an additional range_type to set the correct bounds and dimensions for ++ the output array. */ ++ for (i = 0; i < nargs; i++) ++ { ++ struct subscript_store *index = &subscript_array[i]; ++ ++ if (index->kind == SUBSCRIPT_RANGE) ++ { ++ struct type *range_type, *interim_array_type; ++ ++ range_type ++ = create_static_range_type (NULL, ++ temp_type, ++ 1, ++ index->range.high - index->range.low + 1); ++ ++ interim_array_type = create_array_type (NULL, ++ temp_type, ++ range_type); ++ ++ /* For some reason the type code of the contents is missing, so ++ reset it from the original array. */ ++ TYPE_CODE (interim_array_type) ++ = TYPE_CODE (value_type (new_array)); ++ ++ v = allocate_value (interim_array_type); ++ ++ temp_type = value_type (v); ++ } ++ ++ } ++ value_contents_copy (v, 0, new_array, 0, TYPE_LENGTH (temp_type)); ++ return v; ++ } ++ ++ return new_array; + } + + +@@ -1810,14 +2034,11 @@ evaluate_subexp_standard (struct type *expect_type, + switch (code) + { + case TYPE_CODE_ARRAY: +- if (exp->elts[*pos].opcode == OP_F90_RANGE) +- return value_f90_subarray (arg1, exp, pos, noside); +- else +- goto multi_f77_subscript; ++ return value_f90_subarray (arg1, exp, pos, nargs, noside); + + case TYPE_CODE_STRING: + if (exp->elts[*pos].opcode == OP_F90_RANGE) +- return value_f90_subarray (arg1, exp, pos, noside); ++ return value_f90_subarray (arg1, exp, pos, 1, noside); + else + { + arg2 = evaluate_subexp_with_coercion (exp, pos, noside); +@@ -2222,49 +2443,6 @@ evaluate_subexp_standard (struct type *expect_type, + } + return (arg1); + +- multi_f77_subscript: +- { +- LONGEST subscript_array[MAX_FORTRAN_DIMS]; +- int ndimensions = 1, i; +- struct value *array = arg1; +- +- if (nargs > MAX_FORTRAN_DIMS) +- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); +- +- ndimensions = calc_f77_array_dims (type); +- +- if (nargs != ndimensions) +- error (_("Wrong number of subscripts")); +- +- gdb_assert (nargs > 0); +- +- /* Now that we know we have a legal array subscript expression +- let us actually find out where this element exists in the array. */ +- +- /* Take array indices left to right. */ +- for (i = 0; i < nargs; i++) +- { +- /* Evaluate each subscript; it must be a legal integer in F77. */ +- arg2 = evaluate_subexp_with_coercion (exp, pos, noside); +- +- /* Fill in the subscript array. */ +- +- subscript_array[i] = value_as_long (arg2); +- } +- +- /* Internal type of array is arranged right to left. */ +- for (i = nargs; i > 0; i--) +- { +- struct type *array_type = check_typedef (value_type (array)); +- LONGEST index = subscript_array[i - 1]; +- +- array = value_subscripted_rvalue (array, index, +- f77_get_lowerbound (array_type)); +- } +- +- return array; +- } +- + case BINOP_LOGICAL_AND: + arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); + if (noside == EVAL_SKIP) +@@ -3121,6 +3299,9 @@ calc_f77_array_dims (struct type *array_type) + int ndimen = 1; + struct type *tmp_type; + ++ if (TYPE_CODE (array_type) == TYPE_CODE_STRING) ++ return 1; ++ + if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY)) + error (_("Can't get dimensions for a non-array type")); + +diff --git a/gdb/f-exp.y b/gdb/f-exp.y +index 56629dc..ab23df0 100644 +--- a/gdb/f-exp.y ++++ b/gdb/f-exp.y +@@ -308,6 +308,8 @@ arglist : subrange + + arglist : arglist ',' exp %prec ABOVE_COMMA + { arglist_len++; } ++ | arglist ',' subrange %prec ABOVE_COMMA ++ { arglist_len++; } + ; + + /* There are four sorts of subrange types in F90. */ +diff --git a/gdb/valops.c b/gdb/valops.c +index 5e5f685..f8d23fb 100644 +--- a/gdb/valops.c ++++ b/gdb/valops.c +@@ -3759,56 +3759,151 @@ value_of_this_silent (const struct language_defn *lang) + struct value * + value_slice (struct value *array, int lowbound, int length) + { ++ /* Pass unaltered arguments to VALUE_SLICE_1, plus a CALL_COUNT of '1' as we ++ are only considering the highest dimension, or we are working on a one ++ dimensional array. So we call VALUE_SLICE_1 exactly once. */ ++ return value_slice_1 (array, lowbound, length, 1); ++} ++ ++/* CALL_COUNT is used to determine if we are calling the function once, e.g. ++ we are working on the current dimension of ARRAY, or if we are calling ++ the function repeatedly. In the later case we need to take elements ++ from the TARGET_TYPE of ARRAY. ++ With a CALL_COUNT greater than 1 we calculate the offsets for every element ++ that should be in the result array. Then we fetch the contents and then ++ copy them into the result array. The result array will have one dimension ++ less than the input array, so later on we need to recreate the indices and ++ ranges in the calling function. */ ++ ++struct value * ++value_slice_1 (struct value *array, int lowbound, int length, int call_count) ++{ + struct type *slice_range_type, *slice_type, *range_type; +- LONGEST lowerbound, upperbound; +- struct value *slice; +- struct type *array_type; ++ struct type *array_type = check_typedef (value_type (array)); ++ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type)); ++ unsigned int elt_size, elt_offs; ++ LONGEST elt_stride, ary_high_bound, ary_low_bound; ++ struct value *v; ++ int slice_range_size, i = 0, row_count = 1, elem_count = 1; + +- array_type = check_typedef (value_type (array)); ++ /* Check for legacy code if we are actually dealing with an array or ++ string. */ + if (TYPE_CODE (array_type) != TYPE_CODE_ARRAY + && TYPE_CODE (array_type) != TYPE_CODE_STRING) + error (_("cannot take slice of non-array")); + +- range_type = TYPE_INDEX_TYPE (array_type); +- if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0) +- error (_("slice from bad array or bitstring")); ++ ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (array_type)); ++ ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (array_type)); ++ ++ /* When we are working on a multi-dimensional array, we need to get the ++ attributes of the underlying type. */ ++ if (call_count > 1) ++ { ++ elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type)); ++ row_count = TYPE_LENGTH (array_type) ++ / TYPE_LENGTH (TYPE_TARGET_TYPE (array_type)); ++ } ++ ++ elem_count = length; ++ elt_size = TYPE_LENGTH (elt_type); ++ elt_offs = longest_to_int (lowbound - ary_low_bound); ++ elt_stride = TYPE_LENGTH (TYPE_INDEX_TYPE (array_type)); ++ ++ elt_offs *= elt_size; ++ ++ /* Check for valid user input. In case of Fortran this was already done ++ in the calling function. */ ++ if (call_count == 1 ++ && (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) ++ && elt_offs >= TYPE_LENGTH (array_type))) ++ error (_("no such vector element")); + +- if (lowbound < lowerbound || length < 0 +- || lowbound + length - 1 > upperbound) +- error (_("slice out of range")); ++ /* CALL_COUNT is 1 when we are dealing either with the highest dimension ++ of the array, or a one dimensional array. Set RANGE_TYPE accordingly. ++ In both cases we calculate how many rows/elements will be in the output ++ array by setting slice_range_size. */ ++ if (call_count == 1) ++ { ++ range_type = TYPE_INDEX_TYPE (array_type); ++ slice_range_size = elem_count; ++ ++ /* Check if the array bounds are valid. */ ++ if (get_discrete_bounds (range_type, &ary_low_bound, &ary_high_bound) < 0) ++ error (_("slice from bad array or bitstring")); ++ } ++ /* When CALL_COUNT is greater than 1, we are dealing with an array of arrays. ++ So we need to get the type below the current one and set the RANGE_TYPE ++ accordingly. */ ++ else ++ { ++ range_type = TYPE_INDEX_TYPE (TYPE_TARGET_TYPE (array_type)); ++ slice_range_size = (ary_low_bound + row_count - 1) * (elem_count); ++ ary_low_bound = TYPE_LOW_BOUND (range_type); ++ } + + /* FIXME-type-allocation: need a way to free this type when we are +- done with it. */ +- slice_range_type = create_static_range_type ((struct type *) NULL, +- TYPE_TARGET_TYPE (range_type), +- lowbound, +- lowbound + length - 1); ++ done with it. */ + ++ slice_range_type = create_static_range_type (NULL, TYPE_TARGET_TYPE (range_type), ++ ary_low_bound, slice_range_size); + { +- struct type *element_type = TYPE_TARGET_TYPE (array_type); +- LONGEST offset +- = (lowbound - lowerbound) * TYPE_LENGTH (check_typedef (element_type)); ++ struct type *element_type; ++ ++ /* When CALL_COUNT equals 1 we can use the legacy code for subarrays. */ ++ if (call_count == 1) ++ { ++ element_type = TYPE_TARGET_TYPE (array_type); + +- slice_type = create_array_type ((struct type *) NULL, +- element_type, +- slice_range_type); +- TYPE_CODE (slice_type) = TYPE_CODE (array_type); ++ slice_type = create_array_type (NULL, element_type, slice_range_type); ++ ++ TYPE_CODE (slice_type) = TYPE_CODE (array_type); ++ ++ if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) ++ v = allocate_value_lazy (slice_type); ++ else ++ { ++ v = allocate_value (slice_type); ++ value_contents_copy (v, ++ value_embedded_offset (v), ++ array, ++ value_embedded_offset (array) + elt_offs, ++ elt_size * longest_to_int (length)); ++ } + +- if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) +- slice = allocate_value_lazy (slice_type); ++ } ++ /* When CALL_COUNT is larger than 1 we are working on a range of ranges. ++ So we copy the relevant elements into the new array we return. */ + else + { +- slice = allocate_value (slice_type); +- value_contents_copy (slice, 0, array, offset, +- type_length_units (slice_type)); ++ LONGEST dst_offset = 0; ++ LONGEST src_row_length = TYPE_LENGTH (TYPE_TARGET_TYPE (array_type)); ++ ++ element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type)); ++ slice_type = create_array_type (NULL, element_type, slice_range_type); ++ ++ TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_type)); ++ ++ v = allocate_value (slice_type); ++ for (i = 0; i < longest_to_int (row_count); i++) ++ { ++ /* Fetches the contents of ARRAY and copies them into V. */ ++ value_contents_copy (v, ++ dst_offset, ++ array, ++ elt_offs, ++ elt_size * elem_count); ++ elt_offs += src_row_length; ++ dst_offset += elt_size * elem_count; ++ } + } + +- set_value_component_location (slice, array); +- VALUE_FRAME_ID (slice) = VALUE_FRAME_ID (array); +- set_value_offset (slice, value_offset (array) + offset); ++ set_value_component_location (v, array); ++ VALUE_REGNUM (v) = VALUE_REGNUM (array); ++ VALUE_FRAME_ID (v) = VALUE_FRAME_ID (array); ++ set_value_offset (v, value_offset (array) + elt_offs); + } + +- return slice; ++ return v; + } + + /* Create a value for a FORTRAN complex number. Currently most of the +diff --git a/gdb/value.h b/gdb/value.h +index eea0e59..05939c4 100644 +--- a/gdb/value.h ++++ b/gdb/value.h +@@ -1056,6 +1056,8 @@ extern struct value *varying_to_slice (struct value *); + + extern struct value *value_slice (struct value *, int, int); + ++extern struct value *value_slice_1 (struct value *, int, int, int); ++ + extern struct value *value_literal_complex (struct value *, struct value *, + struct type *); + +-- +1.7.0.7 diff --git a/gdb-fortran-stride-intel-2of6.patch b/gdb-fortran-stride-intel-2of6.patch new file mode 100644 index 0000000..12f7515 --- /dev/null +++ b/gdb-fortran-stride-intel-2of6.patch @@ -0,0 +1,45 @@ +From: Christoph Weinmann +[PATCH 2/6] fortran: combine subarray and string computation +https://sourceware.org/ml/gdb-patches/2015-12/msg00010.html +Message-Id: <1448976075-11456-3-git-send-email-christoph.t.weinmann@intel.com> + +Strings only have one dimension, but the element computation is +identical to the subarray computation for ranges and indices. + +2013-11-26 Christoph Weinmann + + * eval.c (evaluate_subexp_standard): Call + value_f90_subarray for print expressions on array and + string types. + + + +Signed-off-by: Christoph Weinmann +--- + gdb/eval.c | 10 +--------- + 1 files changed, 1 insertions(+), 9 deletions(-) + +diff --git a/gdb/eval.c b/gdb/eval.c +index 2ceccbc..0c1b607 100644 +--- a/gdb/eval.c ++++ b/gdb/eval.c +@@ -2034,16 +2034,8 @@ evaluate_subexp_standard (struct type *expect_type, + switch (code) + { + case TYPE_CODE_ARRAY: +- return value_f90_subarray (arg1, exp, pos, nargs, noside); +- + case TYPE_CODE_STRING: +- if (exp->elts[*pos].opcode == OP_F90_RANGE) +- return value_f90_subarray (arg1, exp, pos, 1, noside); +- else +- { +- arg2 = evaluate_subexp_with_coercion (exp, pos, noside); +- return value_subscript (arg1, value_as_long (arg2)); +- } ++ return value_f90_subarray (arg1, exp, pos, nargs, noside); + + case TYPE_CODE_PTR: + case TYPE_CODE_FUNC: +-- +1.7.0.7 diff --git a/gdb-fortran-stride-intel-3of6.patch b/gdb-fortran-stride-intel-3of6.patch new file mode 100644 index 0000000..ebe3a87 --- /dev/null +++ b/gdb-fortran-stride-intel-3of6.patch @@ -0,0 +1,162 @@ +From: Christoph Weinmann +[PATCH 3/6] fortran: change subrange enum to bit field +https://sourceware.org/ml/gdb-patches/2015-12/msg00006.html +Message-Id: <1448976075-11456-4-git-send-email-christoph.t.weinmann@intel.com> + +Change Fortran subrange enum for subrange expressions to +represent a bitfield for easier manipulation. Consequently +also change occurences and evaluation of said enum. The +behaviour of GDB is unchanged. + +2013-11-27 Christoph Weinmann + + * eval.c (value_f90_subarray): Change evaluation of the + subarray boundaries. Set boundaries to be either user + provided (bit in f90_range_type was set) or take the + default value if the boundary was not provided by the user. + * f-exp.y (subrange): Change rules for subrange expressions + to write the relevant bit sequence onto the elt stack. + * f-lang.h (f90_range_type): Change the enum to use bit + values for each boundary, if set by the user. + * parse.c (operator_length_standard): In case of + OP_F90_RANGE change the calculation of the number of + arguments on the elt stack, depending on the number of + boundaries provided by the user. + + + +Signed-off-by: Christoph Weinmann +--- + gdb/eval.c | 14 ++++++-------- + gdb/f-exp.y | 11 ++++++----- + gdb/f-lang.h | 6 ++---- + gdb/parse.c | 21 ++++++++------------- + 4 files changed, 22 insertions(+), 30 deletions(-) + +diff --git a/gdb/eval.c b/gdb/eval.c +index 0c1b607..47ba602 100644 +--- a/gdb/eval.c ++++ b/gdb/eval.c +@@ -480,12 +480,12 @@ value_f90_subarray (struct value *array, struct expression *exp, + /* If a lower bound was provided by the user, the bit has been + set and we can assign the value from the elt stack. Same for + upper bound. */ +- if ((range->f90_range_type == HIGH_BOUND_DEFAULT) +- || range->f90_range_type == NONE_BOUND_DEFAULT) ++ if ((range->f90_range_type & SUBARRAY_LOW_BOUND) ++ == SUBARRAY_LOW_BOUND) + range->low = value_as_long (evaluate_subexp (NULL_TYPE, exp, + pos, noside)); +- if ((range->f90_range_type == LOW_BOUND_DEFAULT) +- || range->f90_range_type == NONE_BOUND_DEFAULT) ++ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) ++ == SUBARRAY_HIGH_BOUND) + range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp, + pos, noside)); + } +@@ -526,12 +526,10 @@ value_f90_subarray (struct value *array, struct expression *exp, + + /* If no lower bound was provided by the user, we take the + default boundary. Same for the high bound. */ +- if ((range->f90_range_type == LOW_BOUND_DEFAULT) +- || (range->f90_range_type == BOTH_BOUND_DEFAULT)) ++ if ((range->f90_range_type & SUBARRAY_LOW_BOUND) == 0) + range->low = TYPE_LOW_BOUND (index_type); + +- if ((range->f90_range_type == HIGH_BOUND_DEFAULT) +- || (range->f90_range_type == BOTH_BOUND_DEFAULT)) ++ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) == 0) + range->high = TYPE_HIGH_BOUND (index_type); + + /* Both user provided low and high bound have to be inside the +diff --git a/gdb/f-exp.y b/gdb/f-exp.y +index ab23df0..1ff768c 100644 +--- a/gdb/f-exp.y ++++ b/gdb/f-exp.y +@@ -315,26 +315,27 @@ arglist : arglist ',' exp %prec ABOVE_COMMA + /* There are four sorts of subrange types in F90. */ + + subrange: exp ':' exp %prec ABOVE_COMMA +- { write_exp_elt_opcode (pstate, OP_F90_RANGE); +- write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT); ++ { write_exp_elt_opcode (pstate, OP_F90_RANGE); ++ write_exp_elt_longcst (pstate, ++ SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND); + write_exp_elt_opcode (pstate, OP_F90_RANGE); } + ; + + subrange: exp ':' %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_F90_RANGE); +- write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT); ++ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND); + write_exp_elt_opcode (pstate, OP_F90_RANGE); } + ; + + subrange: ':' exp %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_F90_RANGE); +- write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT); ++ write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND); + write_exp_elt_opcode (pstate, OP_F90_RANGE); } + ; + + subrange: ':' %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_F90_RANGE); +- write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT); ++ write_exp_elt_longcst (pstate, 0); + write_exp_elt_opcode (pstate, OP_F90_RANGE); } + ; + +diff --git a/gdb/f-lang.h b/gdb/f-lang.h +index f7a14d7..20cf5bd 100644 +--- a/gdb/f-lang.h ++++ b/gdb/f-lang.h +@@ -44,10 +44,8 @@ extern void f_val_print (struct type *, const gdb_byte *, int, CORE_ADDR, + + enum f90_range_type + { +- BOTH_BOUND_DEFAULT, /* "(:)" */ +- LOW_BOUND_DEFAULT, /* "(:high)" */ +- HIGH_BOUND_DEFAULT, /* "(low:)" */ +- NONE_BOUND_DEFAULT /* "(low:high)" */ ++ SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" */ ++ SUBARRAY_HIGH_BOUND = 0x2 /* "(:high)" */ + }; + + /* A common block. */ +diff --git a/gdb/parse.c b/gdb/parse.c +index a24c52a..7e45c05 100644 +--- a/gdb/parse.c ++++ b/gdb/parse.c +@@ -1006,22 +1006,17 @@ operator_length_standard (const struct expression *expr, int endpos, + + case OP_F90_RANGE: + oplen = 3; ++ args = 0; + range_type = (enum f90_range_type) + longest_to_int (expr->elts[endpos - 2].longconst); + +- switch (range_type) +- { +- case LOW_BOUND_DEFAULT: +- case HIGH_BOUND_DEFAULT: +- args = 1; +- break; +- case BOTH_BOUND_DEFAULT: +- args = 0; +- break; +- case NONE_BOUND_DEFAULT: +- args = 2; +- break; +- } ++ /* Increment the argument counter for each argument ++ provided by the user. */ ++ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) ++ args++; ++ ++ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) ++ args++; + + break; + +-- +1.7.0.7 diff --git a/gdb-fortran-stride-intel-4of6.patch b/gdb-fortran-stride-intel-4of6.patch new file mode 100644 index 0000000..650236e --- /dev/null +++ b/gdb-fortran-stride-intel-4of6.patch @@ -0,0 +1,142 @@ +From: Christoph Weinmann +[PATCH 4/6] fortran: enable parsing of stride parameter for subranges +https://sourceware.org/ml/gdb-patches/2015-12/msg00009.html +Message-Id: <1448976075-11456-5-git-send-email-christoph.t.weinmann@intel.com> + +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'. + +2013-11-27 Christoph Weinmann + + * eval.c (value_f90_subarray): Add expression evaluation + for a stride parameter in a Fortran range expression. + * f-exp.y: Add yacc rules for writing info on the elt stack + when the user provided a stride argument. + * f-lang.h (F90_RANGE): Add field to enum to show when a + stride was provided by the user. + * parse.c (operator_length_standard): Check if a stride + value was provided, and increment argument counter + accordingly. + + + +Signed-off-by: Christoph Weinmann +--- + gdb/eval.c | 10 +++++++++- + gdb/f-exp.y | 33 +++++++++++++++++++++++++++++++-- + gdb/f-lang.h | 5 +++-- + gdb/parse.c | 3 +++ + 4 files changed, 46 insertions(+), 5 deletions(-) + +diff --git a/gdb/eval.c b/gdb/eval.c +index 47ba602..15b2ad4 100644 +--- a/gdb/eval.c ++++ b/gdb/eval.c +@@ -438,7 +438,7 @@ value_f90_subarray (struct value *array, struct expression *exp, + struct subscript_range + { + enum f90_range_type f90_range_type; +- LONGEST low, high; ++ LONGEST low, high, stride; + } + range; + LONGEST number; +@@ -488,6 +488,14 @@ value_f90_subarray (struct value *array, struct expression *exp, + == SUBARRAY_HIGH_BOUND) + range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp, + pos, noside)); ++ ++ /* Assign the user's stride value if provided. */ ++ if ((range->f90_range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE) ++ range->stride = value_as_long (evaluate_subexp (NULL_TYPE, exp, ++ pos, noside)); ++ /* Assign the default stride value '1'. */ ++ else ++ range->stride = 1; + } + /* User input is an index. E.g.: "p arry(5)". */ + else +diff --git a/gdb/f-exp.y b/gdb/f-exp.y +index 1ff768c..01480b0 100644 +--- a/gdb/f-exp.y ++++ b/gdb/f-exp.y +@@ -316,8 +316,8 @@ arglist : arglist ',' exp %prec ABOVE_COMMA + + subrange: exp ':' exp %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_F90_RANGE); +- write_exp_elt_longcst (pstate, +- SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND); ++ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND ++ | SUBARRAY_HIGH_BOUND); + write_exp_elt_opcode (pstate, OP_F90_RANGE); } + ; + +@@ -339,6 +339,35 @@ subrange: ':' %prec ABOVE_COMMA + write_exp_elt_opcode (pstate, OP_F90_RANGE); } + ; + ++/* Each subrange type can have a stride argument. */ ++subrange: exp ':' exp ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_F90_RANGE); ++ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND ++ | SUBARRAY_HIGH_BOUND ++ | SUBARRAY_STRIDE); ++ write_exp_elt_opcode (pstate, OP_F90_RANGE); } ++ ; ++ ++subrange: exp ':' ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_F90_RANGE); ++ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND ++ | SUBARRAY_STRIDE); ++ write_exp_elt_opcode (pstate, OP_F90_RANGE); } ++ ; ++ ++subrange: ':' exp ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_F90_RANGE); ++ write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND ++ | SUBARRAY_STRIDE); ++ write_exp_elt_opcode (pstate, OP_F90_RANGE); } ++ ; ++ ++subrange: ':' ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_F90_RANGE); ++ write_exp_elt_longcst (pstate, SUBARRAY_STRIDE); ++ write_exp_elt_opcode (pstate, OP_F90_RANGE); } ++ ; ++ + complexnum: exp ',' exp + { } + ; +diff --git a/gdb/f-lang.h b/gdb/f-lang.h +index 20cf5bd..6cc0672 100644 +--- a/gdb/f-lang.h ++++ b/gdb/f-lang.h +@@ -44,8 +44,9 @@ extern void f_val_print (struct type *, const gdb_byte *, int, CORE_ADDR, + + enum f90_range_type + { +- SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" */ +- SUBARRAY_HIGH_BOUND = 0x2 /* "(:high)" */ ++ SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" or "(low::)" */ ++ SUBARRAY_HIGH_BOUND = 0x2, /* "(:high)" or "(:high:)" */ ++ SUBARRAY_STRIDE = 0x4 /* "(::stride)" */ + }; + + /* A common block. */ +diff --git a/gdb/parse.c b/gdb/parse.c +index 7e45c05..e67a426 100644 +--- a/gdb/parse.c ++++ b/gdb/parse.c +@@ -1018,6 +1018,9 @@ operator_length_standard (const struct expression *expr, int endpos, + if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) + args++; + ++ if ((range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE) ++ args++; ++ + break; + + default: +-- +1.7.0.7 diff --git a/gdb-fortran-stride-intel-5of6.patch b/gdb-fortran-stride-intel-5of6.patch new file mode 100644 index 0000000..1ce5440 --- /dev/null +++ b/gdb-fortran-stride-intel-5of6.patch @@ -0,0 +1,402 @@ +From: Christoph Weinmann +[PATCH 5/6] fortran: calculate subarray with stride values. +https://sourceware.org/ml/gdb-patches/2015-12/msg00011.html +Message-Id: <1448976075-11456-6-git-send-email-christoph.t.weinmann@intel.com> + +Calculate elements of a subarray using a provided stride value +The stride value can be a positive or negative integer, but may +not be zero. If no stride is provided, use the default value +1 to print all elements inside the range. + +1| program prog +2| integer :: ary(10) = (/ (i, i=1, 10) /) +3| end program prog + +(gdb) print ary(1:10:2) +$3 = (1, 3, 5, 7, 9) + +2013-11-27 Christoph Weinmann + + * eval.c (value_f90_subarray): Add range size calculation + for stride based ranges, and evaluation of user stride + parameters. Add check for matching user input to array + bounds. + * valops.c (value_slice): Add call parameter with default + stride value for calling value_slice_1. + * valops.c (value_slice_1): Add function parameter for + stride length in the return subarray. Calculate array + elements based on stride value. + * value.h: Add stride parameter to declaration of + value_slice_1. + + + +Signed-off-by: Christoph Weinmann +--- + gdb/eval.c | 110 +++++++++++++++++++++++++++++++++++++++++++++------------ + gdb/valops.c | 85 ++++++++++++++++++++++++++++++++------------ + gdb/value.h | 2 +- + 3 files changed, 150 insertions(+), 47 deletions(-) + +diff --git a/gdb/eval.c b/gdb/eval.c +index 15b2ad4..b8cd080 100644 +--- a/gdb/eval.c ++++ b/gdb/eval.c +@@ -437,8 +437,8 @@ value_f90_subarray (struct value *array, struct expression *exp, + { + struct subscript_range + { +- enum f90_range_type f90_range_type; +- LONGEST low, high, stride; ++ enum f90_range_type f90_range_type; ++ LONGEST low, high, stride; + } + range; + LONGEST number; +@@ -475,7 +475,7 @@ value_f90_subarray (struct value *array, struct expression *exp, + range = &index->range; + + *pos += 3; +- range->f90_range_type = longest_to_int (exp->elts[pc].longconst); ++ range->f90_range_type = exp->elts[pc].longconst; + + /* If a lower bound was provided by the user, the bit has been + set and we can assign the value from the elt stack. Same for +@@ -484,6 +484,7 @@ value_f90_subarray (struct value *array, struct expression *exp, + == SUBARRAY_LOW_BOUND) + range->low = value_as_long (evaluate_subexp (NULL_TYPE, exp, + pos, noside)); ++ + if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) + == SUBARRAY_HIGH_BOUND) + range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp, +@@ -496,6 +497,10 @@ value_f90_subarray (struct value *array, struct expression *exp, + /* Assign the default stride value '1'. */ + else + range->stride = 1; ++ ++ /* Check the provided stride value is illegal, aka '0'. */ ++ if (range->stride == 0) ++ error (_("Stride must not be 0")); + } + /* User input is an index. E.g.: "p arry(5)". */ + else +@@ -512,10 +517,8 @@ value_f90_subarray (struct value *array, struct expression *exp, + + } + +- /* Traverse the array from right to left and evaluate each corresponding +- user input. VALUE_SUBSCRIPT is called for every index, until a range +- expression is evaluated. After a range expression has been evaluated, +- every subsequent expression is also treated as a range. */ ++ /* Traverse the array from right to left and set the high and low bounds ++ for later use. */ + for (i = nargs - 1; i >= 0; i--) + { + struct subscript_store *index = &subscript_array[i]; +@@ -548,6 +551,48 @@ value_f90_subarray (struct value *array, struct expression *exp, + || range->high > TYPE_HIGH_BOUND (index_type)) + error (_("provided bound(s) outside array bound(s)")); + ++ /* For a negative stride the lower boundary must be larger than the ++ upper boundary. ++ For a positive stride the lower boundary must be smaller than the ++ upper boundary. */ ++ if ((range->stride < 0 && range->low < range->high) ++ || (range->stride > 0 && range->low > range->high)) ++ error (_("Wrong value provided for stride and boundaries")); ++ ++ } ++ break; ++ ++ case SUBSCRIPT_INDEX: ++ break; ++ ++ } ++ ++ array_type = TYPE_TARGET_TYPE (array_type); ++ } ++ ++ /* Reset ARRAY_TYPE before slicing.*/ ++ array_type = check_typedef (value_type (new_array)); ++ ++ /* Traverse the array from right to left and evaluate each corresponding ++ user input. VALUE_SUBSCRIPT is called for every index, until a range ++ expression is evaluated. After a range expression has been evaluated, ++ every subsequent expression is also treated as a range. */ ++ for (i = nargs - 1; i >= 0; i--) ++ { ++ struct subscript_store *index = &subscript_array[i]; ++ struct type *index_type = TYPE_INDEX_TYPE (array_type); ++ ++ switch (index->kind) ++ { ++ case SUBSCRIPT_RANGE: ++ { ++ ++ /* When we hit the first range specified by the user, we must ++ treat any subsequent user entry as a range. We simply ++ increment DIM_COUNT which tells us how many times we are ++ calling VALUE_SLICE_1. */ ++ struct subscript_range *range = &index->range; ++ + /* DIM_COUNT counts every user argument that is treated as a range. + This is necessary for expressions like 'print array(7, 8:9). + Here the first argument is a literal, but must be treated as a +@@ -555,10 +600,9 @@ value_f90_subarray (struct value *array, struct expression *exp, + dim_count++; + + new_array +- = value_slice_1 (new_array, +- longest_to_int (range->low), +- longest_to_int (range->high - range->low + 1), +- dim_count); ++ = value_slice_1 (new_array, range->low, ++ range->high - range->low + 1, ++ range->stride, dim_count); + } + break; + +@@ -572,27 +616,38 @@ value_f90_subarray (struct value *array, struct expression *exp, + to get the value offset right. */ + if (dim_count == 0) + new_array +- = value_subscripted_rvalue (new_array, index->number, ++ = value_subscripted_rvalue (new_array, index->number, + f77_get_lowerbound (value_type + (new_array))); + else + { +- /* Check for valid index input. */ ++ dim_count++; ++ ++ /* We might end up here, because we have to treat the provided ++ index like a range. But now VALUE_SUBSCRIPTED_RVALUE ++ cannot do the range checks for us. So we have to make sure ++ ourselves that the user provided index is inside the ++ array bounds. Throw an error if not. */ + if (index->number < TYPE_LOW_BOUND (index_type) +- || index->number > TYPE_HIGH_BOUND (index_type)) +- error (_("error no such vector element")); ++ && index->number < TYPE_HIGH_BOUND (index_type)) ++ error (_("provided bound(s) outside array bound(s)")); ++ ++ if (index->number > TYPE_LOW_BOUND (index_type) ++ && index->number > TYPE_HIGH_BOUND (index_type)) ++ error (_("provided bound(s) outside array bound(s)")); + +- dim_count++; + new_array = value_slice_1 (new_array, +- longest_to_int (index->number), +- 1, /* length is '1' element */ ++ index->number, ++ 1, /* COUNT is '1' element */ ++ 1, /* STRIDE set to '1' */ + dim_count); + } + + } + break; + } +- } ++ array_type = TYPE_TARGET_TYPE (array_type); ++ } + + /* With DIM_COUNT > 1 we currently have a one dimensional array, but expect + an array of arrays, depending on how many ranges have been provided by +@@ -617,7 +672,9 @@ value_f90_subarray (struct value *array, struct expression *exp, + the output array. So we traverse the SUBSCRIPT_ARRAY again, looking + for a range entry. When we find one, we use the range info to create + an additional range_type to set the correct bounds and dimensions for +- the output array. */ ++ the output array. In addition, we may have a stride value that is not ++ '1', forcing us to adjust the number of elements in a range, according ++ to the stride value. */ + for (i = 0; i < nargs; i++) + { + struct subscript_store *index = &subscript_array[i]; +@@ -625,12 +682,19 @@ value_f90_subarray (struct value *array, struct expression *exp, + if (index->kind == SUBSCRIPT_RANGE) + { + struct type *range_type, *interim_array_type; ++ int new_length; ++ ++ /* The length of a sub-dimension with all elements between the ++ bounds plus the start element itself. It may be modified by ++ a user provided stride value. */ ++ new_length = index->range.high - index->range.low; ++ new_length /= index->range.stride; + + range_type + = create_static_range_type (NULL, +- temp_type, +- 1, +- index->range.high - index->range.low + 1); ++ temp_type, ++ index->range.low, ++ index->range.low + new_length); + + interim_array_type = create_array_type (NULL, + temp_type, +diff --git a/gdb/valops.c b/gdb/valops.c +index f8d23fb..6c9112f 100644 +--- a/gdb/valops.c ++++ b/gdb/valops.c +@@ -3759,10 +3759,13 @@ value_of_this_silent (const struct language_defn *lang) + struct value * + value_slice (struct value *array, int lowbound, int length) + { +- /* Pass unaltered arguments to VALUE_SLICE_1, plus a CALL_COUNT of '1' as we +- are only considering the highest dimension, or we are working on a one +- dimensional array. So we call VALUE_SLICE_1 exactly once. */ +- return value_slice_1 (array, lowbound, length, 1); ++ /* Pass unaltered arguments to VALUE_SLICE_1, plus a default stride ++ value of '1', which returns every element between LOWBOUND and ++ (LOWBOUND + LENGTH). We also provide a default CALL_COUNT of '1' ++ as we are only considering the highest dimension, or we are ++ working on a one dimensional array. So we call VALUE_SLICE_1 ++ exactly once. */ ++ return value_slice_1 (array, lowbound, length, 1, 1); + } + + /* CALL_COUNT is used to determine if we are calling the function once, e.g. +@@ -3776,7 +3779,8 @@ value_slice (struct value *array, int lowbound, int length) + ranges in the calling function. */ + + struct value * +-value_slice_1 (struct value *array, int lowbound, int length, int call_count) ++value_slice_1 (struct value *array, int lowbound, int length, ++ int stride_length, int call_count) + { + struct type *slice_range_type, *slice_type, *range_type; + struct type *array_type = check_typedef (value_type (array)); +@@ -3799,14 +3803,24 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count) + attributes of the underlying type. */ + if (call_count > 1) + { ++ ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (elt_type)); ++ ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (elt_type)); + elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type)); + row_count = TYPE_LENGTH (array_type) + / TYPE_LENGTH (TYPE_TARGET_TYPE (array_type)); + } + +- elem_count = length; ++ /* With a stride of '1', the number of elements per result row is equal to ++ the LENGTH of the subarray. With non-default stride values, we skip ++ elements, but have to add the start element to the total number of ++ elements per row. */ ++ if (stride_length == 1) ++ elem_count = length; ++ else ++ elem_count = ((length - 1) / stride_length) + 1; ++ + elt_size = TYPE_LENGTH (elt_type); +- elt_offs = longest_to_int (lowbound - ary_low_bound); ++ elt_offs = lowbound - ary_low_bound; + elt_stride = TYPE_LENGTH (TYPE_INDEX_TYPE (array_type)); + + elt_offs *= elt_size; +@@ -3837,7 +3851,7 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count) + else + { + range_type = TYPE_INDEX_TYPE (TYPE_TARGET_TYPE (array_type)); +- slice_range_size = (ary_low_bound + row_count - 1) * (elem_count); ++ slice_range_size = ary_low_bound + (row_count * elem_count) - 1; + ary_low_bound = TYPE_LOW_BOUND (range_type); + } + +@@ -3849,8 +3863,9 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count) + { + struct type *element_type; + +- /* When CALL_COUNT equals 1 we can use the legacy code for subarrays. */ +- if (call_count == 1) ++ /* When both CALL_COUNT and STRIDE_LENGTH equal 1, we can use the legacy ++ code for subarrays. */ ++ if (call_count == 1 && stride_length == 1) + { + element_type = TYPE_TARGET_TYPE (array_type); + +@@ -3871,29 +3886,53 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count) + } + + } +- /* When CALL_COUNT is larger than 1 we are working on a range of ranges. +- So we copy the relevant elements into the new array we return. */ ++ /* With a CALL_COUNT or STRIDE_LENGTH are greater than 1 we are working ++ on a range of ranges. So we copy the relevant elements into the ++ new array we return. */ + else + { ++ int j, offs_store = elt_offs; + LONGEST dst_offset = 0; + LONGEST src_row_length = TYPE_LENGTH (TYPE_TARGET_TYPE (array_type)); + +- element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type)); ++ if (call_count == 1) ++ { ++ /* When CALL_COUNT is equal to 1 we are working on the current range ++ and use these elements directly. */ ++ element_type = TYPE_TARGET_TYPE (array_type); ++ } ++ else ++ { ++ /* Working on an array of arrays, the type of the elements is the type ++ of the subarrays' type. */ ++ element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type)); ++ } ++ + slice_type = create_array_type (NULL, element_type, slice_range_type); + +- TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_type)); ++ /* If we have a one dimensional array, we copy its TYPE_CODE. For a ++ multi dimensional array we copy the embedded type's TYPE_CODE. */ ++ if (call_count == 1) ++ TYPE_CODE (slice_type) = TYPE_CODE (array_type); ++ else ++ TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_type)); + + v = allocate_value (slice_type); +- for (i = 0; i < longest_to_int (row_count); i++) ++ ++ /* Iterate through the rows of the outer array and set the new offset ++ for each row. */ ++ for (i = 0; i < row_count; i++) + { +- /* Fetches the contents of ARRAY and copies them into V. */ +- value_contents_copy (v, +- dst_offset, +- array, +- elt_offs, +- elt_size * elem_count); +- elt_offs += src_row_length; +- dst_offset += elt_size * elem_count; ++ elt_offs = offs_store + i * src_row_length; ++ ++ /* Iterate through the elements in each row to copy only those. */ ++ for (j = 1; j <= elem_count; j++) ++ { ++ /* Fetches the contents of ARRAY and copies them into V. */ ++ value_contents_copy (v, dst_offset, array, elt_offs, elt_size); ++ elt_offs += elt_size * stride_length; ++ dst_offset += elt_size; ++ } + } + } + +diff --git a/gdb/value.h b/gdb/value.h +index 05939c4..d687468 100644 +--- a/gdb/value.h ++++ b/gdb/value.h +@@ -1056,7 +1056,7 @@ extern struct value *varying_to_slice (struct value *); + + extern struct value *value_slice (struct value *, int, int); + +-extern struct value *value_slice_1 (struct value *, int, int, int); ++extern struct value *value_slice_1 (struct value *, int, int, int, int); + + extern struct value *value_literal_complex (struct value *, struct value *, + struct type *); +-- +1.7.0.7 diff --git a/gdb-fortran-stride-intel-6of6-nokfail.patch b/gdb-fortran-stride-intel-6of6-nokfail.patch new file mode 100644 index 0000000..5b61de1 --- /dev/null +++ b/gdb-fortran-stride-intel-6of6-nokfail.patch @@ -0,0 +1,36 @@ +--- gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/subrange.exp-orig 2016-01-08 22:45:44.956842553 +0100 ++++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/subrange.exp 2016-01-08 23:26:05.078554629 +0100 +@@ -39,27 +39,16 @@ foreach var {a alloc ptr} { + set old_prefix $pf_prefix + lappend pf_prefix "$var:" + +- setup_kfail "*-*-*" "vlaregression/9999" + gdb_test "p $var (2, 2:3)" { = \(22, 32\)} +- setup_kfail "*-*-*" "vlaregression/9999" + gdb_test "p $var (2:3, 3)" { = \(32, 33\)} +- setup_kfail "*-*-*" "vlaregression/9999" + gdb_test "p $var (1, 2:)" { = \(21, 31\)} +- setup_kfail "*-*-*" "vlaregression/9999" + gdb_test "p $var (2, :2)" { = \(12, 22\)} +- setup_kfail "*-*-*" "vlaregression/9999" + gdb_test "p $var (3, 2:2)" { = \(23\)} +- setup_kfail "*-*-*" "vlaregression/9999" + gdb_test "ptype $var (3, 2:2)" " = $int4 \\(2:2\\)" +- setup_kfail "*-*-*" "vlaregression/9999" + gdb_test "p $var (4, :)" { = \(14, 24, 34\)} +- setup_kfail "*-*-*" "vlaregression/9999" + gdb_test "p $var (:, :)" { = \(\( *11, 12, 13, 14\) \( *21, 22, 23, 24\) \( *31, 32, 33, 34\) *\)} +- setup_kfail "*-*-*" "vlaregression/9999" + gdb_test "ptype $var (:, :)" " = $int4 \\(4,3\\)" +- setup_kfail "*-*-*" "vlaregression/9999" + gdb_test "p $var (:)" "Wrong number of subscripts" +- setup_kfail "*-*-*" "vlaregression/9999" + gdb_test "p $var (:, :, :)" "Wrong number of subscripts" + + set pf_prefix $old_prefix +@@ -68,5 +57,4 @@ foreach var {a alloc ptr} { + gdb_test_no_output {set $a=a} + delete_breakpoints + gdb_unload +-setup_kfail "*-*-*" "vlaregression/9999" + gdb_test {p $a (3, 2:2)} { = \(23\)} diff --git a/gdb-fortran-stride-intel-6of6-testcasefix.patch b/gdb-fortran-stride-intel-6of6-testcasefix.patch new file mode 100644 index 0000000..d67920b --- /dev/null +++ b/gdb-fortran-stride-intel-6of6-testcasefix.patch @@ -0,0 +1,52 @@ +http://sourceware.org/ml/gdb-patches/2016-01/msg00135.html +Subject: Re: [PATCH 0/6] fortran: multi-dimensional subarrays with strides + + +--vkogqOf2sHV7VnPd +Content-Type: text/plain; charset=us-ascii +Content-Disposition: inline + +On Thu, 03 Dec 2015 21:51:19 +0100, Jan Kratochvil wrote: +> Just I see - reproducible with FSF GDB trunk - one new: +> FAIL: gdb.fortran/static-arrays.exp: print ar3(:2,:2,:2) +> happening on x86_64 in -m32 target mode and on i686 native host. +> It PASSes in the most common case of native x86_64. Tested on Fedora 23. +> print ar3(:2,:2,:2)^M +> -$52 = (( ( 111, 211) ( 121, 221) ) ( ( 112, 212) ( 122, 222) ) )^M +> -(gdb) PASS: gdb.fortran/static-arrays.exp: print ar3(:2,:2,:2) +> +$52 = (( ( 1221, 211) ( 121, 221) ) ( ( 112, 212) ( 122, 222) ) )^M +> +(gdb) FAIL: gdb.fortran/static-arrays.exp: print ar3(:2,:2,:2) + +That was easier than I expected: + +gfortran -fcheck=bounds +-> +At line 44 of file gdb.fortran/static-arrays.f90 +Fortran runtime error: Index '11' of dimension 1 of array 'ar4' above upper bound of 10 + +There is: + integer, dimension(10,-7:3, -15:-5) :: ar4 ++ + do i = 1, 11, 1 + + +Jan + +--vkogqOf2sHV7VnPd +Content-Type: text/plain; charset=us-ascii +Content-Disposition: inline; filename=1 + +--- gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/static-arrays.f90-orig 2016-01-08 19:19:18.421828196 +0100 ++++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/static-arrays.f90 2016-01-08 19:41:09.778142683 +0100 +@@ -38,7 +38,7 @@ subroutine sub + end do + end do + +- do i = 1, 11, 1 ++ do i = 1, 10, 1 + do j = -7, 3, 1 + do k = -15, -5, 1 + ar4(i,j,k) = i*100 + (j+8)*10 + (k+16) + +--vkogqOf2sHV7VnPd-- + diff --git a/gdb-fortran-stride-intel-6of6.patch b/gdb-fortran-stride-intel-6of6.patch new file mode 100644 index 0000000..ba77c19 --- /dev/null +++ b/gdb-fortran-stride-intel-6of6.patch @@ -0,0 +1,474 @@ +From: Christoph Weinmann +[PATCH 6/6] fortran: test cases for subarray strides and slices +https://sourceware.org/ml/gdb-patches/2015-12/msg00012.html +Message-Id: <1448976075-11456-7-git-send-email-christoph.t.weinmann@intel.com> + +Add test cases for subarray creation with range, literal and +stride value permutations for one, two, and three dimensional +arrays. + +2013-12-04 Christoph Weinmann + +testsuite/gdb.fortran/ + * static-arrays.exp: New test. + * static-arrays.f90: New file. + + + +Signed-off-by: Christoph Weinmann +--- + gdb/testsuite/gdb.fortran/static-arrays.exp | 380 +++++++++++++++++++++++++++ + gdb/testsuite/gdb.fortran/static-arrays.f90 | 55 ++++ + 2 files changed, 435 insertions(+), 0 deletions(-) + create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.exp + create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.f90 + +diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp +new file mode 100644 +index 0000000..077f6fb +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/static-arrays.exp +@@ -0,0 +1,380 @@ ++# Copyright 2015 Free Software Foundation, Inc. ++# ++# Contributed by Intel Corp. ++# ++# 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 static-arrays.f90 ++ ++if { [prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}] } { ++ return -1 ++} ++ ++if ![runto MAIN__] then { ++ perror "couldn't run to breakpoint MAIN__" ++ continue ++} ++ ++gdb_breakpoint [gdb_get_line_number "BP1"] ++gdb_continue_to_breakpoint "BP1" ".*BP1.*" ++ ++# Tests subarrays of one dimensional arrays with subrange variations ++gdb_test "print ar1" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \ ++ "print ar1." ++gdb_test "print ar1\(4:7\)" "\\$\[0-9\]+ = \\(4, 5, 6, 7\\)" \ ++ "print ar1\(4:7\)" ++gdb_test "print ar1\(8:\)" "\\$\[0-9\]+ = \\(8, 9\\).*" \ ++ "print ar1\(8:\)" ++gdb_test "print ar1\(:3\)" "\\$\[0-9\]+ = \\(1, 2, 3\\).*" \ ++ "print ar1\(:3\)" ++gdb_test "print ar1\(:\)" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \ ++ "print ar1\(:\)" ++ ++# Check assignment ++gdb_test_no_output "set \$my_ary = ar1\(3:8\)" ++gdb_test "print \$my_ary" \ ++ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \ ++ "Assignment of subarray to variable" ++gdb_test_no_output "set ar1\(5\) = 42" ++ gdb_test "print ar1\(3:8\)" \ ++ "\\$\[0-9\]+ = \\(3, 4, 42, 6, 7, 8\\)" \ ++ "print ar1\(3:8\) after assignment" ++gdb_test "print \$my_ary" \ ++ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \ ++ "Assignment of subarray to variable after original array changed" ++ ++# Test for subarrays of one dimensional arrays with literals ++ gdb_test "print ar1\(3\)" "\\$\[0-9\]+ = 3" \ ++ "print ar1\(3\)" ++ ++# Tests for subranges of 2 dimensional arrays with subrange variations ++gdb_test "print ar2\(2:3, 3:4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 23, 33\\) \\( 24, 34\\) \\)" \ ++ "print ar2\(2:3, 3:4\)." ++gdb_test "print ar2\(8:9,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ ++ "print ar2\(8:9,8:\)" ++gdb_test "print ar2\(8:9,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \ ++ "print ar2\(8:9,:2\)" ++ ++gdb_test "print ar2\(8:,8:9\)" \ ++ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ ++ "print ar2\(8:,8:9\)" ++gdb_test "print ar2\(8:,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ ++ "print ar2\(8:,8:\)" ++gdb_test "print ar2\(8:,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \ ++ "print ar2\(8:,:2\)" ++ ++gdb_test "print ar2\(:2,2:3\)" \ ++ "\\$\[0-9\]+ = \\(\\( 12, 22\\) \\( 13, 23\\) \\)" \ ++ "print ar2\(:2,2:3\)" ++gdb_test "print ar2\(:2,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 18, 28\\) \\( 19, 29\\) \\)" \ ++ "print ar2\(:2,8:\)" ++gdb_test "print ar2\(:2,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 11, 21\\) \\( 12, 22\\) \\)" \ ++ "print ar2\(:2,:2\)" ++ ++# Test subranges of 2 dimensional arrays with literals and subrange variations ++gdb_test "print ar2\(7, 3:6\)" \ ++ "\\$\[0-9\]+ = \\(73, 74, 75, 76\\)" \ ++ "print ar2\(7, 3:6\)" ++gdb_test "print ar2\(7,8:\)" \ ++ "\\$\[0-9\]+ = \\(78, 79\\)" \ ++ "print ar2\(7,8:\)" ++gdb_test "print ar2\(7,:2\)" \ ++ "\\$\[0-9\]+ = \\(71, 72\\)" \ ++ "print ar2\(7,:2\)" ++ ++gdb_test "print ar2\(7:8,4\)" \ ++ "\\$\[0-9\]+ = \\(74, 84\\)" \ ++ "print ar2(7:8,4\)" ++gdb_test "print ar2\(8:,4\)" \ ++ "\\$\[0-9\]+ = \\(84, 94\\)" \ ++ "print ar2\(8:,4\)" ++gdb_test "print ar2\(:2,4\)" \ ++ "\\$\[0-9\]+ = \\(14, 24\\)" \ ++ "print ar2\(:2,4\)" ++gdb_test "print ar2\(3,4\)" \ ++ "\\$\[0-9\]+ = 34" \ ++ "print ar2\(3,4\)" ++ ++# Test subarrays of 3 dimensional arrays with literals and subrange variations ++gdb_test "print ar3\(2:4,3:4,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 237, 337, 437\\) \\( 247, 347, 447\\) \\) \\( \\( 238, 338, 438\\) \\( 248, 348, 448\\) \\) \\)" \ ++ "print ar3\(2:4,3:4,7:8\)" ++gdb_test "print ar3\(2:3,4:5,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 248, 348\\) \\( 258, 358\\) \\) \\( \\( 249, 349\\) \\( 259, 359\\) \\) \\)" \ ++ "print ar3\(2:3,4:5,8:\)" ++gdb_test "print ar3\(2:3,4:5,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 241, 341\\) \\( 251, 351\\) \\) \\( \\( 242, 342\\) \\( 252, 352\\) \\) \\)" \ ++ "print ar3\(2:3,4:5,:2\)" ++ ++gdb_test "print ar3\(2:3,8:,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 287, 387\\) \\( 297, 397\\) \\) \\( \\( 288, 388\\) \\( 298, 398\\) \\) \\)" \ ++ "print ar3\(2:3,8:,7:8\)" ++gdb_test "print ar3\(2:3,8:,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 288, 388\\) \\( 298, 398\\) \\) \\( \\( 289, 389\\) \\( 299, 399\\) \\) \\)" \ ++ "print ar3\(2:3,8:,8:\)" ++gdb_test "print ar3\(2:3,8:,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 281, 381\\) \\( 291, 391\\) \\) \\( \\( 282, 382\\) \\( 292, 392\\) \\) \\)" \ ++ "print ar3\(2:3,8:,:2\)" ++ ++gdb_test "print ar3\(2:3,:2,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 217, 317\\) \\( 227, 327\\) \\) \\( \\( 218, 318\\) \\( 228, 328\\) \\) \\)" \ ++ "print ar3\(2:3,:2,7:8\)" ++gdb_test "print ar3\(2:3,:2,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 218, 318\\) \\( 228, 328\\) \\) \\( \\( 219, 319\\) \\( 229, 329\\) \\) \\)" \ ++ "print ar3\(2:3,:2,8:\)" ++gdb_test "print ar3\(2:3,:2,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 211, 311\\) \\( 221, 321\\) \\) \\( \\( 212, 312\\) \\( 222, 322\\) \\) \\)" \ ++ "print ar3\(2:3,:2,:2\)" ++ ++gdb_test "print ar3\(8:,3:4,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 837, 937\\) \\( 847, 947\\) \\) \\( \\( 838, 938\\) \\( 848, 948\\) \\) \\)" \ ++ "print ar3\(8:,3:4,7:8\)" ++gdb_test "print ar3\(8:,4:5,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 848, 948\\) \\( 858, 958\\) \\) \\( \\( 849, 949\\) \\( 859, 959\\) \\) \\)" \ ++ "print ar3\(8:,4:5,8:\)" ++gdb_test "print ar3\(8:,4:5,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 841, 941\\) \\( 851, 951\\) \\) \\( \\( 842, 942\\) \\( 852, 952\\) \\) \\)" \ ++ "print ar3\(8:,4:5,:2\)" ++ ++gdb_test "print ar3\(8:,8:,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 887, 987\\) \\( 897, 997\\) \\) \\( \\( 888, 988\\) \\( 898, 998\\) \\) \\)" \ ++ "print ar3\(8:,8:,7:8\)" ++gdb_test "print ar3\(8:,8:,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 888, 988\\) \\( 898, 998\\) \\) \\( \\( 889, 989\\) \\( 899, 999\\) \\) \\)" \ ++ "print ar3\(8:,8:,8:\)" ++gdb_test "print ar3\(8:,8:,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 881, 981\\) \\( 891, 991\\) \\) \\( \\( 882, 982\\) \\( 892, 992\\) \\) \\)" \ ++ "print ar3\(8:,8:,:2\)" ++ ++gdb_test "print ar3\(8:,:2,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 817, 917\\) \\( 827, 927\\) \\) \\( \\( 818, 918\\) \\( 828, 928\\) \\) \\)" \ ++ "print ar3\(8:,:2,7:8\)" ++gdb_test "print ar3\(8:,:2,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 818, 918\\) \\( 828, 928\\) \\) \\( \\( 819, 919\\) \\( 829, 929\\) \\) \\)" \ ++ "print ar3\(8:,:2,8:\)" ++gdb_test "print ar3\(8:,:2,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 811, 911\\) \\( 821, 921\\) \\) \\( \\( 812, 912\\) \\( 822, 922\\) \\) \\)" \ ++ "print ar3\(8:,:2,:2\)" ++ ++ ++gdb_test "print ar3\(:2,3:4,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 137, 237\\) \\( 147, 247\\) \\) \\( \\( 138, 238\\) \\( 148, 248\\) \\) \\)" \ ++ "print ar3 \(:2,3:4,7:8\)." ++gdb_test "print ar3\(:2,3:4,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 138, 238\\) \\( 148, 248\\) \\) \\( \\( 139, 239\\) \\( 149, 249\\) \\) \\)" \ ++ "print ar3\(:2,3:4,8:\)" ++gdb_test "print ar3\(:2,3:4,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 131, 231\\) \\( 141, 241\\) \\) \\( \\( 132, 232\\) \\( 142, 242\\) \\) \\)" \ ++ "print ar3\(:2,3:4,:2\)" ++ ++gdb_test "print ar3\(:2,8:,7:8\)" "\\$\[0-9\]+ = \\(\\( \\( 187, 287\\) \\( 197, 297\\) \\) \\( \\( 188, 288\\) \\( 198, 298\\) \\) \\)" \ ++ "print ar3\(:2,8:,7:8\)" ++gdb_test "print ar3\(:2,8:,8:\)" "\\$\[0-9\]+ = \\(\\( \\( 188, 288\\) \\( 198, 298\\) \\) \\( \\( 189, 289\\) \\( 199, 299\\) \\) \\)" \ ++ "print ar3\(:2,8:,8:\)" ++gdb_test "print ar3\(:2,8:,:2\)" "\\$\[0-9\]+ = \\(\\( \\( 181, 281\\) \\( 191, 291\\) \\) \\( \\( 182, 282\\) \\( 192, 292\\) \\) \\)" \ ++ "print ar3\(:2,8:,:2\)" ++ ++gdb_test "print ar3\(:2,:2,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 117, 217\\) \\( 127, 227\\) \\) \\( \\( 118, 218\\) \\( 128, 228\\) \\) \\)" \ ++ "print ar3\(:2,:2,7:8\)" ++gdb_test "print ar3\(:2,:2,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 118, 218\\) \\( 128, 228\\) \\) \\( \\( 119, 219\\) \\( 129, 229\\) \\) \\)" \ ++ "print ar3\(:2,:2,8:\)" ++gdb_test "print ar3\(:2,:2,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\) \\( \\( 112, 212\\) \\( 122, 222\\) \\) \\)" \ ++ "print ar3\(:2,:2,:2\)" ++ ++ ++#Tests for subarrays of 3 dimensional arrays with literals and subranges ++gdb_test "print ar3\(3,3:4,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 337, 347\\) \\( 338, 348\\) \\)" \ ++ "print ar3\(3,3:4,7:8\)" ++gdb_test "print ar3\(3,4:5,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 348, 358\\) \\( 349, 359\\) \\)" \ ++ "print ar3\(3,4:5,8:\)" ++gdb_test "print ar3\(3,4:5,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 341, 351\\) \\( 342, 352\\) \\)" \ ++ "print ar3\(3,4:5,:2\)" ++gdb_test "print ar3\(3,4:5,3\)" \ ++ "\\$\[0-9\]+ = \\(343, 353\\)" \ ++ "print ar3\(3,4:5,3\)" ++ ++gdb_test "print ar3\(2,8:,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 287, 297\\) \\( 288, 298\\) \\)" \ ++ "print ar3\(2,8:,7:8\)" ++gdb_test "print ar3\(2,8:,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 288, 298\\) \\( 289, 299\\) \\)" \ ++ "print ar3\(2,8:,8:\)" ++gdb_test "print ar3\(2,8:,:2\)"\ ++ "\\$\[0-9\]+ = \\(\\( 281, 291\\) \\( 282, 292\\) \\)" \ ++ "print ar3\(2,8:,:2\)" ++gdb_test "print ar3\(2,8:,3\)" \ ++ "\\$\[0-9\]+ = \\(283, 293\\)" \ ++ "print ar3\(2,8:,3\)" ++ ++gdb_test "print ar3\(2,:2,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 217, 227\\) \\( 218, 228\\) \\)" \ ++ "print ar3\(2,:2,7:8\)" ++gdb_test "print ar3\(2,:2,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 218, 228\\) \\( 219, 229\\) \\)" \ ++ "print ar3\(2,:2,8:\)" ++gdb_test "print ar3\(2,:2,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 211, 221\\) \\( 212, 222\\) \\)" \ ++ "print ar3\(2,:2,:2\)" ++gdb_test "print ar3\(2,:2,3\)" \ ++ "\\$\[0-9\]+ = \\(213, 223\\)" \ ++ "print ar3\(2,:2,3\)" ++ ++gdb_test "print ar3\(3,4,7:8\)" \ ++ "\\$\[0-9\]+ = \\(347, 348\\)" \ ++ "print ar3\(3,4,7:8\)" ++gdb_test "print ar3\(3,4,8:\)" \ ++ "\\$\[0-9\]+ = \\(348, 349\\)" \ ++i "print ar3\(3,4,8:\)" ++gdb_test "print ar3\(3,4,:2\)" \ ++ "\\$\[0-9\]+ = \\(341, 342\\)" \ ++ "print ar3\(3,4,:2\)" ++gdb_test "print ar3\(5,6,7\)" \ ++ "\\$\[0-9\]+ = 567" \ ++ "print ar3\(5,6,7\)" ++ ++gdb_test "print ar3\(3:4,6,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 367, 467\\) \\( 368, 468\\) \\)" \ ++ "print ar3\(3:4,6,7:8\)" ++gdb_test "print ar3\(3:4,6,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 368, 468\\) \\( 369, 469\\) \\)" \ ++ "print ar3\(3:4,6,8:\)" ++gdb_test "print ar3\(3:4,6,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 361, 461\\) \\( 362, 462\\) \\)" \ ++ "print ar3\(3:4,6,:2\)" ++gdb_test "print ar3\(3:4,6,5\)" \ ++ "\\$\[0-9\]+ = \\(365, 465\\)" \ ++ "print ar3\(3:4,6,5\)" ++ ++gdb_test "print ar3\(8:,6,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 867, 967\\) \\( 868, 968\\) \\)" \ ++ "print ar3\(8:,6,7:8\)" ++gdb_test "print ar3\(8:,6,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 868, 968\\) \\( 869, 969\\) \\)" \ ++ "print ar3\(8:,6,8:\)" ++gdb_test "print ar3\(8:,6,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 861, 961\\) \\( 862, 962\\) \\)" \ ++ "print ar3\(8:,6,:2\)" ++gdb_test "print ar3\(8:,6,5\)" \ ++ "\\$\[0-9\]+ = \\(865, 965\\)" \ ++ "print ar3\(8:,6,5\)" ++ ++gdb_test "print ar3\(:2,6,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 167, 267\\) \\( 168, 268\\) \\)" \ ++ "print ar3\(:2,6,7:8\)" ++gdb_test "print ar3\(:2,6,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 168, 268\\) \\( 169, 269\\) \\)" \ ++ "print ar3\(:2,6,8:\)" ++gdb_test "print ar3\(:2,6,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 161, 261\\) \\( 162, 262\\) \\)" \ ++ "print ar3\(:2,6,:2\)" ++gdb_test "print ar3\(:2,6,5\)" \ ++ "\\$\[0-9\]+ = \\(165, 265\\)" \ ++ "print ar3\(:2,6,5\)" ++ ++gdb_test "print ar3\(3:4,5:6,4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 354, 454\\) \\( 364, 464\\) \\)" \ ++ "print ar2\(3:4,5:6,4\)" ++gdb_test "print ar3\(8:,5:6,4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 854, 954\\) \\( 864, 964\\) \\)" \ ++ "print ar2\(8:,5:6,4\)" ++gdb_test "print ar3\(:2,5:6,4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 154, 254\\) \\( 164, 264\\) \\)" \ ++ "print ar2\(:2,5:6,4\)" ++ ++# Stride > 1 ++gdb_test "print ar1\(2:6:2\)" \ ++ "\\$\[0-9\]+ = \\(2, 4, 6\\)" \ ++ "print ar1\(2:6:2\)" ++gdb_test "print ar2\(2:6:2,3:4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 23, 43, 63\\) \\( 24, 44, 64\\) \\)" \ ++ "print ar2\(2:6:2,3:4\)" ++gdb_test "print ar2\(2:6:2,3\)" \ ++ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \ ++ "print ar2\(2:6:2,3\)" ++gdb_test "print ar3\(2:6:2,3:5:2,4:7:3\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 234, 434, 634\\) \\( 254, 454, 654\\) \\) \\( \\( 237, 437, 637\\) \\( 257, 457, 657\\) \\) \\)" \ ++ "print ar3\(2:6:2,3:5:2,4:7:3\)" ++gdb_test "print ar3\(2:6:2,5,4:7:3\)" \ ++ "\\$\[0-9\]+ = \\(\\( 254, 454, 654\\) \\( 257, 457, 657\\) \\)" \ ++ "print ar3\(2:6:2,5,4:7:3\)" ++ ++# Stride < 0 ++gdb_test "print ar1\(8:2:-2\)" \ ++ "\\$\[0-9\]+ = \\(8, 6, 4, 2\\)" \ ++ "print ar1\(8:2:-2\)" ++gdb_test "print ar2\(8:2:-2,3:4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 83, 63, 43, 23\\) \\( 84, 64, 44, 24\\) \\)" \ ++ "print ar2\(8:2:-2,3:4\)" ++gdb_test "print ar2\(2:6:2,3\)" \ ++ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \ ++ "print ar2\(2:6:2,3\)" ++gdb_test "print ar3\(2:3,7:3:-4,4:7:3\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 274, 374\\) \\( 234, 334\\) \\) \\( \\( 277, 377\\) \\( 237, 337\\) \\) \\)" \ ++ "print ar3\(2:3,7:3:-4,4:7:3\)" ++gdb_test "print ar3\(2:6:2,5,7:4:-3\)" \ ++ "\\$\[0-9\]+ = \\(\\( 257, 457, 657\\) \\( 254, 454, 654\\) \\)" \ ++ "print ar3\(2:6:2,5,7:4:-3\)" ++ ++# Tests with negative and mixed indices ++gdb_test "p ar4\(2:4, -2:1, -15:-14\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 261, 361, 461\\) \\( 271, 371, 471\\) \\( 281, 381, 481\\) \\( 291, 391, 491\\) \\) \\( \\( 262, 362, 462\\) \\( 272, 372, 472\\) \\( 282, 382, 482\\) \\( 292, 392, 492\\) \\) \\)" \ ++ "print ar4(2:4, -2:1, -15:-14)" ++ ++gdb_test "p ar4\(7,-6:2:3,-7\)" \ ++ "\\$\[0-9\]+ = \\(729, 759, 789\\)" \ ++ "print ar4(7,-6:2:3,-7)" ++ ++gdb_test "p ar4\(9:2:-2, -6:2:3, -6:-15:-3\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 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\\) \\) \\)" \ ++ "print ar4(9:2:-2, -6:2:3, -6:-15:-3)" ++ ++gdb_test "p ar4\(:,:,:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 111, 211, 311, 411, 511, 611, 711, 811, .*" \ ++ "print ar4(:,:,:)" ++ ++# Provoke error messages for bad user input ++gdb_test "print ar1\(0:4\)" \ ++ "provided bound\\(s\\) outside array bound\\(s\\)" \ ++ "print ar1\(0:4\)" ++gdb_test "print ar1\(8:12\)" \ ++ "provided bound\\(s\\) outside array bound\\(s\\)" \ ++ "print ar1\(8:12\)" ++gdb_test "print ar1\(8:2:\)" \ ++ "A syntax error in expression, near `\\)'." \ ++ "print ar1\(8:2:\)" ++gdb_test "print ar1\(8:2:2\)" \ ++ "Wrong value provided for stride and boundaries" \ ++ "print ar1\(8:2:2\)" ++gdb_test "print ar1\(2:8:-2\)" \ ++ "Wrong value provided for stride and boundaries" \ ++ "print ar1\(2:8:-2\)" ++gdb_test "print ar1\(2:7:0\)" \ ++ "Stride must not be 0" \ ++ "print ar1\(2:7:0\)" ++gdb_test "print ar1\(3:7\) = 42" \ ++ "Invalid cast." \ ++ "Assignment of value to subarray" +diff --git a/gdb/testsuite/gdb.fortran/static-arrays.f90 b/gdb/testsuite/gdb.fortran/static-arrays.f90 +new file mode 100644 +index 0000000..af1a20c +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/static-arrays.f90 +@@ -0,0 +1,55 @@ ++! Copyright 2015 Free Software Foundation, Inc. ++! ++! Contributed by Intel Corp. ++! ++! 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 . ++ ++subroutine sub ++ integer, dimension(9) :: ar1 ++ integer, dimension(9,9) :: ar2 ++ integer, dimension(9,9,9) :: ar3 ++ integer, dimension(10,-7:3, -15:-5) :: ar4 ++ integer :: i,j,k ++ ++ ar1 = 1 ++ ar2 = 1 ++ ar3 = 1 ++ ar4 = 4 ++ ++ ! Resulting array ar3 looks like ((( 111, 112, 113, 114,...))) ++ do i = 1, 9, 1 ++ ar1(i) = i ++ do j = 1, 9, 1 ++ ar2(i,j) = i*10 + j ++ do k = 1, 9, 1 ++ ar3(i,j,k) = i*100 + j*10 + k ++ end do ++ end do ++ end do ++ ++ do i = 1, 11, 1 ++ do j = -7, 3, 1 ++ do k = -15, -5, 1 ++ ar4(i,j,k) = i*100 + (j+8)*10 + (k+16) ++ end do ++ end do ++ end do ++ ++ ar1(1) = 11 !BP1 ++ return ++end ++ ++program testprog ++ call sub ++end +-- +1.7.0.7 diff --git a/gdb-vla-intel.patch b/gdb-vla-intel.patch index 925f401..edf6b23 100644 --- a/gdb-vla-intel.patch +++ b/gdb-vla-intel.patch @@ -755,24 +755,6 @@ Index: gdb-7.10.50.20160106/gdb/gdbtypes.c } /* Resolve dynamic bounds of members of the union TYPE to static -@@ -4558,6 +4622,17 @@ - gdb_assert_not_reached ("bad type_specific_kind"); - } - -+ if (TYPE_NFIELDS (type)) -+ { -+ int nfields = TYPE_NFIELDS (type); -+ -+ TYPE_FIELDS (new_type) -+ = OBSTACK_CALLOC (&TYPE_OWNER (type).objfile->objfile_obstack, -+ nfields, struct field); -+ memcpy (TYPE_FIELDS (new_type), TYPE_FIELDS (type), -+ nfields * sizeof (struct field)); -+ } -+ - return new_type; - } - Index: gdb-7.10.50.20160106/gdb/gdbtypes.h =================================================================== --- gdb-7.10.50.20160106.orig/gdb/gdbtypes.h 2016-01-08 19:15:35.085582471 +0100 diff --git a/gdb.spec b/gdb.spec index f211248..eaa16b2 100644 --- a/gdb.spec +++ b/gdb.spec @@ -27,7 +27,7 @@ Version: 7.10.50.%{snapsrc} # The release always contains a leading reserved number, start it at 1. # `upstream' is not a part of `name' to stay fully rpm dependencies compatible for the testing. -Release: 35%{?dist} +Release: 36%{?dist} License: GPLv3+ and GPLv3+ with exceptions and GPLv2+ and GPLv2+ with exceptions and GPL+ and LGPLv2+ and BSD and Public Domain and GFDL Group: Development/Debuggers @@ -520,11 +520,19 @@ Patch848: gdb-dts-rhel6-python-compat.patch Patch852: gdb-gnat-dwarf-crash-3of3.patch # VLA (Fortran dynamic arrays) from Intel + archer-jankratochvil-vla tests. +Patch1058: gdb-fortran-stride-intel-1of6.patch +Patch1059: gdb-fortran-stride-intel-2of6.patch +Patch1060: gdb-fortran-stride-intel-3of6.patch +Patch1061: gdb-fortran-stride-intel-4of6.patch +Patch1062: gdb-fortran-stride-intel-5of6.patch +Patch1063: gdb-fortran-stride-intel-6of6.patch +Patch1068: gdb-fortran-stride-intel-6of6-testcasefix.patch Patch888: gdb-vla-intel.patch Patch983: gdb-vla-intel-logical-not.patch Patch889: gdb-vla-intel-stringbt-fix.patch Patch912: gdb-vla-intel-04of23-fix.patch Patch887: gdb-archer-vla-tests.patch +Patch1069: gdb-fortran-stride-intel-6of6-nokfail.patch # Continue backtrace even if a frame filter throws an exception (Phil Muldoon). Patch918: gdb-btrobust.patch @@ -755,6 +763,13 @@ find -name "*.info*"|xargs rm -f #patch232 -p1 %patch349 -p1 +%patch1058 -p1 +%patch1059 -p1 +%patch1060 -p1 +%patch1061 -p1 +%patch1062 -p1 +%patch1063 -p1 +%patch1068 -p1 %patch888 -p1 %patch983 -p1 %patch889 -p1 @@ -852,6 +867,7 @@ find -name "*.info*"|xargs rm -f %patch852 -p1 %patch863 -p1 %patch887 -p1 +%patch1069 -p1 %patch918 -p1 %patch925 -p1 %patch927 -p1 @@ -1377,6 +1393,9 @@ then fi %changelog +* Sat Jan 9 2016 Jan Kratochvil - 7.10.50.20160106-36.fc24 +- VLA (Fortran dynamic arrays) strides (multi-dimensional subarrays) from Intel. + * Fri Jan 8 2016 Jan Kratochvil - 7.10.50.20160106-35.fc24 - Fix false FAILs on too long base directory.