+From FEDORA_PATCHES Mon Sep 17 00:00:00 2001
+From: Fedora GDB patches <invalid@email.com>
+Date: Fri, 27 Oct 2017 21:07:50 +0200
+Subject: gdb-vla-intel-fortran-strides.patch
+
+;; VLA (Fortran dynamic arrays) from Intel + archer-jankratochvil-vla tests.
+;;=push
+
git diff --stat -p gdb/master...gdb/users/bheckel/fortran-strides
dbfd7140bf4c0500d1f5d192be781f83f78f7922
gdb/value.h | 2 +
23 files changed, 1242 insertions(+), 183 deletions(-)
-Index: gdb-7.99.90.20170420/gdb/dwarf2loc.c
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/dwarf2loc.c 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/dwarf2loc.c 2017-04-20 22:26:14.356446562 +0200
-@@ -2622,11 +2622,14 @@
+diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c
+--- a/gdb/dwarf2loc.c
++++ b/gdb/dwarf2loc.c
+@@ -2600,11 +2600,14 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
/* See dwarf2loc.h. */
int
if (prop == NULL)
return 0;
-@@ -2650,7 +2653,7 @@
+@@ -2628,7 +2631,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
*value = value_as_address (val);
}
}
}
break;
-@@ -2672,7 +2675,7 @@
+@@ -2650,7 +2653,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
if (!value_optimized_out (val))
{
*value = value_as_address (val);
}
}
}
-@@ -2680,8 +2683,8 @@
+@@ -2658,8 +2661,8 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
case PROP_CONST:
*value = prop->data.const_val;
case PROP_ADDR_OFFSET:
{
struct dwarf2_property_baton *baton
-@@ -2702,11 +2705,38 @@
+@@ -2680,11 +2683,38 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
val = value_at (baton->offset_info.type,
pinfo->addr + baton->offset_info.offset);
*value = value_as_address (val);
+ rc = 1;
}
+ break;
-+ }
-+
+ }
+
+- return 0;
+ if (rc == 1 && is_signed == 1)
+ {
+ /* If we have a valid return candidate and it's value is signed,
+ /* Check if signed bit is set and sign-extend values. */
+ if (*value & (neg_mask))
+ *value |= (neg_mask );
- }
++ }
+ return rc;
+}
-
-- return 0;
++
+int
+dwarf2_evaluate_property (const struct dynamic_prop *prop,
+ struct frame_info *frame,
}
/* See dwarf2loc.h. */
-Index: gdb-7.99.90.20170420/gdb/dwarf2loc.h
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/dwarf2loc.h 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/dwarf2loc.h 2017-04-20 22:26:14.356446562 +0200
-@@ -143,6 +143,12 @@
+diff --git a/gdb/dwarf2loc.h b/gdb/dwarf2loc.h
+--- a/gdb/dwarf2loc.h
++++ b/gdb/dwarf2loc.h
+@@ -143,6 +143,12 @@ int dwarf2_evaluate_property (const struct dynamic_prop *prop,
struct property_addr_info *addr_stack,
CORE_ADDR *value);
/* A helper for the compiler interface that compiles a single dynamic
property to C code.
-Index: gdb-7.99.90.20170420/gdb/dwarf2read.c
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/dwarf2read.c 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/dwarf2read.c 2017-04-20 22:27:08.510788562 +0200
-@@ -15268,7 +15268,7 @@
+diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
+--- a/gdb/dwarf2read.c
++++ b/gdb/dwarf2read.c
+@@ -17566,7 +17566,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;
int low_default_is_valid;
int high_bound_is_count = 0;
const char *name;
-@@ -15288,7 +15288,9 @@
+@@ -17586,7 +17586,9 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
low.kind = PROP_CONST;
high.kind = PROP_CONST;
/* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow
omitting DW_AT_lower_bound. */
-@@ -15321,6 +15323,13 @@
+@@ -17619,6 +17621,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 (&symfile_complaints, _("Missing DW_AT_byte_stride "
-+ "- DIE at 0x%x [in module %s]"),
-+ to_underlying (die->sect_off), objfile_name (cu->objfile));
++ 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);
-@@ -15397,7 +15406,7 @@
+@@ -17696,7 +17706,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;
if (high_bound_is_count)
TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1;
-Index: gdb-7.99.90.20170420/gdb/eval.c
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/eval.c 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/eval.c 2017-04-20 22:26:14.362446600 +0200
-@@ -379,29 +379,325 @@
+diff --git a/gdb/eval.c b/gdb/eval.c
+--- a/gdb/eval.c
++++ b/gdb/eval.c
+@@ -377,29 +377,325 @@ init_array_element (struct value *array, struct value *element,
return index;
}
- = (enum range_type) longest_to_int (exp->elts[pc].longconst);
-
- *pos += 3;
+-
+- 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));
+ struct value *new_array = array;
+ struct type *array_type = check_typedef (value_type (new_array));
+ struct type *elt_type;
+ {
+ struct subscript_store *index = &subscript_array[i];
-- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
-- low_bound = TYPE_LOW_BOUND (range);
+- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+- high_bound = TYPE_HIGH_BOUND (range);
- else
-- low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+- high_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_RANGE)
+ {
+ int pc = (*pos) + 1;
+ subscript_range *range;
-
-- 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_RANGE;
+ range = &index->U.range;
+
+
+ case SUBSCRIPT_INDEX:
+ break;
-
-- return value_slice (array, low_bound, high_bound - low_bound + 1);
++
+ }
+
+ array_type = TYPE_TARGET_TYPE (array_type);
+ struct type *range_type, *interim_array_type;
+
+ int new_length;
-+
+
+- return value_slice (array, low_bound, high_bound - low_bound + 1);
+ /* 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. */
}
-@@ -1790,19 +2086,8 @@
+@@ -1926,19 +2222,8 @@ evaluate_subexp_standard (struct type *expect_type,
switch (code)
{
case TYPE_CODE_ARRAY:
case TYPE_CODE_PTR:
case TYPE_CODE_FUNC:
-@@ -2203,49 +2488,6 @@
+@@ -2334,49 +2619,6 @@ evaluate_subexp_standard (struct type *expect_type,
}
return (arg1);
case BINOP_LOGICAL_AND:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
-@@ -3102,6 +3344,9 @@
+@@ -3293,6 +3535,9 @@ calc_f77_array_dims (struct type *array_type)
int ndimen = 1;
struct type *tmp_type;
if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
error (_("Can't get dimensions for a non-array type"));
-Index: gdb-7.99.90.20170420/gdb/expprint.c
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/expprint.c 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/expprint.c 2017-04-20 22:26:14.363446607 +0200
-@@ -568,12 +568,10 @@
+diff --git a/gdb/expprint.c b/gdb/expprint.c
+--- a/gdb/expprint.c
++++ b/gdb/expprint.c
+@@ -578,17 +578,14 @@ print_subexp_standard (struct expression *exp, int *pos,
+ longest_to_int (exp->elts[pc + 1].longconst);
*pos += 2;
+- if (range_type == NONE_BOUND_DEFAULT_EXCLUSIVE
+- || range_type == LOW_BOUND_DEFAULT_EXCLUSIVE)
++ if ((range_type & SUBARRAY_HIGH_BOUND_EXCLUSIVE)
++ == SUBARRAY_HIGH_BOUND_EXCLUSIVE)
+ fputs_filtered ("EXCLUSIVE_", stream);
fputs_filtered ("RANGE(", stream);
- if (range_type == HIGH_BOUND_DEFAULT
-- || range_type == NONE_BOUND_DEFAULT)
+- || range_type == NONE_BOUND_DEFAULT
+- || range_type == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered ("..", stream);
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (")", stream);
return;
-@@ -1055,16 +1053,16 @@
+@@ -1098,22 +1095,24 @@ dump_subexp_body_standard (struct expression *exp,
switch (range_type)
{
+ case SUBARRAY_HIGH_BOUND:
fputs_filtered ("Range '..EXP'", stream);
break;
+- case LOW_BOUND_DEFAULT_EXCLUSIVE:
+- fputs_filtered ("ExclusiveRange '..EXP'", stream);
+- break;
- case HIGH_BOUND_DEFAULT:
+ case SUBARRAY_LOW_BOUND:
fputs_filtered ("Range 'EXP..'", stream);
break;
- case NONE_BOUND_DEFAULT:
++ case (SUBARRAY_LOW_BOUND
++ | SUBARRAY_HIGH_BOUND
++ | SUBARRAY_HIGH_BOUND_EXCLUSIVE):
++ fputs_filtered ("ExclusiveRange '..EXP'", stream);
++ break;
+ case (SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND):
fputs_filtered ("Range 'EXP..EXP'", stream);
break;
+- case NONE_BOUND_DEFAULT_EXCLUSIVE:
++ case (SUBARRAY_HIGH_BOUND | SUBARRAY_HIGH_BOUND_EXCLUSIVE):
+ fputs_filtered ("ExclusiveRange 'EXP..EXP'", stream);
+ break;
default:
-@@ -1072,11 +1070,9 @@
+@@ -1121,11 +1120,9 @@ dump_subexp_body_standard (struct expression *exp,
break;
}
elt = dump_subexp (exp, stream, elt);
}
break;
-Index: gdb-7.99.90.20170420/gdb/expression.h
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/expression.h 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/expression.h 2017-04-20 22:26:14.363446607 +0200
-@@ -154,17 +154,17 @@
+diff --git a/gdb/expression.h b/gdb/expression.h
+--- a/gdb/expression.h
++++ b/gdb/expression.h
+@@ -148,28 +148,27 @@ extern void dump_raw_expression (struct expression *,
struct ui_file *, const char *);
extern void dump_prefix_expression (struct expression *, struct ui_file *);
-/* In an OP_RANGE expression, either bound could be empty, indicating
- that its value is by default that of the corresponding bound of the
-- array or string. So we have four sorts of subrange. This
-- enumeration type is to identify this. */
--
-+/* In an OP_RANGE expression, either bound can be provided by the user, or not.
-+ In addition to this, the user can also specify a stride value to indicated
-+ only certain elements of the array. This enumeration type is to identify
-+ this. */
-+
+- array or string. Also, the upper end of the range can be exclusive
+- or inclusive. So we have six sorts of subrange. This enumeration
+- type is to identify this. */
++/* In an OP_RANGE expression, either bound can be provided by the
++ user, or not. In addition to this, the user can also specify a
++ stride value to indicated only certain elements of the array.
++ Also, the upper end of the range can be exclusive or inclusive.
++ This enumeration type is to identify this. */
+
enum range_type
- {
-- BOTH_BOUND_DEFAULT, /* "(:)" */
-- LOW_BOUND_DEFAULT, /* "(:high)" */
-- HIGH_BOUND_DEFAULT, /* "(low:)" */
-- NONE_BOUND_DEFAULT /* "(low:high)" */
+-{
+- /* Neither the low nor the high bound was given -- so this refers to
+- the entire available range. */
+- BOTH_BOUND_DEFAULT,
+- /* The low bound was not given and the high bound is inclusive. */
+- LOW_BOUND_DEFAULT,
+- /* The high bound was not given and the low bound in inclusive. */
+- HIGH_BOUND_DEFAULT,
+- /* Both bounds were given and both are inclusive. */
+- NONE_BOUND_DEFAULT,
+- /* The low bound was not given and the high bound is exclusive. */
+- NONE_BOUND_DEFAULT_EXCLUSIVE,
+- /* Both bounds were given. The low bound is inclusive and the high
+- bound is exclusive. */
+- LOW_BOUND_DEFAULT_EXCLUSIVE,
+-};
++ {
+ SUBARRAY_NONE_BOUND = 0x0, /* "( : )" */
+ SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" */
+ SUBARRAY_HIGH_BOUND = 0x2, /* "(:high)" */
-+ SUBARRAY_STRIDE = 0x4 /* "(::stride)" */
- };
++ SUBARRAY_STRIDE = 0x4, /* "(::stride)" */
++ /* The low bound was not given and the high bound is exclusive.
++ In this case we always use (SUBARRAY_HIGH_BOUND |
++ SUBARRAY_HIGH_BOUND_EXCLUSIVE). */
++ SUBARRAY_HIGH_BOUND_EXCLUSIVE = 0x8,
++ /* Both bounds were given. The low bound is inclusive and the high
++ bound is exclusive. In this case, we use (SUBARRAY_LOW_BOUND |
++ SUBARRAY_HIGH_BOUND | SUBARRAY_HIGH_BOUND_EXCLUSIVE). */
++ // SUBARRAY_LOW_BOUND_EXCLUSIVE = (SUBARRAY_LOW_BOUND
++ // | SUBARRAY_HIGH_BOUND_EXCLUSIVE),
++ };
#endif /* !defined (EXPRESSION_H) */
-Index: gdb-7.99.90.20170420/gdb/f-exp.y
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/f-exp.y 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/f-exp.y 2017-04-20 22:26:14.363446607 +0200
-@@ -254,31 +254,63 @@
+diff --git a/gdb/f-exp.y b/gdb/f-exp.y
+--- a/gdb/f-exp.y
++++ b/gdb/f-exp.y
+@@ -257,31 +257,63 @@ arglist : subrange
arglist : arglist ',' exp %prec ABOVE_COMMA
{ arglist_len++; }
write_exp_elt_opcode (pstate, OP_RANGE); }
;
-Index: gdb-7.99.90.20170420/gdb/f-valprint.c
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/f-valprint.c 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/f-valprint.c 2017-04-20 22:26:14.364446613 +0200
-@@ -121,8 +121,14 @@
+diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
+--- 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)
{
for (i = lowerbound;
(i < upperbound + 1 && (*elts) < options->print_max);
-Index: gdb-7.99.90.20170420/gdb/gdbtypes.c
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/gdbtypes.c 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/gdbtypes.c 2017-04-20 22:26:14.365446619 +0200
-@@ -862,7 +862,8 @@
+diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
+--- a/gdb/gdbtypes.c
++++ b/gdb/gdbtypes.c
+@@ -902,7 +902,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,
{
if (result_type == NULL)
result_type = alloc_type_copy (index_type);
-@@ -877,6 +878,7 @@
+@@ -917,6 +918,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;
if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0)
TYPE_UNSIGNED (result_type) = 1;
-@@ -905,7 +907,7 @@
+@@ -945,7 +947,7 @@ struct type *
create_static_range_type (struct type *result_type, struct type *index_type,
LONGEST low_bound, LONGEST high_bound)
{
low.kind = PROP_CONST;
low.data.const_val = low_bound;
-@@ -913,7 +915,11 @@
+@@ -953,7 +955,11 @@ create_static_range_type (struct type *result_type, struct type *index_type,
high.kind = PROP_CONST;
high.data.const_val = high_bound;
return result_type;
}
-@@ -1110,16 +1116,20 @@
+@@ -1171,16 +1177,20 @@ create_array_type_with_stride (struct type *result_type,
&& (!type_not_associated (result_type)
&& !type_not_allocated (result_type)))
{
else if (bit_stride > 0)
TYPE_LENGTH (result_type) =
(bit_stride * (high_bound - low_bound + 1) + 7) / 8;
-@@ -1912,12 +1922,12 @@
+@@ -1981,12 +1991,12 @@ resolve_dynamic_range (struct type *dyn_range_type,
CORE_ADDR value;
struct type *static_range_type, *static_target_type;
const struct dynamic_prop *prop;
{
low_bound.kind = PROP_CONST;
low_bound.data.const_val = value;
-@@ -1929,7 +1939,7 @@
+@@ -1998,7 +2008,7 @@ resolve_dynamic_range (struct type *dyn_range_type,
}
prop = &TYPE_RANGE_DATA (dyn_range_type)->high;
{
high_bound.kind = PROP_CONST;
high_bound.data.const_val = value;
-@@ -1944,12 +1954,20 @@
+@@ -2013,12 +2023,20 @@ resolve_dynamic_range (struct type *dyn_range_type,
high_bound.data.const_val = 0;
}
TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
return static_range_type;
}
-Index: gdb-7.99.90.20170420/gdb/gdbtypes.h
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/gdbtypes.h 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/gdbtypes.h 2017-04-20 22:26:14.365446619 +0200
-@@ -551,6 +551,10 @@
+diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
+--- a/gdb/gdbtypes.h
++++ b/gdb/gdbtypes.h
+@@ -612,6 +612,10 @@ struct range_bounds
struct dynamic_prop high;
/* True if HIGH range bound contains the number of elements in the
subrange. This affects how the final hight bound is computed. */
-@@ -713,7 +717,6 @@
+@@ -776,7 +780,6 @@ struct main_type
/* * Union member used for range types. */
struct range_bounds *bounds;
} flds_bnds;
/* * Slot to point to additional language-specific fields of this
-@@ -1228,6 +1231,15 @@
+@@ -1329,6 +1332,15 @@ 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
/* Property accessors for the type data location. */
#define TYPE_DATA_LOCATION(thistype) \
-@@ -1262,6 +1274,9 @@
+@@ -1363,6 +1375,9 @@ 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_UPPER_BOUND_VALUE(arraytype) \
(TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype))))
-@@ -1776,6 +1791,7 @@
+@@ -1892,6 +1907,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 *,
const struct dynamic_prop *);
- extern struct type *create_array_type (struct type *, struct type *,
-Index: gdb-7.99.90.20170420/gdb/parse.c
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/parse.c 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/parse.c 2017-04-20 22:26:14.366446625 +0200
-@@ -1007,22 +1007,20 @@
+diff --git a/gdb/parse.c b/gdb/parse.c
+--- a/gdb/parse.c
++++ b/gdb/parse.c
+@@ -989,24 +989,20 @@ operator_length_standard (const struct expression *expr, int endpos,
case OP_RANGE:
oplen = 3;
- switch (range_type)
- {
- case LOW_BOUND_DEFAULT:
+- case LOW_BOUND_DEFAULT_EXCLUSIVE:
- case HIGH_BOUND_DEFAULT:
- args = 1;
- break;
- args = 0;
- break;
- case NONE_BOUND_DEFAULT:
+- case NONE_BOUND_DEFAULT_EXCLUSIVE:
- args = 2;
- break;
- }
break;
-Index: gdb-7.99.90.20170420/gdb/rust-exp.y
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/rust-exp.y 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/rust-exp.y 2017-04-20 22:26:14.366446625 +0200
-@@ -2409,23 +2409,17 @@
+diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y
+--- a/gdb/rust-exp.y
++++ b/gdb/rust-exp.y
+@@ -2478,24 +2478,28 @@ convert_ast_to_expression (struct parser_state *state,
case OP_RANGE:
{
{
convert_ast_to_expression (state, operation->right.op, top);
- if (kind == BOTH_BOUND_DEFAULT)
-- kind = LOW_BOUND_DEFAULT;
-- else
-- {
+- kind = (operation->inclusive
+- ? LOW_BOUND_DEFAULT : LOW_BOUND_DEFAULT_EXCLUSIVE);
++ if (kind == SUBARRAY_NONE_BOUND)
++ {
++ kind = (range_type) SUBARRAY_HIGH_BOUND;
++ if (!operation->inclusive)
++ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND_EXCLUSIVE);
++ }
+ else
+ {
- gdb_assert (kind == HIGH_BOUND_DEFAULT);
-- kind = NONE_BOUND_DEFAULT;
-- }
-+ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND);
+- kind = (operation->inclusive
+- ? NONE_BOUND_DEFAULT : NONE_BOUND_DEFAULT_EXCLUSIVE);
++ gdb_assert (kind == SUBARRAY_LOW_BOUND);
++ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND);
++ if (!operation->inclusive)
++ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND_EXCLUSIVE);
+ }
}
- write_exp_elt_opcode (state, OP_RANGE);
- write_exp_elt_longcst (state, kind);
-Index: gdb-7.99.90.20170420/gdb/rust-lang.c
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/rust-lang.c 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/rust-lang.c 2017-04-20 22:26:14.367446632 +0200
-@@ -1314,9 +1314,9 @@
+ else
+diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c
+--- a/gdb/rust-lang.c
++++ b/gdb/rust-lang.c
+@@ -1149,13 +1149,11 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst);
*pos += 3;
-- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT)
+- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT
+- || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if ((kind & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
low = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-- if (kind == LOW_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT)
+- if (kind == LOW_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT_EXCLUSIVE
+- || kind == NONE_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if ((kind & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
high = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+- bool inclusive = (kind == NONE_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT);
++ bool inclusive = (!((kind & SUBARRAY_HIGH_BOUND_EXCLUSIVE) == SUBARRAY_HIGH_BOUND_EXCLUSIVE));
if (noside == EVAL_SKIP)
-@@ -1405,7 +1405,7 @@
+ return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
+@@ -1244,7 +1242,7 @@ rust_compute_range (struct type *type, struct value *range,
*low = 0;
*high = 0;
if (TYPE_NFIELDS (type) == 0)
return;
-@@ -1413,15 +1413,14 @@
+@@ -1252,15 +1250,14 @@ rust_compute_range (struct type *type, struct value *range,
i = 0;
if (strcmp (TYPE_FIELD_NAME (type, 0), "start") == 0)
{
- ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT);
+ *kind = (range_type) (*kind | SUBARRAY_HIGH_BOUND);
*high = value_as_long (value_field (range, i));
- }
- }
-@@ -1436,7 +1435,7 @@
+
+ if (rust_inclusive_range_type_p (type))
+@@ -1278,7 +1275,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
struct type *rhstype;
LONGEST low, high_bound;
/* Initialized to appease the compiler. */
LONGEST high = 0;
int want_slice = 0;
-@@ -1498,7 +1497,7 @@
+@@ -1376,7 +1373,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
error (_("Cannot subscript non-array type"));
if (want_slice
low = low_bound;
if (low < 0)
error (_("Index less than zero"));
-@@ -1516,7 +1515,7 @@
+@@ -1394,7 +1391,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
CORE_ADDR addr;
struct value *addrval, *tem;
high = high_bound;
if (high < 0)
error (_("High index less than zero"));
-Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/static-arrays.exp
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/static-arrays.exp 2017-04-20 22:26:14.367446632 +0200
+diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp
+new file mode 100644
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/static-arrays.exp
@@ -0,0 +1,421 @@
+# Copyright 2015 Free Software Foundation, Inc.
+#
+gdb_test "print ar1\(3:7\) = 42" \
+ "Invalid cast." \
+ "Assignment of value to subarray"
-Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/static-arrays.f90
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/static-arrays.f90 2017-04-20 22:26:14.368446638 +0200
+diff --git a/gdb/testsuite/gdb.fortran/static-arrays.f90 b/gdb/testsuite/gdb.fortran/static-arrays.f90
+new file mode 100644
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/static-arrays.f90
@@ -0,0 +1,55 @@
+! Copyright 2015 Free Software Foundation, Inc.
+!
+program testprog
+ call sub
+end
-Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-ptype.exp
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.fortran/vla-ptype.exp 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-ptype.exp 2017-04-20 22:26:14.368446638 +0200
-@@ -98,3 +98,7 @@
+diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp
+--- a/gdb/testsuite/gdb.fortran/vla-ptype.exp
++++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp
+@@ -98,3 +98,7 @@ gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated"
gdb_test "ptype vla2(5, 45, 20)" \
"no such vector element \\\(vector not allocated\\\)" \
"ptype vla2(5, 45, 20) not allocated"
+gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds"]
+gdb_continue_to_breakpoint "vla1-neg-bounds"
+gdb_test "ptype vla1" "type = $real \\(-2:1,-5:4,-3:-1\\)" "ptype vla1 negative bounds"
-Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-sizeof.exp
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.fortran/vla-sizeof.exp 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-sizeof.exp 2017-04-20 22:26:14.368446638 +0200
-@@ -44,3 +44,7 @@
+diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+--- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
++++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+@@ -44,3 +44,7 @@ gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
gdb_breakpoint [gdb_get_line_number "pvla-associated"]
gdb_continue_to_breakpoint "pvla-associated"
gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
+gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds"]
+gdb_continue_to_breakpoint "vla1-neg-bounds"
+gdb_test "print sizeof(vla1)" " = 480" "print sizeof vla1 negative bounds"
-Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-stride.exp
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-stride.exp 2017-04-20 22:26:14.368446638 +0200
+diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp
+new file mode 100644
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-stride.exp
@@ -0,0 +1,44 @@
+# Copyright 2016 Free Software Foundation, Inc.
+
+gdb_continue_to_breakpoint "single-element"
+gdb_test "print pvla" " = \\\(5\\\)" "print single-element"
+gdb_test "print pvla(1)" " = 5" "print one single-element"
-Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-stride.f90
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-stride.f90 2017-04-20 22:26:14.368446638 +0200
+diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90
+new file mode 100644
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-stride.f90
@@ -0,0 +1,29 @@
+! Copyright 2016 Free Software Foundation, Inc.
+!
+
+ pvla => null() ! single-element
+end program vla_stride
-Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla.f90
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.fortran/vla.f90 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla.f90 2017-04-20 22:26:14.368446638 +0200
-@@ -54,4 +54,14 @@
+diff --git a/gdb/testsuite/gdb.fortran/vla.f90 b/gdb/testsuite/gdb.fortran/vla.f90
+--- a/gdb/testsuite/gdb.fortran/vla.f90
++++ b/gdb/testsuite/gdb.fortran/vla.f90
+@@ -54,4 +54,14 @@ program vla
allocate (vla3 (2,2)) ! vla2-deallocated
vla3(:,:) = 13
+ l = allocated(vla1)
+
end program vla
-Index: gdb-7.99.90.20170420/gdb/valarith.c
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/valarith.c 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/valarith.c 2017-04-20 22:26:14.369446644 +0200
-@@ -193,10 +193,16 @@
+diff --git a/gdb/valarith.c b/gdb/valarith.c
+--- a/gdb/valarith.c
++++ b/gdb/valarith.c
+@@ -187,10 +187,16 @@ 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);
{
if (type_not_associated (array_type))
error (_("no such vector element (vector not associated)"));
-Index: gdb-7.99.90.20170420/gdb/valops.c
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/valops.c 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/valops.c 2017-04-20 22:26:14.370446651 +0200
-@@ -3786,55 +3786,194 @@
+diff --git a/gdb/valops.c b/gdb/valops.c
+--- a/gdb/valops.c
++++ b/gdb/valops.c
+@@ -3808,56 +3808,195 @@ 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 default stride
+ value of '1', which returns every element between LOWBOUND and
+ (LOWBOUND + LENGTH). We also provide a default CALL_COUNT of '1'
+struct value *
+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;
- LONGEST lowerbound, upperbound;
- struct value *slice;
- range_type = TYPE_INDEX_TYPE (array_type);
- if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
- error (_("slice from bad array or bitstring"));
--
-- if (lowbound < lowerbound || length < 0
-- || lowbound + length - 1 > upperbound)
-- error (_("slice out of range"));
+ ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (array_type));
+ ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (array_type));
+
+
+ elt_size = TYPE_LENGTH (elt_type);
+ elt_offs = lowbound - ary_low_bound;
-+
+
+- if (lowbound < lowerbound || length < 0
+- || lowbound + length - 1 > upperbound)
+- error (_("slice out of range"));
+ elt_offs *= elt_size;
+
+ /* Check for valid user input. In case of Fortran this was already done
- struct type *element_type = TYPE_TARGET_TYPE (array_type);
- LONGEST offset
- = (lowbound - lowerbound) * TYPE_LENGTH (check_typedef (element_type));
--
-- slice_type = create_array_type ((struct type *) NULL,
-- element_type,
-- slice_range_type);
-- TYPE_CODE (slice_type) = TYPE_CODE (array_type);
+ struct type *element_type;
+
+ /* When both CALL_COUNT and STRIDE_LENGTH equal 1, we can use the legacy
+ element_type = TYPE_TARGET_TYPE (array_type);
+
+ slice_type = create_array_type (NULL, element_type, slice_range_type);
-+
+
+- slice_type = create_array_type ((struct type *) NULL,
+- element_type,
+- slice_range_type);
+- TYPE_CODE (slice_type) = TYPE_CODE (array_type);
+ TYPE_CODE (slice_type) = TYPE_CODE (array_type);
-+
+
+- if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
+- slice = allocate_value_lazy (slice_type);
+ if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
+ v = allocate_value_lazy (slice_type);
+ else
+ 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);
++
+ }
+ /* 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
}
/* Create a value for a FORTRAN complex number. Currently most of the
-Index: gdb-7.99.90.20170420/gdb/value.h
-===================================================================
---- gdb-7.99.90.20170420.orig/gdb/value.h 2017-04-20 22:25:43.973254685 +0200
-+++ gdb-7.99.90.20170420/gdb/value.h 2017-04-20 22:26:14.370446651 +0200
-@@ -1106,6 +1106,8 @@
+diff --git a/gdb/value.h b/gdb/value.h
+--- a/gdb/value.h
++++ b/gdb/value.h
+@@ -1139,6 +1139,8 @@ extern struct value *varying_to_slice (struct value *);
extern struct value *value_slice (struct value *, int, int);