gdb/value.h | 2 +
23 files changed, 1242 insertions(+), 183 deletions(-)
-diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c
---- a/gdb/dwarf2loc.c
-+++ b/gdb/dwarf2loc.c
-@@ -2429,11 +2429,14 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
- /* See dwarf2loc.h. */
-
- int
--dwarf2_evaluate_property (const struct dynamic_prop *prop,
-+dwarf2_evaluate_property_signed (const struct dynamic_prop *prop,
- struct frame_info *frame,
- struct property_addr_info *addr_stack,
-- CORE_ADDR *value)
-+ CORE_ADDR *value,
-+ int is_signed)
- {
-+ int rc = 0;
-+
- if (prop == NULL)
- return 0;
-
-@@ -2457,7 +2460,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
-
- *value = value_as_address (val);
- }
-- return 1;
-+ rc = 1;
- }
- }
- break;
-@@ -2479,7 +2482,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
- if (!value_optimized_out (val))
- {
- *value = value_as_address (val);
-- return 1;
-+ rc = 1;
- }
- }
- }
-@@ -2487,8 +2490,8 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
-
- case PROP_CONST:
- *value = prop->data.const_val;
-- return 1;
--
-+ rc = 1;
-+ break;
- case PROP_ADDR_OFFSET:
- {
- struct dwarf2_property_baton *baton
-@@ -2509,11 +2512,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);
-- return 1;
-+ rc = 1;
- }
-+ break;
- }
-
-- return 0;
-+ if (rc == 1 && is_signed == 1)
-+ {
-+ /* If we have a valid return candidate and it's value is signed,
-+ we have to sign-extend the value because CORE_ADDR on 64bit machine has
-+ 8 bytes but address size of an 32bit application is 4 bytes. */
-+ struct gdbarch * gdbarch = target_gdbarch ();
-+ const int addr_bit = gdbarch_addr_bit (gdbarch);
-+ const CORE_ADDR neg_mask = ((~0) << (addr_bit - 1));
-+
-+ /* Check if signed bit is set and sign-extend values. */
-+ if (*value & (neg_mask))
-+ *value |= (neg_mask );
-+ }
-+ return rc;
-+}
-+
-+int
-+dwarf2_evaluate_property (const struct dynamic_prop *prop,
-+ struct frame_info *frame,
-+ struct property_addr_info *addr_stack,
-+ CORE_ADDR *value)
-+{
-+ return dwarf2_evaluate_property_signed (prop,
-+ frame,
-+ addr_stack,
-+ value,
-+ 0);
- }
-
- /* See dwarf2loc.h. */
-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);
-
-+int dwarf2_evaluate_property_signed (const struct dynamic_prop *prop,
-+ struct frame_info *frame,
-+ struct property_addr_info *addr_stack,
-+ CORE_ADDR *value,
-+ int is_signed);
-+
- /* A helper for the compiler interface that compiles a single dynamic
- property to C code.
-
-diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
---- a/gdb/dwarf2read.c
-+++ b/gdb/dwarf2read.c
-@@ -17752,7 +17752,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
- struct type *base_type, *orig_base_type;
- struct type *range_type;
- struct attribute *attr;
-- struct dynamic_prop low, high;
-+ struct dynamic_prop low, high, stride;
- int low_default_is_valid;
- int high_bound_is_count = 0;
- const char *name;
-@@ -17772,7 +17772,9 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
-
- low.kind = PROP_CONST;
- high.kind = PROP_CONST;
-+ stride.kind = PROP_CONST;
- high.data.const_val = 0;
-+ stride.data.const_val = 0;
-
- /* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow
- omitting DW_AT_lower_bound. */
-@@ -17805,6 +17807,14 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
- break;
- }
-
-+ attr = dwarf2_attr (die, DW_AT_byte_stride, cu);
-+ if (attr)
-+ if (!attr_to_dynamic_prop (attr, die, cu, &stride))
-+ complaint (_("Missing DW_AT_byte_stride "
-+ "- DIE at 0x%s [in module %s]"),
-+ sect_offset_str (die->sect_off),
-+ objfile_name (cu->per_cu->dwarf2_per_objfile->objfile));
-+
- attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
- if (attr)
- attr_to_dynamic_prop (attr, die, cu, &low);
-@@ -17897,7 +17907,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
- && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask))
- high.data.const_val |= negative_mask;
-
-- range_type = create_range_type (NULL, orig_base_type, &low, &high);
-+ range_type = create_range_type (NULL, orig_base_type, &low, &high, &stride);
-
- if (high_bound_is_count)
- TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1;
diff --git a/gdb/eval.c b/gdb/eval.c
--- a/gdb/eval.c
+++ b/gdb/eval.c
-@@ -377,29 +377,324 @@ init_array_element (struct value *array, struct value *element,
+@@ -372,29 +372,324 @@ init_array_element (struct value *array, struct value *element,
return index;
}
}
-@@ -1242,19 +1537,6 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos,
+@@ -1235,19 +1530,6 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos,
return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type);
}
struct value *
evaluate_subexp_standard (struct type *expect_type,
struct expression *exp, int *pos,
-@@ -1949,33 +2231,8 @@ evaluate_subexp_standard (struct type *expect_type,
+@@ -1942,33 +2224,8 @@ evaluate_subexp_standard (struct type *expect_type,
switch (code)
{
case TYPE_CODE_ARRAY:
case TYPE_CODE_PTR:
case TYPE_CODE_FUNC:
-@@ -2372,49 +2629,6 @@ evaluate_subexp_standard (struct type *expect_type,
+@@ -2388,49 +2645,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)
-@@ -3334,6 +3548,9 @@ calc_f77_array_dims (struct type *array_type)
+@@ -3350,6 +3564,9 @@ calc_f77_array_dims (struct type *array_type)
int ndimen = 1;
struct type *tmp_type;
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,
+@@ -580,17 +580,14 @@ print_subexp_standard (struct expression *exp, int *pos,
longest_to_int (exp->elts[pc + 1].longconst);
*pos += 2;
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (")", stream);
return;
-@@ -1105,22 +1102,24 @@ dump_subexp_body_standard (struct expression *exp,
+@@ -1107,22 +1104,24 @@ dump_subexp_body_standard (struct expression *exp,
switch (range_type)
{
fputs_filtered ("ExclusiveRange 'EXP..EXP'", stream);
break;
default:
-@@ -1128,11 +1127,9 @@ dump_subexp_body_standard (struct expression *exp,
+@@ -1130,11 +1129,9 @@ dump_subexp_body_standard (struct expression *exp,
break;
}
diff --git a/gdb/expression.h b/gdb/expression.h
--- a/gdb/expression.h
+++ b/gdb/expression.h
-@@ -150,28 +150,27 @@ extern void dump_raw_expression (struct expression *,
+@@ -167,28 +167,27 @@ extern void dump_raw_expression (struct expression *,
struct ui_file *, const char *);
extern void dump_prefix_expression (struct expression *, struct ui_file *);
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
+@@ -282,31 +282,63 @@ arglist : subrange
arglist : arglist ',' exp %prec ABOVE_COMMA
- { arglist_len++; }
+ { pstate->arglist_len++; }
+ | arglist ',' subrange %prec ABOVE_COMMA
-+ { arglist_len++; }
++ { pstate->arglist_len++; }
;
/* There are four sorts of subrange types in F90. */
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)
- {
-- size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
-+ size_t dim_size;
+@@ -129,6 +129,11 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
+ byte_stride = dim_size;
size_t offs = 0;
-+ LONGEST byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
-+
+
+ if (byte_stride)
+ dim_size = byte_stride;
+ else
+ dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
-
++
for (i = lowerbound;
(i < upperbound + 1 && (*elts) < options->print_max);
+ i++)
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
-@@ -911,7 +911,8 @@ operator== (const range_bounds &l, const range_bounds &r)
- struct type *
- create_range_type (struct type *result_type, struct type *index_type,
- const struct dynamic_prop *low_bound,
-- const struct dynamic_prop *high_bound)
-+ const struct dynamic_prop *high_bound,
-+ const struct dynamic_prop *stride)
- {
- if (result_type == NULL)
- result_type = alloc_type_copy (index_type);
-@@ -926,6 +927,7 @@ create_range_type (struct type *result_type, struct type *index_type,
- TYPE_ZALLOC (result_type, sizeof (struct range_bounds));
- TYPE_RANGE_DATA (result_type)->low = *low_bound;
+@@ -936,7 +936,7 @@ create_range_type (struct type *result_type, struct type *index_type,
TYPE_RANGE_DATA (result_type)->high = *high_bound;
-+ TYPE_RANGE_DATA (result_type)->stride = *stride;
+ TYPE_RANGE_DATA (result_type)->bias = bias;
- if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0)
- TYPE_UNSIGNED (result_type) = 1;
-@@ -954,7 +956,7 @@ struct type *
- create_static_range_type (struct type *result_type, struct type *index_type,
- LONGEST low_bound, LONGEST high_bound)
- {
-- struct dynamic_prop low, high;
-+ struct dynamic_prop low, high, stride;
+- /* Initialize the stride to be a constant, the value will already be zero
++ /* bias the stride to be a constant, the value will already be zero
+ thanks to the use of TYPE_ZALLOC above. */
+ TYPE_RANGE_DATA (result_type)->stride.kind = PROP_CONST;
- low.kind = PROP_CONST;
- low.data.const_val = low_bound;
-@@ -962,7 +964,11 @@ create_static_range_type (struct type *result_type, struct type *index_type,
+@@ -1001,7 +1001,8 @@ create_static_range_type (struct type *result_type, struct type *index_type,
high.kind = PROP_CONST;
high.data.const_val = high_bound;
-- result_type = create_range_type (result_type, index_type, &low, &high);
-+ stride.kind = PROP_CONST;
-+ stride.data.const_val = 0;
-+
+- result_type = create_range_type (result_type, index_type, &low, &high, 0);
+ result_type = create_range_type (result_type, index_type,
-+ &low, &high, &stride);
++ &low, &high, 0);
return result_type;
}
-@@ -1180,16 +1186,20 @@ create_array_type_with_stride (struct type *result_type,
- && (!type_not_associated (result_type)
- && !type_not_allocated (result_type)))
- {
-- LONGEST low_bound, high_bound;
-+ LONGEST low_bound, high_bound, byte_stride;
-
+@@ -1236,6 +1237,7 @@ create_array_type_with_stride (struct type *result_type,
if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
low_bound = high_bound = 0;
element_type = check_typedef (element_type);
-+ byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
+
/* Be careful when setting the array length. Ada arrays can be
empty arrays with the high_bound being smaller than the low_bound.
In such cases, the array length should be zero. */
- if (high_bound < low_bound)
- TYPE_LENGTH (result_type) = 0;
-+ else if (byte_stride > 0)
-+ TYPE_LENGTH (result_type) = byte_stride * (high_bound - low_bound + 1);
- else if (bit_stride > 0)
- TYPE_LENGTH (result_type) =
- (bit_stride * (high_bound - low_bound + 1) + 7) / 8;
-@@ -1990,12 +2000,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;
-- struct dynamic_prop low_bound, high_bound;
-+ struct dynamic_prop low_bound, high_bound, stride;
-
- gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
-
- prop = &TYPE_RANGE_DATA (dyn_range_type)->low;
-- if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
-+ if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
- {
- low_bound.kind = PROP_CONST;
- low_bound.data.const_val = value;
-@@ -2007,7 +2017,7 @@ resolve_dynamic_range (struct type *dyn_range_type,
- }
-
- prop = &TYPE_RANGE_DATA (dyn_range_type)->high;
-- if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
-+ if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
- {
- high_bound.kind = PROP_CONST;
- high_bound.data.const_val = value;
-@@ -2022,12 +2032,20 @@ resolve_dynamic_range (struct type *dyn_range_type,
- high_bound.data.const_val = 0;
- }
-
-+ prop = &TYPE_RANGE_DATA (dyn_range_type)->stride;
-+ if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
-+ {
-+ stride.kind = PROP_CONST;
-+ stride.data.const_val = value;
-+ }
-+
- static_target_type
- = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type),
- addr_stack, 0);
- static_range_type = create_range_type (copy_type (dyn_range_type),
- static_target_type,
-- &low_bound, &high_bound);
-+ &low_bound, &high_bound, &stride);
-+
- TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
- return static_range_type;
- }
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
-@@ -614,6 +614,10 @@ struct range_bounds
-
- struct dynamic_prop high;
-
-+ /* * Stride of range. */
-+
-+ struct dynamic_prop stride;
-+
- /* True if HIGH range bound contains the number of elements in the
- subrange. This affects how the final hight bound is computed. */
-
-@@ -778,7 +782,6 @@ struct main_type
+@@ -803,7 +803,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
-@@ -1327,6 +1330,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
+@@ -1365,6 +1364,15 @@ extern bool set_type_align (struct type *, ULONGEST);
+ #define TYPE_BIT_STRIDE(range_type) \
+ (TYPE_RANGE_DATA(range_type)->stride.data.const_val \
+ * (TYPE_RANGE_DATA(range_type)->flag_is_byte_stride ? 8 : 1))
+#define TYPE_BYTE_STRIDE(range_type) \
+ TYPE_RANGE_DATA(range_type)->stride.data.const_val
+#define TYPE_BYTE_STRIDE_BLOCK(range_type) \
/* Property accessors for the type data location. */
#define TYPE_DATA_LOCATION(thistype) \
-@@ -1361,6 +1373,9 @@ extern bool set_type_align (struct type *, ULONGEST);
+@@ -1400,6 +1408,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))))
-@@ -1896,6 +1911,7 @@ extern struct type *create_array_type_with_stride
- struct dynamic_prop *, unsigned int);
-
- extern struct type *create_range_type (struct type *, struct type *,
-+ const struct dynamic_prop *,
- const struct dynamic_prop *,
- const struct dynamic_prop *);
-
diff --git a/gdb/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,
+@@ -919,24 +919,20 @@ operator_length_standard (const struct expression *expr, int endpos,
case OP_RANGE:
oplen = 3;
diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y
--- a/gdb/rust-exp.y
+++ b/gdb/rust-exp.y
-@@ -2475,24 +2475,28 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation,
+@@ -2492,24 +2492,28 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation,
case OP_RANGE:
{
diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c
--- a/gdb/rust-lang.c
+++ b/gdb/rust-lang.c
-@@ -1193,13 +1193,11 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
+@@ -1224,13 +1224,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 (noside == EVAL_SKIP)
return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
-@@ -1288,7 +1286,7 @@ rust_compute_range (struct type *type, struct value *range,
+@@ -1319,7 +1317,7 @@ rust_compute_range (struct type *type, struct value *range,
*low = 0;
*high = 0;
if (TYPE_NFIELDS (type) == 0)
return;
-@@ -1296,15 +1294,14 @@ rust_compute_range (struct type *type, struct value *range,
+@@ -1327,15 +1325,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));
if (rust_inclusive_range_type_p (type))
-@@ -1322,7 +1319,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
+@@ -1353,7 +1350,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;
-@@ -1420,7 +1417,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
+@@ -1451,7 +1448,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"));
-@@ -1438,7 +1435,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
+@@ -1469,7 +1466,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
CORE_ADDR addr;
struct value *addrval, *tem;
+program testprog
+ call sub
+end
-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"
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"
+@@ -32,7 +32,8 @@ gdb_test "print sizeof(vla1)" " = 0" "print sizeof non-allocated vla1"
+ gdb_test "print sizeof(vla1(3,2,1))" \
+ "no such vector element \\(vector not allocated\\)" \
+ "print sizeof non-allocated indexed vla1"
+-gdb_test "print sizeof(vla1(3:4,2,1))" "array not allocated" \
++gdb_test "print sizeof(vla1(3:4,2,1))" \
++ "provided bound\\(s\\) outside array bound\\(s\\)" \
+ "print sizeof non-allocated sliced vla1"
+
+ # Try to access value in allocated VLA
+@@ -41,7 +42,7 @@ gdb_continue_to_breakpoint "vla1-allocated"
+ gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
+ gdb_test "print sizeof(vla1(3,2,1))" "4" \
+ "print sizeof element from allocated vla1"
+-gdb_test "print sizeof(vla1(3:4,2,1))" "800" \
++gdb_test "print sizeof(vla1(3:4,2,1))" "8" \
+ "print sizeof sliced vla1"
+
+ # Try to access values in undefined pointer to VLA (dangling)
+@@ -49,7 +50,8 @@ gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
+ gdb_test "print sizeof(pvla(3,2,1))" \
+ "no such vector element \\(vector not associated\\)" \
+ "print sizeof non-associated indexed pvla"
+-gdb_test "print sizeof(pvla(3:4,2,1))" "array not associated" \
++gdb_test "print sizeof(pvla(3:4,2,1))" \
++ "provided bound\\(s\\) outside array bound\\(s\\)" \
+ "print sizeof non-associated sliced pvla"
+
+ # Try to access values in pointer to VLA and compare them
+@@ -58,7 +60,8 @@ gdb_continue_to_breakpoint "pvla-associated"
gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
+ gdb_test "print sizeof(pvla(3,2,1))" "4" \
+ "print sizeof element from associated pvla"
+-gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced 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"
++gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla"
+
+ gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"]
+ gdb_continue_to_breakpoint "vla1-neg-bounds-v1"
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 @@
+@@ -0,0 +1,47 @@
+# Copyright 2016 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+ continue
+}
+
++gdb_test_no_output "set max-value-size unlimited" \
++ "set max-value-size to unlimited"
++
+gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
+gdb_continue_to_breakpoint "re-reverse-elements"
+gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \
+
+ pvla => null() ! single-element
+end program vla_stride
-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
-+
-+ allocate (vla1 (-2:1, -5:4, -3:-1))
-+ l = allocated(vla1)
-+
-+ vla1(:, :, :) = 1
-+ vla1(-2, -3, -1) = -231
-+
-+ deallocate (vla1) ! vla1-neg-bounds
-+ l = allocated(vla1)
-+
- end program vla
-diff --git a/gdb/valarith.c b/gdb/valarith.c
---- a/gdb/valarith.c
-+++ b/gdb/valarith.c
-@@ -187,11 +187,17 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound)
- struct type *array_type = check_typedef (value_type (array));
- struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
- ULONGEST elt_size = type_length_units (elt_type);
-- ULONGEST elt_offs = elt_size * (index - lowerbound);
-+ LONGEST elt_offs = index - lowerbound;
-+ LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type));
-+
-+ if (elt_stride != 0)
-+ elt_offs *= elt_stride;
-+ else
-+ elt_offs *= elt_size;
-
- if (index < lowerbound
- || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
-- && elt_offs >= type_length_units (array_type))
-+ && abs (elt_offs) >= type_length_units (array_type))
- || (VALUE_LVAL (array) != lval_memory
- && TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)))
- {
diff --git a/gdb/valops.c b/gdb/valops.c
--- a/gdb/valops.c
+++ b/gdb/valops.c
-@@ -3792,56 +3792,195 @@ value_of_this_silent (const struct language_defn *lang)
+@@ -3797,13 +3797,42 @@ value_of_this_silent (const struct language_defn *lang)
struct value *
value_slice (struct value *array, int lowbound, int length)
if (TYPE_CODE (array_type) != TYPE_CODE_ARRAY
&& TYPE_CODE (array_type) != TYPE_CODE_STRING)
error (_("cannot take slice of non-array"));
+@@ -3813,45 +3842,155 @@ value_slice (struct value *array, int lowbound, int length)
+ if (type_not_associated (array_type))
+ error (_("array not associated"));
- range_type = TYPE_INDEX_TYPE (array_type);
- if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
/* 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,
+- slice_range_type = create_static_range_type (NULL,
- TYPE_TARGET_TYPE (range_type),
- lowbound,
- lowbound + length - 1);
+
+ slice_type = create_array_type (NULL, element_type, slice_range_type);
-- slice_type = create_array_type ((struct type *) NULL,
+- slice_type = create_array_type (NULL,
- element_type,
- slice_range_type);
- TYPE_CODE (slice_type) = TYPE_CODE (array_type);
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 *);
+@@ -1145,6 +1145,8 @@ extern struct value *varying_to_slice (struct value *);
extern struct value *value_slice (struct value *, int, int);
projects / packages / gdb.git / blobdiff