+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
+
+FileName: 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/valops.c | 197 +++++++++++--
gdb/value.h | 2 +
23 files changed, 1242 insertions(+), 183 deletions(-)
+---
+ gdb/dwarf2loc.c | 46 ++-
+ gdb/dwarf2loc.h | 6 +
+ gdb/dwarf2read.c | 13 +-
+ gdb/eval.c | 391 +++++++++++++++++++++-----
+ gdb/expprint.c | 20 +-
+ gdb/expression.h | 18 +-
+ gdb/f-exp.y | 42 ++-
+ gdb/f-valprint.c | 8 +-
+ gdb/gdbtypes.c | 34 ++-
+ gdb/gdbtypes.h | 18 +-
+ gdb/parse.c | 24 +-
+ gdb/rust-exp.y | 12 +-
+ gdb/rust-lang.c | 17 +-
+ gdb/testsuite/gdb.fortran/static-arrays.exp | 421 ++++++++++++++++++++++++++++
+ gdb/testsuite/gdb.fortran/static-arrays.f90 | 55 ++++
+ gdb/testsuite/gdb.fortran/vla-ptype.exp | 4 +
+ gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +
+ gdb/testsuite/gdb.fortran/vla-stride.exp | 44 +++
+ gdb/testsuite/gdb.fortran/vla-stride.f90 | 29 ++
+ gdb/testsuite/gdb.fortran/vla.f90 | 10 +
+ gdb/valarith.c | 10 +-
+ gdb/valops.c | 199 +++++++++++--
+ gdb/value.h | 2 +
+ 23 files changed, 1245 insertions(+), 182 deletions(-)
+ create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.exp
+ create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.f90
+ create mode 100644 gdb/testsuite/gdb.fortran/vla-stride.exp
+ create mode 100644 gdb/testsuite/gdb.fortran/vla-stride.f90
-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
+index 51f133f1b5..5105c8d23a 100644
+--- a/gdb/dwarf2loc.c
++++ b/gdb/dwarf2loc.c
+@@ -2601,11 +2601,14 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
/* See dwarf2loc.h. */
int
if (prop == NULL)
return 0;
-@@ -2650,7 +2653,7 @@
+@@ -2629,7 +2632,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
*value = value_as_address (val);
}
}
}
break;
-@@ -2672,7 +2675,7 @@
+@@ -2651,7 +2654,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
if (!value_optimized_out (val))
{
*value = value_as_address (val);
}
}
}
-@@ -2680,8 +2683,8 @@
+@@ -2659,8 +2662,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 @@
+@@ -2681,11 +2684,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
+index f82e7b2d11..74f0597359 100644
+--- 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
+index 58da0fc1f9..8fc1f7ec45 100644
+--- a/gdb/dwarf2read.c
++++ b/gdb/dwarf2read.c
+@@ -17551,7 +17551,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 @@
+@@ -17571,7 +17571,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 @@
+@@ -17604,6 +17606,13 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
break;
}
attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
if (attr)
attr_to_dynamic_prop (attr, die, cu, &low);
-@@ -15397,7 +15406,7 @@
+@@ -17680,7 +17689,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
+index 6f74c41b9f..d9bca2791d 100644
+--- a/gdb/eval.c
++++ b/gdb/eval.c
+@@ -384,29 +384,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 @@
+@@ -1928,19 +2224,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 @@
+@@ -2336,49 +2621,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 @@
+@@ -3282,6 +3524,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
+index ac5ae0fea1..41bb357a27 100644
+--- a/gdb/expprint.c
++++ b/gdb/expprint.c
+@@ -581,12 +581,10 @@ print_subexp_standard (struct expression *exp, int *pos,
*pos += 2;
fputs_filtered ("RANGE(", stream);
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (")", stream);
return;
-@@ -1055,16 +1053,16 @@
+@@ -1094,16 +1092,16 @@ dump_subexp_body_standard (struct expression *exp,
switch (range_type)
{
fputs_filtered ("Range 'EXP..EXP'", stream);
break;
default:
-@@ -1072,11 +1070,9 @@
+@@ -1111,11 +1109,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
+index a783ea5fef..be24792eb6 100644
+--- a/gdb/expression.h
++++ b/gdb/expression.h
+@@ -153,17 +153,17 @@ extern void dump_raw_expression (struct expression *,
struct ui_file *, const char *);
extern void dump_prefix_expression (struct expression *, struct ui_file *);
};
#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
+index 6495e03cc5..cd89bb7ca2 100644
+--- 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
+index 903f2af638..b4067a8460 100644
+--- a/gdb/f-valprint.c
++++ b/gdb/f-valprint.c
+@@ -119,8 +119,14 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
if (nss != ndimensions)
{
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
+index 43fe56e487..a72e2b3e0a 100644
+--- 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 @@
+@@ -1992,12 +2002,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 @@
+@@ -2009,7 +2019,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 @@
+@@ -2024,12 +2034,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
+index 92ca85c295..179238ce82 100644
+--- a/gdb/gdbtypes.h
++++ b/gdb/gdbtypes.h
+@@ -560,6 +560,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 @@
+@@ -731,7 +735,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 @@
+@@ -1253,6 +1256,15 @@ extern void allocate_gnat_aux_type (struct type *);
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 @@
+@@ -1287,6 +1299,9 @@ extern void allocate_gnat_aux_type (struct type *);
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 @@
+@@ -1818,6 +1833,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
+index 8b2bb22c76..e1bf3edbe2 100644
+--- a/gdb/parse.c
++++ b/gdb/parse.c
+@@ -984,22 +984,20 @@ operator_length_standard (const struct expression *expr, int endpos,
case OP_RANGE:
oplen = 3;
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
+index 199e87671e..397a92dfdb 100644
+--- a/gdb/rust-exp.y
++++ b/gdb/rust-exp.y
+@@ -2448,23 +2448,17 @@ convert_ast_to_expression (struct parser_state *state,
case OP_RANGE:
{
}
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 @@
+diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c
+index f7bec33a42..cb924e084d 100644
+--- a/gdb/rust-lang.c
++++ b/gdb/rust-lang.c
+@@ -1366,9 +1366,9 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst);
*pos += 3;
high = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
-@@ -1405,7 +1405,7 @@
+@@ -1457,7 +1457,7 @@ rust_compute_range (struct type *type, struct value *range,
*low = 0;
*high = 0;
if (TYPE_NFIELDS (type) == 0)
return;
-@@ -1413,15 +1413,14 @@
+@@ -1465,15 +1465,14 @@ rust_compute_range (struct type *type, struct value *range,
i = 0;
if (strcmp (TYPE_FIELD_NAME (type, 0), "start") == 0)
{
*high = value_as_long (value_field (range, i));
}
}
-@@ -1436,7 +1435,7 @@
+@@ -1488,7 +1487,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 @@
+@@ -1586,7 +1585,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 @@
+@@ -1604,7 +1603,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
+index 0000000000..cc9ecc04ab
+--- /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
+index 0000000000..f22fcbe124
+--- /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
+index 5f367348b0..5351a0aa2e 100644
+--- 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
+index 3113983ba4..83bc849619 100644
+--- 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
+index 0000000000..dcf15e5daf
+--- /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
+index 0000000000..8d2425222e
+--- /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
+index 508290a36e..d87f59b92b 100644
+--- 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
+index 58e3a09c37..035def5466 100644
+--- a/gdb/valarith.c
++++ b/gdb/valarith.c
+@@ -189,10 +189,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
+index 9525dc8499..4cd4fd96ae 100644
+--- a/gdb/valops.c
++++ b/gdb/valops.c
+@@ -3776,56 +3776,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
+index 7dc67dc721..03ca06448f 100644
+--- a/gdb/value.h
++++ b/gdb/value.h
+@@ -1128,6 +1128,8 @@ extern struct value *varying_to_slice (struct value *);
extern struct value *value_slice (struct value *, int, int);
extern struct value *value_literal_complex (struct value *, struct value *,
struct type *);
+--
+2.14.3
+
projects / packages / gdb.git / blobdiff