This is the mail archive of the
archer@sourceware.org
mailing list for the Archer project.
Re: Calculating array length
On Sun, 14 Jun 2009 22:29:38 +0200, Joost van der Sluis wrote:
> I attached the patch. It always uses the bounds to decide how many
> elements there are, and when necessary each element in the array is
> evaluated seperately.
I agree with this part.
Created an artifical DWARF testcase for the problematic case of Pascal array
containing AnsiStrings (as simulated by `struct string_t' in the attached
testcase gdb.arch/x86_64-pascal-string-array.c). Therefore TYPE_LENGTH of the
same `string_t' type will differ for each element of the array, depending on
the current object_address (shifted by the element size=stride for each array
element).
Original C code:
struct string_t
{
const char *string;
unsigned long length;
}
array[3];
Hand-modified DWARF originally produced from the C code above:
<2><84>: Abbrev Number: 5 (DW_TAG_string_type)
<85> DW_AT_name : (indirect string, offset: 0x0): string_t
<89> DW_AT_byte_size : 8
<8a> DW_AT_string_length: 3 byte block: 97 23 8 (DW_OP_push_object_address; DW_OP_plus_uconst: 8)
<8e> DW_AT_data_location: 2 byte block: 97 6 (DW_OP_push_object_address; DW_OP_deref)
<2><93>: Abbrev Number: 4 (DW_TAG_variable)
<94> DW_AT_name : (indirect string, offset: 0x11): array
<9a> DW_AT_type : <0xf9>
<9e> DW_AT_location : 3 byte block: 91 80 7f (DW_OP_fbreg: -128)
<1><b6>: Abbrev Number: 10 (DW_TAG_base_type)
<b7> DW_AT_byte_size : 8
<b8> DW_AT_encoding : 7 (unsigned)
<1><f9>: Abbrev Number: 14 (DW_TAG_array_type)
<fa> DW_AT_type : <0x84>
<2><fe>: Abbrev Number: 15 (DW_TAG_subrange_type)
<ff> DW_AT_type : <0xb6>
<103> DW_AT_upper_bound : 2
<104> DW_AT_stride : 16
> To see if this is really neccessary to do, I test if
> TYPE_DATA_LOCATION_DWARF_BLOCK is set. I doubt if that is ok, but it
> works for my case.
>
> Also pascal_cal_print is adapted so that it does not call check_typedef
> on the type before it is passed to val_print_array_elements.
This part was workarounding an existing bug of the VLA patch as it creates
a static type (=evaluate dynamic fields for the current variable/sub-part)
recursively by check_typedef().
A better way would be to make static only one step and the caller would have
to call check_typedef() on TYPE_TARGET_TYPE etc. again. This way was
attempted by the attached patch. It works with the new `string_t' testcase
and I hope it would work even for your Pascal arrays (I do not have the
compiler for them).
Still the attached patch has a regression on:
+FAIL: gdb.ada/null_array.exp: ptype my_table (GDB internal error)
+FAIL: gdb.ada/null_array.exp: print my_matrix (GDB internal error)
because currently copy_type_recursive() can create invalid discardable types.
While trying to fix it I stopped as this path of global object_address_set was
only temporary for maintainability as a 3rd party patch. As the patch has
been promised as generally acceptable it needs to be done the right way instead:
(1) object_address (for DW_OP_push_object_address) should be local for each
variable / type evaluation. That means changing many `struct type *' to
carry also the object address, now assuming by using `struct value *'
having the `lazy' flag set and object address stored there in
value->location.address.
(2) Function check_typedef should be dropped and its resolving of TYPE_DYNAMIC
fields should be done on-demand, when any code asks for it. It is mostly
required by the new attached testcase where each array element's
TYPE_LENGTH differs.
It will also make the types garbage collector unused by the VLA patch.
The check_typedef removal should be easy to make incrementally.
(3) object_address_get_data() (converting now object address -> data address)
should be dropped - the object address (for DW_OP_push_object_address)
needs to be kept indefinitely for `struct value' as the data address
(possibly different by optional DW_AT_data_location) will be evaluated
dynamically derived from the object address. This will remove the problem
of the single address being kept now which sometimes needs to be the
object address and sometimes the data address.
(4) value_raw_address() vs. value_address() (as is shifted by value->offset)
should be made more clear. value_address() should return _data_address_
+ offset. value_raw_address() is only used once in java_value_print, it
may be dropped.
Currently not intending to accept neither of the mine or yours patches for
archer-jankratochvil-vla, is it a problem to keep the your patch for your GDB
fork? Going to start working on the right solution above as I already lost
a lot of time trying to keep the current patch in its add-on form.
Thanks,
Jan
diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c
index 19902a9..4c56107 100644
--- a/gdb/dwarf2loc.c
+++ b/gdb/dwarf2loc.c
@@ -107,8 +107,8 @@ struct dwarf_expr_baton
{
struct frame_info *frame;
struct objfile *objfile;
- /* From DW_TAG_variable's DW_AT_location (not DW_TAG_type's
- DW_AT_data_location) for DW_OP_push_object_address. */
+
+ /* Address to set by object_address_set. */
CORE_ADDR object_address;
};
@@ -217,9 +217,12 @@ dwarf_expr_object_address (void *baton)
return debaton->object_address;
}
-/* Address of the variable we are currently referring to. It is set from
- DW_TAG_variable's DW_AT_location (not DW_TAG_type's DW_AT_data_location) for
- DW_OP_push_object_address. */
+/* Address of the variable we are currently referring to. It is initially set
+ from DW_TAG_variable's DW_AT_location. It is used for
+ DW_OP_push_object_address. It is never the address derived by
+ DW_AT_data_location (nor completely unrelated DW_AT_data_member_location).
+ Expresses the address of the closes DW_AT_type, such as an element of an
+ array, not the base address of an array. */
static CORE_ADDR object_address;
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index e559d86..8ce4884 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -4655,6 +4655,8 @@ create_single_array_dimension (struct type *type, struct type *range_type,
validity while accessing FIELD_LOC_KIND_DWARF_BLOCK. */
fetch_die_type_attrs (die, range_type, cu);
+ finalize_type (type);
+
return type;
}
@@ -5095,6 +5097,7 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu)
struct type *type, *range_type, *index_type, *char_type;
struct attribute *attr;
int length;
+ char *name;
index_type = builtin_type_int32;
/* RANGE_TYPE is allocated from OBJFILE, not as a permanent type. */
@@ -5185,6 +5188,10 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu)
type = create_string_type (NULL, range_type);
+ name = dwarf2_name (die, cu);
+ if (name)
+ TYPE_NAME (type) = name;
+
return set_die_type (die, type, cu);
}
diff --git a/gdb/eval.c b/gdb/eval.c
index 83ae2cd..6ae3cfa 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -2696,6 +2696,7 @@ evaluate_subexp_for_sizeof (struct expression *exp, int *pos)
int pc;
struct type *type;
struct value *val;
+ struct cleanup *back_to;
pc = (*pos);
op = exp->elts[pc].opcode;
@@ -2709,7 +2710,14 @@ evaluate_subexp_for_sizeof (struct expression *exp, int *pos)
case UNOP_IND:
(*pos)++;
val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
+
+ back_to = make_cleanup (null_cleanup, 0);
+ object_address_set (value_raw_address (val));
+
type = check_typedef (value_type (val));
+
+ do_cleanups (back_to);
+
if (TYPE_CODE (type) != TYPE_CODE_PTR
&& TYPE_CODE (type) != TYPE_CODE_REF
&& TYPE_CODE (type) != TYPE_CODE_ARRAY)
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index 44456f8..35f875e 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -146,6 +146,7 @@ f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream)
TYPE_ARRAY_BYTE_STRIDE_VALUE (tmp_type);
tmp_type = TYPE_TARGET_TYPE (tmp_type);
+ CHECK_TYPEDEF (tmp_type);
ndimen++;
}
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index ec32200..f84a20b 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -875,13 +875,18 @@ create_array_type (struct type *result_type,
In such cases, the array length should be zero. TYPE_TARGET_STUB needs to
be checked as it may have dependencies on DWARF blocks depending on
runtime information not available during the CREATE_ARRAY_TYPE time. */
- if (high_bound < low_bound || TYPE_TARGET_STUB (element_type))
+ if (high_bound < low_bound)
+ TYPE_LENGTH (result_type) = 0;
+ else if (TYPE_BYTE_STRIDE (range_type) > 0)
+ TYPE_LENGTH (result_type) = TYPE_BYTE_STRIDE (range_type)
+ * (high_bound - low_bound + 1);
+ else if (TYPE_TARGET_STUB (element_type))
TYPE_LENGTH (result_type) = 0;
else
{
CHECK_TYPEDEF (element_type);
- TYPE_LENGTH (result_type) =
- TYPE_LENGTH (element_type) * (high_bound - low_bound + 1);
+ TYPE_LENGTH (result_type) = TYPE_LENGTH (element_type)
+ * (high_bound - low_bound + 1);
}
if (TYPE_LENGTH (result_type) == 0)
@@ -1638,12 +1643,7 @@ check_typedef (struct type *type)
constant values expected by the callers of this function. */
if (TYPE_DYNAMIC (type))
{
- htab_t copied_types;
- struct type *type_old = type;
-
- copied_types = create_copied_types_hash (NULL);
- type = copy_type_recursive (type, copied_types);
- htab_delete (copied_types);
+ type = copy_type_recursive (type, NULL);
gdb_assert (TYPE_DYNAMIC (type) == 0);
}
@@ -3104,10 +3104,15 @@ copy_type_recursive_1 (struct objfile *objfile,
if it did, the type might disappear unexpectedly. */
gdb_assert (TYPE_OBJFILE (type) == objfile);
- pair.old = type;
- slot = htab_find_slot (copied_types, &pair, INSERT);
- if (*slot != NULL)
- return ((struct type_pair *) *slot)->new;
+ if (copied_types)
+ {
+ pair.old = type;
+ slot = htab_find_slot (copied_types, &pair, INSERT);
+ if (*slot != NULL)
+ return ((struct type_pair *) *slot)->new;
+ }
+ else
+ slot = NULL;
new_type = alloc_type (NULL);
@@ -3115,10 +3120,13 @@ copy_type_recursive_1 (struct objfile *objfile,
we encounter this type again during a recursive call below. Memory could
be allocated from OBJFILE in the case we will be removing OBJFILE, this
optimization is missed and xfree is called for it from COPIED_TYPES. */
- stored = xmalloc (sizeof (*stored));
- stored->old = type;
- stored->new = new_type;
- *slot = stored;
+ if (slot)
+ {
+ stored = xmalloc (sizeof (*stored));
+ stored->old = type;
+ stored->new = new_type;
+ *slot = stored;
+ }
/* Copy the common fields of types. For the main type, we simply
copy the entire thing and then update specific fields as needed. */
@@ -3191,10 +3199,15 @@ copy_type_recursive_1 (struct objfile *objfile,
TYPE_FIELD_ARTIFICIAL (new_type, i) =
TYPE_FIELD_ARTIFICIAL (type, i);
TYPE_FIELD_BITSIZE (new_type, i) = TYPE_FIELD_BITSIZE (type, i);
- if (TYPE_FIELD_TYPE (type, i))
- TYPE_FIELD_TYPE (new_type, i)
- = copy_type_recursive_1 (objfile, TYPE_FIELD_TYPE (type, i),
- copied_types);
+ if (1 || copied_types)
+ {
+ if (TYPE_FIELD_TYPE (type, i))
+ TYPE_FIELD_TYPE (new_type, i)
+ = copy_type_recursive_1 (objfile, TYPE_FIELD_TYPE (type, i),
+ copied_types);
+ }
+ else
+ TYPE_FIELD_TYPE (new_type, i) = TYPE_FIELD_TYPE (type, i);
if (TYPE_FIELD_NAME (type, i))
TYPE_FIELD_NAME (new_type, i) =
xstrdup (TYPE_FIELD_NAME (type, i));
@@ -3216,7 +3229,10 @@ copy_type_recursive_1 (struct objfile *objfile,
case FIELD_LOC_KIND_DWARF_BLOCK:
/* `struct dwarf2_locexpr_baton' is too bound to its objfile so
it is expected to be made constant by CHECK_TYPEDEF. */
- if (TYPE_NOT_ALLOCATED (new_type)
+ if (0 && copied_types)
+ SET_FIELD_DWARF_BLOCK (TYPE_FIELD (new_type, i),
+ TYPE_FIELD_DWARF_BLOCK (type, i));
+ else if (TYPE_NOT_ALLOCATED (new_type)
|| TYPE_NOT_ASSOCIATED (new_type))
SET_FIELD_DWARF_BLOCK (TYPE_FIELD (new_type, i), NULL);
else
@@ -3231,30 +3247,42 @@ copy_type_recursive_1 (struct objfile *objfile,
}
}
- /* Convert TYPE_RANGE_HIGH_BOUND_IS_COUNT into a regular bound. */
- if (TYPE_CODE (type) == TYPE_CODE_RANGE
- && TYPE_RANGE_HIGH_BOUND_IS_COUNT (type))
+ if (copied_types)
{
- TYPE_RANGE_HIGH_BOUND_IS_COUNT (new_type) = 0;
- TYPE_HIGH_BOUND (new_type) = TYPE_LOW_BOUND (type)
- + TYPE_HIGH_BOUND (type) - 1;
+ /* Copy pointers to other types. */
+ if (TYPE_TARGET_TYPE (type))
+ TYPE_TARGET_TYPE (new_type) =
+ copy_type_recursive_1 (objfile,
+ TYPE_TARGET_TYPE (type),
+ copied_types);
+ if (TYPE_VPTR_BASETYPE (type))
+ TYPE_VPTR_BASETYPE (new_type) =
+ copy_type_recursive_1 (objfile,
+ TYPE_VPTR_BASETYPE (type),
+ copied_types);
+ }
+ else
+ {
+ TYPE_TARGET_TYPE (new_type) = TYPE_TARGET_TYPE (type);
+ TYPE_VPTR_BASETYPE (new_type) = TYPE_VPTR_BASETYPE (type);
}
- /* Both FIELD_LOC_KIND_DWARF_BLOCK and TYPE_RANGE_HIGH_BOUND_IS_COUNT were
- possibly converted. */
- TYPE_DYNAMIC (new_type) = 0;
+ if (copied_types == NULL)
+ {
+ /* Convert TYPE_RANGE_HIGH_BOUND_IS_COUNT into a regular bound. */
+ if (TYPE_CODE (type) == TYPE_CODE_RANGE
+ && TYPE_RANGE_HIGH_BOUND_IS_COUNT (type))
+ {
+ TYPE_RANGE_HIGH_BOUND_IS_COUNT (new_type) = 0;
+ TYPE_HIGH_BOUND (new_type) = TYPE_LOW_BOUND (type)
+ + TYPE_HIGH_BOUND (type) - 1;
+ }
+
+ /* Both FIELD_LOC_KIND_DWARF_BLOCK and TYPE_RANGE_HIGH_BOUND_IS_COUNT were
+ possibly converted. */
+ TYPE_DYNAMIC (new_type) = 0;
+ }
- /* Copy pointers to other types. */
- if (TYPE_TARGET_TYPE (type))
- TYPE_TARGET_TYPE (new_type) =
- copy_type_recursive_1 (objfile,
- TYPE_TARGET_TYPE (type),
- copied_types);
- if (TYPE_VPTR_BASETYPE (type))
- TYPE_VPTR_BASETYPE (new_type) =
- copy_type_recursive_1 (objfile,
- TYPE_VPTR_BASETYPE (type),
- copied_types);
/* Maybe copy the type_specific bits.
NOTE drow/2005-12-09: We do not copy the C++-specific bits like
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index aca3f07..362d31c 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -945,10 +945,11 @@ extern void allocate_cplus_struct_type (struct type *);
#define FIELD_TYPE(thisfld) ((thisfld).type)
#define FIELD_NAME(thisfld) ((thisfld).name)
#define FIELD_LOC_KIND(thisfld) ((thisfld).loc_kind)
-#define FIELD_BITPOS(thisfld) ((thisfld).loc.bitpos)
-#define FIELD_STATIC_PHYSNAME(thisfld) ((thisfld).loc.physname)
-#define FIELD_STATIC_PHYSADDR(thisfld) ((thisfld).loc.physaddr)
-#define FIELD_DWARF_BLOCK(thisfld) ((thisfld).loc.dwarf_block)
+#include "gdb_assert.h"
+#define FIELD_BITPOS(thisfld) (*({ gdb_assert (FIELD_LOC_KIND (thisfld) == FIELD_LOC_KIND_BITPOS); &(thisfld).loc.bitpos; }))
+#define FIELD_STATIC_PHYSNAME(thisfld) (*({ gdb_assert (FIELD_LOC_KIND (thisfld) == FIELD_LOC_KIND_PHYSNAME); &(thisfld).loc.physname; }))
+#define FIELD_STATIC_PHYSADDR(thisfld) (*({ gdb_assert (FIELD_LOC_KIND (thisfld) == FIELD_LOC_KIND_PHYSADDR); &(thisfld).loc.physaddr; }))
+#define FIELD_DWARF_BLOCK(thisfld) (*({ gdb_assert (FIELD_LOC_KIND (thisfld) == FIELD_LOC_KIND_DWARF_BLOCK); &(thisfld).loc.dwarf_block; }))
#define SET_FIELD_BITPOS(thisfld, bitpos) \
(FIELD_LOC_KIND (thisfld) = FIELD_LOC_KIND_BITPOS, \
FIELD_BITPOS (thisfld) = (bitpos))
diff --git a/gdb/p-typeprint.c b/gdb/p-typeprint.c
index 5085fb4..8dd22c8 100644
--- a/gdb/p-typeprint.c
+++ b/gdb/p-typeprint.c
@@ -265,8 +265,7 @@ pascal_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
if (passed_a_ptr)
fprintf_filtered (stream, "(");
fprintf_filtered (stream, "array ");
- if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
- && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
+ if (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
fprintf_filtered (stream, "[%d..%d] ",
TYPE_ARRAY_LOWER_BOUND_VALUE (type),
TYPE_ARRAY_UPPER_BOUND_VALUE (type)
diff --git a/gdb/p-valprint.c b/gdb/p-valprint.c
index 30d0650..174b74d 100644
--- a/gdb/p-valprint.c
+++ b/gdb/p-valprint.c
@@ -71,6 +71,7 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr,
case TYPE_CODE_ARRAY:
if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
{
+ case TYPE_CODE_STRING:
elttype = check_typedef (TYPE_TARGET_TYPE (type));
eltlen = TYPE_LENGTH (elttype);
len = TYPE_LENGTH (type) / eltlen;
diff --git a/gdb/testsuite/gdb.arch/x86_64-pascal-string-array-foo.S b/gdb/testsuite/gdb.arch/x86_64-pascal-string-array-foo.S
new file mode 100644
index 0000000..ef4ba2a
--- /dev/null
+++ b/gdb/testsuite/gdb.arch/x86_64-pascal-string-array-foo.S
@@ -0,0 +1,447 @@
+ .file "x86_64-pascal-string-array.c"
+ .section .debug_abbrev,"",@progbits
+.Ldebug_abbrev0:
+ .section .debug_info,"",@progbits
+.Ldebug_info0:
+ .section .debug_line,"",@progbits
+.Ldebug_line0:
+ .text
+.Ltext0:
+ .section .rodata
+.LC0:
+ .string "alX"
+ .text
+.globl foo
+ .type foo, @function
+foo:
+.LFB0:
+ .file 1 "x86_64-pascal-string-array.c"
+ # x86_64-pascal-string-array.c:22
+ .loc 1 22 0
+ .cfi_startproc
+ # basic block 2
+ pushq %rbp
+ .cfi_def_cfa_offset 16
+ movq %rsp, %rbp
+ .cfi_offset 6, -16
+ .cfi_def_cfa_register 6
+ pushq %rbx
+ movl %edi, -116(%rbp)
+ # x86_64-pascal-string-array.c:23
+ .loc 1 23 0
+ movw $22636, -32(%rbp)
+ movb $0, -30(%rbp)
+ # x86_64-pascal-string-array.c:24
+ .loc 1 24 0
+ movl .LC0(%rip), %eax
+ movl %eax, -48(%rbp)
+ # x86_64-pascal-string-array.c:25
+ .loc 1 25 0
+ movl $1483498338, -64(%rbp)
+ movb $0, -60(%rbp)
+ # x86_64-pascal-string-array.c:33
+ .loc 1 33 0
+ movl -116(%rbp), %eax
+ movslq %eax,%rcx
+ # x86_64-pascal-string-array.c:32
+ .loc 1 32 0
+ movl -116(%rbp), %eax
+ addl $1, %eax
+ # x86_64-pascal-string-array.c:33
+ .loc 1 33 0
+ movslq %eax,%rdx
+ movl -116(%rbp), %eax
+ addl $2, %eax
+ cltq
+ leaq -32(%rbp), %rbx
+ .cfi_offset 3, -24
+ movq %rbx, -112(%rbp)
+ movq %rcx, -104(%rbp)
+ leaq -48(%rbp), %rcx
+ movq %rcx, -96(%rbp)
+ movq %rdx, -88(%rbp)
+ leaq -64(%rbp), %rdx
+ movq %rdx, -80(%rbp)
+ movq %rax, -72(%rbp)
+ # x86_64-pascal-string-array.c:36
+ .loc 1 36 0
+ popq %rbx
+ leave
+ ret
+ .cfi_endproc
+.LFE0:
+ .size foo, .-foo
+.Letext0:
+ .section .debug_loc,"",@progbits
+.Ldebug_loc0:
+.LLST0:
+ .quad .LFB0-.Ltext0 # Location list begin address (*.LLST0)
+ .quad .LFE0-.Ltext0 # Location list end address (*.LLST0)
+ .value 0x2 # Location expression size
+ .byte 0x76 # DW_OP_breg6
+ .sleb128 16
+ .quad 0x0 # Location list terminator begin (*.LLST0)
+ .quad 0x0 # Location list terminator end (*.LLST0)
+ .section .debug_info
+.Lo0:
+ .long .Ldebuginfo_end-1f # Length of Compilation Unit Info
+1:
+ .value 0x2 # DWARF version number
+ .long .Ldebug_abbrev0 # Offset Into Abbrev. Section
+ .byte 0x8 # Pointer Size (in bytes)
+ .uleb128 0x1 # (DIE (0xb) DW_TAG_compile_unit)
+ .long .LASF8 # DW_AT_producer: "GNU C 4.4.0 20090506 (Red Hat 4.4.0-4)"
+ .byte 0x9 # DW_AT_language = DW_LANG_Pascal83
+ .long .LASF9 # DW_AT_name: "x86_64-pascal-string-array.c"
+ .long .LASF10 # DW_AT_comp_dir: ""
+ .quad .Ltext0 # DW_AT_low_pc
+ .quad .Letext0 # DW_AT_high_pc
+ .long .Ldebug_line0 # DW_AT_stmt_list
+ .uleb128 0x2 # (DIE (0x2d) DW_TAG_subprogram)
+ .byte 0x1 # DW_AT_external
+ .ascii "foo\0" # DW_AT_name
+ .byte 0x1 # DW_AT_decl_file (x86_64-pascal-string-array.c)
+ .byte 0x15 # DW_AT_decl_line
+ .byte 0x1 # DW_AT_prototyped
+ .quad .LFB0 # DW_AT_low_pc
+ .quad .LFE0 # DW_AT_high_pc
+ .long .LLST0 # DW_AT_frame_base
+ .uleb128 0x3 # (DIE (0x4e) DW_TAG_formal_parameter)
+ .long .LASF11 # DW_AT_name: "show_l"
+ .byte 0x1 # DW_AT_decl_file (x86_64-pascal-string-array.c)
+ .byte 0x15 # DW_AT_decl_line
+ .long .Ldie0xc1-.Lo0 # DW_AT_type
+ .byte 0x3 # DW_AT_location
+ .byte 0x91 # DW_OP_fbreg
+ .sleb128 -132
+ .uleb128 0x4 # (DIE (0x5d) DW_TAG_variable)
+ .long .LASF0 # DW_AT_name: "string0"
+ .byte 0x1 # DW_AT_decl_file (x86_64-pascal-string-array.c)
+ .byte 0x17 # DW_AT_decl_line
+ .long .Ldie0xe2-.Lo0 # DW_AT_type
+ .byte 0x2 # DW_AT_location
+ .byte 0x91 # DW_OP_fbreg
+ .sleb128 -48
+ .uleb128 0x4 # (DIE (0x6b) DW_TAG_variable)
+ .long .LASF1 # DW_AT_name: "string1"
+ .byte 0x1 # DW_AT_decl_file (x86_64-pascal-string-array.c)
+ .byte 0x18 # DW_AT_decl_line
+ .long .Ldie0xf7-.Lo0 # DW_AT_type
+ .byte 0x2 # DW_AT_location
+ .byte 0x91 # DW_OP_fbreg
+ .sleb128 -64
+ .uleb128 0x4 # (DIE (0x79) DW_TAG_variable)
+ .long .LASF2 # DW_AT_name: "string2"
+ .byte 0x1 # DW_AT_decl_file (x86_64-pascal-string-array.c)
+ .byte 0x19 # DW_AT_decl_line
+ .long .Ldie0x10c-.Lo0 # DW_AT_type
+ .byte 0x3 # DW_AT_location
+ .byte 0x91 # DW_OP_fbreg
+ .sleb128 -80
+.Ldie0x88:
+ .uleb128 0x5 # (DIE (0x88) DW_TAG_string_type)
+ .long .LASF12 # DW_AT_name: "string_t"
+ .byte 0x8 # DW_AT_byte_size = sizeof (string_t.length)
+ .byte 2f-1f # DW_AT_string_length
+1: .byte 0x97 # DW_OP_push_object_address
+ .byte 0x23 # DW_OP_plus_uconst
+ .uleb128 8 # offsetof (struct string_t, length)
+2:
+ .byte 2f-1f # DW_AT_data_location
+1: .byte 0x97 # DW_OP_push_object_address
+ .byte 0x06 # DW_OP_deref
+2:
+ .byte 0x1 # DW_AT_decl_file (x86_64-pascal-string-array.c)
+ .byte 0x1b # DW_AT_decl_line
+ .uleb128 0x4 # (DIE (0xb1) DW_TAG_variable)
+ .long .LASF5 # DW_AT_name: "array"
+ .byte 0x1 # DW_AT_decl_file (x86_64-pascal-string-array.c)
+ .byte 0x1f # DW_AT_decl_line
+ .long .Ldie0x123-.Lo0 # DW_AT_type
+ .byte 0x3 # DW_AT_location
+ .byte 0x91 # DW_OP_fbreg
+ .sleb128 -128
+ .byte 0x0 # end of children of DIE 0x2d
+.Ldie0xc1:
+ .uleb128 0x7 # (DIE (0xc1) DW_TAG_base_type)
+ .byte 0x4 # DW_AT_byte_size
+ .byte 0x5 # DW_AT_encoding
+ .ascii "int\0" # DW_AT_name
+.Ldie0xc8:
+ .uleb128 0x8 # (DIE (0xc8) DW_TAG_array_type)
+ .long .Ldie0xdb-.Lo0 # DW_AT_type
+ .uleb128 0x9 # (DIE (0xd1) DW_TAG_subrange_type)
+ .long .Ldie0xd8-.Lo0 # DW_AT_type
+ .byte 0x2 # DW_AT_upper_bound
+ .byte 0x0 # end of children of DIE 0xc8
+.Ldie0xd8:
+ .uleb128 0xa # (DIE (0xd8) DW_TAG_base_type)
+ .byte 0x8 # DW_AT_byte_size
+ .byte 0x7 # DW_AT_encoding
+.Ldie0xdb:
+ .uleb128 0xb # (DIE (0xdb) DW_TAG_base_type)
+ .byte 0x1 # DW_AT_byte_size
+ .byte 0x6 # DW_AT_encoding
+ .long .LASF6 # DW_AT_name: "char"
+.Ldie0xe2:
+ .uleb128 0xc # (DIE (0xe2) DW_TAG_const_type)
+ .long .Ldie0xc8-.Lo0 # DW_AT_type
+.Ldie0xe7:
+ .uleb128 0x8 # (DIE (0xe7) DW_TAG_array_type)
+ .long .Ldie0xdb-.Lo0 # DW_AT_type
+ .uleb128 0x9 # (DIE (0xf0) DW_TAG_subrange_type)
+ .long .Ldie0xd8-.Lo0 # DW_AT_type
+ .byte 0x3 # DW_AT_upper_bound
+ .byte 0x0 # end of children of DIE 0xe7
+.Ldie0xf7:
+ .uleb128 0xc # (DIE (0xf7) DW_TAG_const_type)
+ .long .Ldie0xe7-.Lo0 # DW_AT_type
+.Ldie0xfc:
+ .uleb128 0x8 # (DIE (0xfc) DW_TAG_array_type)
+ .long .Ldie0xdb-.Lo0 # DW_AT_type
+ .uleb128 0x9 # (DIE (0x105) DW_TAG_subrange_type)
+ .long .Ldie0xd8-.Lo0 # DW_AT_type
+ .byte 0x4 # DW_AT_upper_bound
+ .byte 0x0 # end of children of DIE 0xfc
+.Ldie0x10c:
+ .uleb128 0xc # (DIE (0x10c) DW_TAG_const_type)
+ .long .Ldie0xfc-.Lo0 # DW_AT_type
+ .uleb128 0xd # (DIE (0x111) DW_TAG_pointer_type)
+ .byte 0x8 # DW_AT_byte_size
+ .long .Ldie0x117-.Lo0 # DW_AT_type
+.Ldie0x117:
+ .uleb128 0xc # (DIE (0x117) DW_TAG_const_type)
+ .long .Ldie0xdb-.Lo0 # DW_AT_type
+ .uleb128 0xb # (DIE (0x11c) DW_TAG_base_type)
+ .byte 0x8 # DW_AT_byte_size
+ .byte 0x7 # DW_AT_encoding
+ .long .LASF7 # DW_AT_name: "long unsigned int"
+.Ldie0x123:
+ .uleb128 0xe # (DIE (0x123) DW_TAG_array_type)
+ .long .Ldie0x88-.Lo0 # DW_AT_type
+ .uleb128 0xf # (DIE (0x128) DW_TAG_subrange_type)
+ .long .Ldie0xd8-.Lo0 # DW_AT_type
+ .byte 0x2 # DW_AT_upper_bound
+ .byte 0x10 # DW_AT_byte_stride
+ .byte 0x0 # end of children of DIE 0x123
+ .byte 0x0 # end of children of DIE 0xb
+.Ldebuginfo_end:
+ .section .debug_abbrev
+ .uleb128 0x1 # (abbrev code)
+ .uleb128 0x11 # (TAG: DW_TAG_compile_unit)
+ .byte 0x1 # DW_children_yes
+ .uleb128 0x25 # (DW_AT_producer)
+ .uleb128 0xe # (DW_FORM_strp)
+ .uleb128 0x13 # (DW_AT_language)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x3 # (DW_AT_name)
+ .uleb128 0xe # (DW_FORM_strp)
+ .uleb128 0x1b # (DW_AT_comp_dir)
+ .uleb128 0xe # (DW_FORM_strp)
+ .uleb128 0x11 # (DW_AT_low_pc)
+ .uleb128 0x1 # (DW_FORM_addr)
+ .uleb128 0x12 # (DW_AT_high_pc)
+ .uleb128 0x1 # (DW_FORM_addr)
+ .uleb128 0x10 # (DW_AT_stmt_list)
+ .uleb128 0x6 # (DW_FORM_data4)
+ .byte 0x0
+ .byte 0x0
+ .uleb128 0x2 # (abbrev code)
+ .uleb128 0x2e # (TAG: DW_TAG_subprogram)
+ .byte 0x1 # DW_children_yes
+ .uleb128 0x3f # (DW_AT_external)
+ .uleb128 0xc # (DW_FORM_flag)
+ .uleb128 0x3 # (DW_AT_name)
+ .uleb128 0x8 # (DW_FORM_string)
+ .uleb128 0x3a # (DW_AT_decl_file)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x3b # (DW_AT_decl_line)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x27 # (DW_AT_prototyped)
+ .uleb128 0xc # (DW_FORM_flag)
+ .uleb128 0x11 # (DW_AT_low_pc)
+ .uleb128 0x1 # (DW_FORM_addr)
+ .uleb128 0x12 # (DW_AT_high_pc)
+ .uleb128 0x1 # (DW_FORM_addr)
+ .uleb128 0x40 # (DW_AT_frame_base)
+ .uleb128 0x6 # (DW_FORM_data4)
+ .byte 0x0
+ .byte 0x0
+ .uleb128 0x3 # (abbrev code)
+ .uleb128 0x5 # (TAG: DW_TAG_formal_parameter)
+ .byte 0x0 # DW_children_no
+ .uleb128 0x3 # (DW_AT_name)
+ .uleb128 0xe # (DW_FORM_strp)
+ .uleb128 0x3a # (DW_AT_decl_file)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x3b # (DW_AT_decl_line)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x49 # (DW_AT_type)
+ .uleb128 0x13 # (DW_FORM_ref4)
+ .uleb128 0x2 # (DW_AT_location)
+ .uleb128 0xa # (DW_FORM_block1)
+ .byte 0x0
+ .byte 0x0
+ .uleb128 0x4 # (abbrev code)
+ .uleb128 0x34 # (TAG: DW_TAG_variable)
+ .byte 0x0 # DW_children_no
+ .uleb128 0x3 # (DW_AT_name)
+ .uleb128 0xe # (DW_FORM_strp)
+ .uleb128 0x3a # (DW_AT_decl_file)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x3b # (DW_AT_decl_line)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x49 # (DW_AT_type)
+ .uleb128 0x13 # (DW_FORM_ref4)
+ .uleb128 0x2 # (DW_AT_location)
+ .uleb128 0xa # (DW_FORM_block1)
+ .byte 0x0
+ .byte 0x0
+ .uleb128 0x5 # (abbrev code)
+ .uleb128 0x12 # (TAG: DW_TAG_string_type)
+ .byte 0x0 # DW_children_no
+ .uleb128 0x3 # (DW_AT_name)
+ .uleb128 0xe # (DW_FORM_strp)
+ .uleb128 0xb # (DW_AT_byte_size)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x19 # (DW_AT_string_length)
+ .uleb128 0xa # (DW_FORM_block1)
+ .uleb128 0x50 # (DW_AT_data_location)
+ .uleb128 0xa # (DW_FORM_block1)
+ .uleb128 0x3a # (DW_AT_decl_file)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x3b # (DW_AT_decl_line)
+ .uleb128 0xb # (DW_FORM_data1)
+ .byte 0x0
+ .byte 0x0
+ .uleb128 0x7 # (abbrev code)
+ .uleb128 0x24 # (TAG: DW_TAG_base_type)
+ .byte 0x0 # DW_children_no
+ .uleb128 0xb # (DW_AT_byte_size)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x3e # (DW_AT_encoding)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x3 # (DW_AT_name)
+ .uleb128 0x8 # (DW_FORM_string)
+ .byte 0x0
+ .byte 0x0
+ .uleb128 0x8 # (abbrev code)
+ .uleb128 0x1 # (TAG: DW_TAG_array_type)
+ .byte 0x1 # DW_children_yes
+ .uleb128 0x49 # (DW_AT_type)
+ .uleb128 0x13 # (DW_FORM_ref4)
+ .byte 0x0
+ .byte 0x0
+ .uleb128 0x9 # (abbrev code)
+ .uleb128 0x21 # (TAG: DW_TAG_subrange_type)
+ .byte 0x0 # DW_children_no
+ .uleb128 0x49 # (DW_AT_type)
+ .uleb128 0x13 # (DW_FORM_ref4)
+ .uleb128 0x2f # (DW_AT_upper_bound)
+ .uleb128 0xb # (DW_FORM_data1)
+ .byte 0x0
+ .byte 0x0
+ .uleb128 0xa # (abbrev code)
+ .uleb128 0x24 # (TAG: DW_TAG_base_type)
+ .byte 0x0 # DW_children_no
+ .uleb128 0xb # (DW_AT_byte_size)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x3e # (DW_AT_encoding)
+ .uleb128 0xb # (DW_FORM_data1)
+ .byte 0x0
+ .byte 0x0
+ .uleb128 0xb # (abbrev code)
+ .uleb128 0x24 # (TAG: DW_TAG_base_type)
+ .byte 0x0 # DW_children_no
+ .uleb128 0xb # (DW_AT_byte_size)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x3e # (DW_AT_encoding)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x3 # (DW_AT_name)
+ .uleb128 0xe # (DW_FORM_strp)
+ .byte 0x0
+ .byte 0x0
+ .uleb128 0xc # (abbrev code)
+ .uleb128 0x26 # (TAG: DW_TAG_const_type)
+ .byte 0x0 # DW_children_no
+ .uleb128 0x49 # (DW_AT_type)
+ .uleb128 0x13 # (DW_FORM_ref4)
+ .byte 0x0
+ .byte 0x0
+ .uleb128 0xd # (abbrev code)
+ .uleb128 0xf # (TAG: DW_TAG_pointer_type)
+ .byte 0x0 # DW_children_no
+ .uleb128 0xb # (DW_AT_byte_size)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x49 # (DW_AT_type)
+ .uleb128 0x13 # (DW_FORM_ref4)
+ .byte 0x0
+ .byte 0x0
+ .uleb128 0xe # (abbrev code)
+ .uleb128 0x1 # (TAG: DW_TAG_array_type)
+ .byte 0x1 # DW_children_yes
+ .uleb128 0x49 # (DW_AT_type)
+ .uleb128 0x13 # (DW_FORM_ref4)
+ .byte 0x0
+ .byte 0x0
+ .uleb128 0xf # (abbrev code)
+ .uleb128 0x21 # (TAG: DW_TAG_subrange_type)
+ .byte 0x0 # DW_children_no
+ .uleb128 0x49 # (DW_AT_type)
+ .uleb128 0x13 # (DW_FORM_ref4)
+ .uleb128 0x2f # (DW_AT_upper_bound)
+ .uleb128 0xb # (DW_FORM_data1)
+ .uleb128 0x51 # (DW_AT_byte_stride)
+ .uleb128 0xb # (DW_FORM_data1)
+ .byte 0x0
+ .byte 0x0
+ .byte 0x0
+ .section .debug_pubnames,"",@progbits
+ .long 0x16 # Length of Public Names Info
+ .value 0x2 # DWARF Version
+ .long .Ldebug_info0 # Offset of Compilation Unit Info
+ .long 0x130 # Compilation Unit Length
+ .long 0x2d # DIE offset
+ .ascii "foo\0" # external name
+ .long 0x0
+ .section .debug_aranges,"",@progbits
+ .long 0x2c # Length of Address Ranges Info
+ .value 0x2 # DWARF Version
+ .long .Ldebug_info0 # Offset of Compilation Unit Info
+ .byte 0x8 # Size of Address
+ .byte 0x0 # Size of Segment Descriptor
+ .value 0x0 # Pad to 16 byte boundary
+ .value 0x0
+ .quad .Ltext0 # Address
+ .quad .Letext0-.Ltext0 # Length
+ .quad 0x0
+ .quad 0x0
+ .section .debug_str,"MS",@progbits,1
+.LASF12:
+ .string "string_t"
+.LASF0:
+ .string "string0"
+.LASF5:
+ .string "array"
+.LASF1:
+ .string "string1"
+.LASF4:
+ .string "length"
+.LASF10:
+ .string ""
+.LASF7:
+ .string "long unsigned int"
+.LASF6:
+ .string "char"
+.LASF3:
+ .string "string"
+.LASF9:
+ .string "x86_64-pascal-string-array.c"
+.LASF8:
+ .string "GNU C 4.4.0 20090506 (Red Hat 4.4.0-4)"
+.LASF11:
+ .string "show_l"
+.LASF2:
+ .string "string2"
+ .ident "GCC: (GNU) 4.4.0 20090506 (Red Hat 4.4.0-4)"
+ .section .note.GNU-stack,"",@progbits
diff --git a/gdb/testsuite/gdb.arch/x86_64-pascal-string-array.c b/gdb/testsuite/gdb.arch/x86_64-pascal-string-array.c
new file mode 100644
index 0000000..fc2c541
--- /dev/null
+++ b/gdb/testsuite/gdb.arch/x86_64-pascal-string-array.c
@@ -0,0 +1,48 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+ Copyright 2009 Free Software Foundation, Inc.
+
+ 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 <http://www.gnu.org/licenses/>. */
+
+#if 0
+
+void
+foo (int show_l)
+{
+ const char string0[] = "lX";
+ const char string1[] = "alX";
+ const char string2[] = "bclX";
+ struct string_t
+ {
+ const char *string;
+ unsigned long length;
+ }
+ array[3] = {{string0, 0 + show_l},
+ {string1, 1 + show_l},
+ {string2, 2 + show_l}};
+
+ show_l = show_l; /* break-here */
+}
+
+#else
+
+int
+main (void)
+{
+ foo (0);
+ foo (1);
+ return 0;
+}
+
+#endif
diff --git a/gdb/testsuite/gdb.arch/x86_64-pascal-string-array.exp b/gdb/testsuite/gdb.arch/x86_64-pascal-string-array.exp
new file mode 100644
index 0000000..94e4547
--- /dev/null
+++ b/gdb/testsuite/gdb.arch/x86_64-pascal-string-array.exp
@@ -0,0 +1,64 @@
+# Copyright 2009 Free Software Foundation, Inc.
+
+# 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 <http://www.gnu.org/licenses/>.
+
+# Test DW_AT_data_location accessed through DW_TAG_typedef intermediate.
+
+if ![istarget "x86_64-*-*"] then {
+ verbose "Skipping over gdb.arch/x86_64-pascal-string-array.exp test made only for x86_64."
+ return
+}
+
+set test x86_64-pascal-string-array
+set srcfile ${test}.c
+
+# Disable {debug} options as the .c debug_line would conflict with -foo.S.
+if { [prepare_for_testing ${test}.exp ${test} [list ${test}-foo.S ${test}.c] {}] } {
+ return -1
+}
+
+if ![runto_main] {
+ untested ${test}.exp
+ return -1
+}
+
+gdb_breakpoint [gdb_get_line_number "break-here"]
+gdb_continue_to_breakpoint "break-here"
+
+gdb_test "whatis array" "type = array \\\[0\\.\\.2\\\] of string_t" "first: whatis array"
+gdb_test "ptype array" "type = array \\\[0\\.\\.2\\\] of string_t" "first: ptype array"
+
+set test "first: p array\[0\]"
+gdb_test_multiple "p array\[0\]" $test {
+ -re " = 0x\[0-9a-f\]+ 'lX'\r\n$gdb_prompt $" {
+ # pascal_val_print currently considers TYPE_LENGTH == 0 as unspecified.
+### setup_kfail *-*-* gdb/9999
+ fail $test
+ }
+ -re " = ''\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+gdb_test "p array\[1\]" " = 'a'" "first: p array\[1\]"
+gdb_test "p array\[2\]" " = 'bc'" "first: p array\[2\]"
+
+gdb_continue_to_breakpoint "break-here"
+
+gdb_test "whatis array" "type = array \\\[0\\.\\.2\\\] of string_t" "second: whatis array"
+gdb_test "ptype array" "type = array \\\[0\\.\\.2\\\] of string_t" "second: ptype array"
+
+gdb_test "p array\[0\]" " = 'l'" "second: p array\[0\]"
+gdb_test "p array\[1\]" " = 'al'" "second: p array\[1\]"
+gdb_test "p array\[2\]" " = 'bcl'" "second: p array\[2\]"
+
diff --git a/gdb/valarith.c b/gdb/valarith.c
index 8a635b6..ad4489c 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -31,6 +31,7 @@
#include "dfp.h"
#include <math.h>
#include "infcall.h"
+#include "dwarf2loc.h"
/* Define whether or not the C operator '/' truncates towards zero for
differently signed operands (truncation direction is undefined in C). */
@@ -178,11 +179,12 @@ value_subscript (struct value *array, struct value *idx)
LONGEST lowerbound, upperbound;
get_discrete_bounds (range_type, &lowerbound, &upperbound);
- if (VALUE_LVAL (array) != lval_memory)
+ if (VALUE_LVAL (array) != lval_memory
+ || TYPE_BYTE_STRIDE (range_type) > 0)
{
if (index >= lowerbound && index <= upperbound)
{
- CORE_ADDR element_size = TYPE_LENGTH (TYPE_TARGET_TYPE (tarray));
+ CORE_ADDR element_size = TYPE_ARRAY_BYTE_STRIDE_VALUE (tarray);
CORE_ADDR offset = (index - lowerbound) * element_size;
return value_subscripted_rvalue (array, offset);
@@ -232,8 +234,26 @@ struct value *
value_subscripted_rvalue (struct value *array, CORE_ADDR offset)
{
struct type *array_type = check_typedef (value_type (array));
- struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
+ struct type *elt_type;
struct value *v;
+ struct cleanup *back_to;
+ CORE_ADDR elt_addr;
+
+ back_to = make_cleanup (null_cleanup, 0);
+
+ /* Find the element object address - derived from the array _data_ address
+ shifted by OFFSET. */
+ elt_addr = value_raw_address (array);
+ object_address_get_data (value_type (array), &elt_addr);
+ elt_addr += offset;
+
+ /* And get the appropriate TYPE for the specific element of the array.
+ Different elements of the array may get different (such as by their string
+ length) types). */
+ object_address_set (elt_addr);
+ elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
+
+ do_cleanups (back_to);
/* Do not check TYPE_LENGTH (array_type) as we may have been given the
innermost dimension of a multi-dimensional Fortran array where its length
@@ -252,7 +272,7 @@ value_subscripted_rvalue (struct value *array, CORE_ADDR 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) + offset);
+ set_value_address (v, elt_addr);
return v;
}
diff --git a/gdb/valops.c b/gdb/valops.c
index acd67f0..befc6be 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -318,6 +318,7 @@ value_cast (struct type *type, struct value *arg2)
enum type_code code2;
int scalar;
struct type *type2;
+ struct cleanup *back_to;
int convert_to_boolean = 0;
@@ -338,17 +339,26 @@ value_cast (struct type *type, struct value *arg2)
return value_ref (val);
}
+ back_to = make_cleanup (null_cleanup, 0);
+ object_address_set (value_raw_address (arg2));
+
code2 = TYPE_CODE (check_typedef (value_type (arg2)));
+ arg2 = coerce_ref (arg2);
if (code2 == TYPE_CODE_REF)
- /* We deref the value and then do the cast. */
- return value_cast (type, coerce_ref (arg2));
+ {
+ do_cleanups (back_to);
+
+ /* We deref the value and then do the cast. */
+ return value_cast (type, arg2);
+ }
CHECK_TYPEDEF (type);
code1 = TYPE_CODE (type);
- arg2 = coerce_ref (arg2);
type2 = check_typedef (value_type (arg2));
+ do_cleanups (back_to);
+
/* You can't cast to a reference type. See value_cast_pointers
instead. */
gdb_assert (code1 != TYPE_CODE_REF);