diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 0623204..94a5e43 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -1490,11 +1490,8 @@ finalize_type (struct type *type) updated. FIXME: Remove this dependency (only ada_to_fixed_type?). */ struct type * -check_typedef (struct type *type) +check_typedef_target (struct type *type) { - struct type *orig_type = type; - int is_const, is_volatile; - gdb_assert (type); while (TYPE_CODE (type) == TYPE_CODE_TYPEDEF) @@ -1527,6 +1524,17 @@ check_typedef (struct type *type) } type = TYPE_TARGET_TYPE (type); } + return (type); + +} + +struct type * +check_typedef (struct type *type) +{ + struct type *orig_type = type; + int is_const, is_volatile; + + type=check_typedef_target(type); is_const = TYPE_CONST (type); is_volatile = TYPE_VOLATILE (type); diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h index f0a5405..f571161 100644 --- a/gdb/gdbtypes.h +++ b/gdb/gdbtypes.h @@ -1339,6 +1339,8 @@ extern struct type *lookup_unsigned_typename (const struct language_defn *, extern struct type *lookup_signed_typename (const struct language_defn *, struct gdbarch *,char *); +extern struct type *check_typedef_target (struct type *); + extern struct type *check_typedef (struct type *); #define CHECK_TYPEDEF(TYPE) \ diff --git a/gdb/p-valprint.c b/gdb/p-valprint.c index 50c993f..7f85df4 100644 --- a/gdb/p-valprint.c +++ b/gdb/p-valprint.c @@ -61,12 +61,15 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr, unsigned int i = 0; /* Number of characters printed */ unsigned len; struct type *elttype; + struct value *value; unsigned eltlen; int length_pos, length_size, string_pos; struct type *char_type; LONGEST val; CORE_ADDR addr; + value = value_at_lazy(type, address); + CHECK_TYPEDEF (type); switch (TYPE_CODE (type)) { @@ -82,9 +85,8 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr, } /* For an array of chars, print with string syntax. */ if ((eltlen == 1 || eltlen == 2 || eltlen == 4) - && ((TYPE_CODE (elttype) == TYPE_CODE_INT) - || ((current_language->la_language == language_pascal) - && (TYPE_CODE (elttype) == TYPE_CODE_CHAR))) + && ((current_language->la_language == language_pascal) + && (TYPE_CODE (elttype) == TYPE_CODE_CHAR)) && (options->format == 0 || options->format == 's')) { /* If requested, look for the first null char and only print @@ -122,7 +124,7 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr, { i = 0; } - val_print_array_elements (type, valaddr + embedded_offset, address, stream, + val_print_array_elements (value_type(value), valaddr + embedded_offset, address, stream, recurse, options, i); fprintf_filtered (stream, "}"); } diff --git a/gdb/testsuite/gdb.pascal/arrays.exp b/gdb/testsuite/gdb.pascal/arrays.exp new file mode 100644 index 0000000..ab6d7d4 --- /dev/null +++ b/gdb/testsuite/gdb.pascal/arrays.exp @@ -0,0 +1,71 @@ +# Copyright 2008, 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 . + +if $tracelevel then { + strace $tracelevel +} + +load_lib "pascal.exp" + +set testfile "arrays" +set srcfile ${testfile}.pas +set binfile ${objdir}/${subdir}/${testfile}$EXEEXT + +if {[gdb_compile_pascal "-gw3 ${srcdir}/${subdir}/${srcfile}" "${binfile}" executable [list debug ]] != "" } { + return -1 +} + +gdb_exit +gdb_start +gdb_reinitialize_dir $srcdir/$subdir +gdb_load ${binfile} +set bp_location1 [gdb_get_line_number "set breakpoint 1 here"] +set bp_location2 [gdb_get_line_number "set breakpoint 2 here"] + + +if { [gdb_breakpoint ${srcfile}:${bp_location1}] } { + pass "setting breakpoint 1" +} +if { [gdb_breakpoint ${srcfile}:${bp_location2}] } { + pass "setting breakpoint 2" +} + +# Verify that "start" lands inside the right procedure. +if { [gdb_start_cmd] < 0 } { + untested start + return -1 +} + +gdb_test "" ".* at .*${srcfile}.*" "start" + +gdb_test "cont" "Breakpoint .*:${bp_location1}.*" "Going to first breakpoint" + +gdb_test "print StatArrInt" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61\\}" "Print static array of integer type" +gdb_test "print StatArrInt_" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61\\}" "Print static array of integer" + +gdb_test "cont" "Breakpoint .*:${bp_location2}.*" "Going to second breakpoint" + +gdb_test "print DynArrInt" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer type" +gdb_test "print DynArrInt_" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer" + +gdb_test "print s" ".* = 'test'#0'string'" "Print string containing null-char" + +gdb_test "print DynArrStr" ".* = \\{'dstr0', 'dstr1', 'dstr2', 'dstr3', 'dstr4', 'dstr5', 'dstr6', 'dstr7', 'dstr8', 'dstr9', 'dstr10', 'dstr11', 'dstr12'\\}" "Print dynamic array of string" +gdb_test "print StatArrStr" ".* = \\{'str0', 'str1', 'str2', 'str3', 'str4', 'str5', 'str6', 'str7', 'str8', 'str9', 'str10', 'str11', 'str12'\\}" "Print static array of string" + +gdb_test "print DynArrChar" ".* = 'abcdefghijklm'" "Print dynamic array of char" +gdb_test "print StatArrChar" ".* = 'abcdefghijkl'" "Print static array of char" +gdb_test "print Stat2dArrInt" ".* = \\{\\{0, 1, 2, 3, 4\\}, \\{1, 2, 3, 4, 5\\}, \\{2, 3, 4, 5, 6\\}, \\{3, 4, 5, 6, 7\\}, \\{4, 5, 6, 7, 8\\}, \\{5, 6, 7, 8, 9\\}, \\{6, 7, 8, 9, 10\\}, \\{7, 8, 9, 10, 11\\}, \\{8, 9, 10, 11, 12\\}, \\{9, 10, 11, 12, 13\\}, \\{10, 11, 12, 13, 14\\}, \\{11, 12, 13, 14, 15\\}\\}" "Print static 2-dimensional array of integer" + diff --git a/gdb/testsuite/gdb.pascal/arrays.pas b/gdb/testsuite/gdb.pascal/arrays.pas new file mode 100644 index 0000000..295602d --- /dev/null +++ b/gdb/testsuite/gdb.pascal/arrays.pas @@ -0,0 +1,82 @@ +{ + Copyright 2008, 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 . +} + +program arrays; + +{$mode objfpc}{$h+} + +uses sysutils; + +type TStatArrInt= array[0..11] of integer; + TDynArrInt= array of integer; + TStatArrStr= array[0..12] of string; + TDynArrStr= array of string; + TDynArrChar = array of char; + TStatArrChar = array [0..11] of char; + + TStat2dArrInt = array[0..11,0..4] of integer; + +var StatArrInt: TStatArrInt; + StatArrInt_: Array[0..11] of integer; + DynArrInt: TDynArrInt; + DynArrInt_: Array of integer; + StatArrStr: TStatArrStr; + DynArrStr: TDynArrStr; + StatArrChar: TStatArrChar; + DynArrChar: TDynArrChar; + + Stat2dArrInt: TStat2dArrInt; + + s: string; + + i,j : integer; + +begin + for i := 0 to 11 do + begin + StatArrInt[i]:= i+50; + StatArrInt_[i]:= i+50; + StatArrChar[i]:= chr(ord('a')+i); + for j := 0 to 4 do + Stat2dArrInt[i,j]:=i+j; + end; + writeln(StatArrInt_[0]); + writeln(StatArrInt[0]); { set breakpoint 1 here } + writeln(StatArrChar[0]); + writeln(Stat2dArrInt[0,0]); + + setlength(DynArrInt,13); + setlength(DynArrInt_,13); + setlength(DynArrStr,13); + setlength(DynArrChar,13); + for i := 0 to 12 do + begin + DynArrInt[i]:= i+50; + DynArrInt_[i]:= i+50; + DynArrChar[i]:= chr(ord('a')+i); + StatArrStr[i]:='str'+inttostr(i); + DynArrStr[i]:='dstr'+inttostr(i); + end; + writeln(DynArrInt_[1]); + writeln(DynArrInt[1]); + writeln(DynArrStr[1]); + writeln(StatArrStr[1]); + writeln(DynArrChar[1]); + + s := 'test'#0'string'; + writeln(s); { set breakpoint 2 here } +end. diff --git a/gdb/valops.c b/gdb/valops.c index 0ffccaf..e156493 100644 --- a/gdb/valops.c +++ b/gdb/valops.c @@ -720,7 +720,7 @@ value_fetch_lazy (struct value *val) if (object_address_get_data (value_type (val), &addr)) { struct type *type = value_enclosing_type (val); - int length = TYPE_LENGTH (check_typedef (type)); + int length = value_length_get (val, 1); // For Fortran full_span should be zero? if (length) { diff --git a/gdb/valprint.c b/gdb/valprint.c index e5b12f2..93b06e1 100644 --- a/gdb/valprint.c +++ b/gdb/valprint.c @@ -1033,9 +1033,9 @@ print_char_chars (struct ui_file *stream, struct type *type, default values instead. */ int -get_array_bounds (struct type *type, long *low_bound, long *high_bound) +get_array_bounds (struct value *val, long *low_bound, long *high_bound) { - struct type *index = TYPE_INDEX_TYPE (type); + struct type *index = TYPE_INDEX_TYPE (value_type(val)); long low = 0; long high = 0; @@ -1044,8 +1044,8 @@ get_array_bounds (struct type *type, long *low_bound, long *high_bound) if (TYPE_CODE (index) == TYPE_CODE_RANGE) { - low = TYPE_LOW_BOUND (index); - high = TYPE_HIGH_BOUND (index); + low = VALUE_LOWER_BOUND (val); + high = VALUE_UPPER_BOUND (val); } else if (TYPE_CODE (index) == TYPE_CODE_ENUM) { @@ -1109,7 +1109,9 @@ val_print_array_elements (struct type *type, const gdb_byte *valaddr, unsigned int things_printed = 0; unsigned len; struct type *elttype, *index_type; + struct value *val; unsigned eltlen; + unsigned stride; /* Position of the array element we are examining to see whether it is repeated. */ unsigned int rep1; @@ -1117,32 +1119,31 @@ val_print_array_elements (struct type *type, const gdb_byte *valaddr, unsigned int reps; long low_bound_index = 0; + type=check_typedef_target(type); + stride = TYPE_ARRAY_BYTE_STRIDE_VALUE(check_typedef(type)); + /* Construct a new 'struct value' to obtain dynamic information on the type, + like the array bounds */ + val = value_at_lazy(type, address); elttype = TYPE_TARGET_TYPE (type); eltlen = TYPE_LENGTH (check_typedef (elttype)); index_type = TYPE_INDEX_TYPE (type); - /* Compute the number of elements in the array. On most arrays, - the size of its elements is not zero, and so the number of elements - is simply the size of the array divided by the size of the elements. - But for arrays of elements whose size is zero, we need to look at - the bounds. */ - if (eltlen != 0) - len = TYPE_LENGTH (type) / eltlen; + /* Always use the bounds to calculate the amount of + elements in the array. */ + long low, hi; + if (get_array_bounds (val, &low, &hi)) + { + len = hi - low + 1; + } else { - long low, hi; - if (get_array_bounds (type, &low, &hi)) - len = hi - low + 1; - else - { - warning (_("unable to get bounds of array, assuming null array")); - len = 0; - } + warning (_("unable to get bounds of array, assuming null array")); + len = 0; } /* Get the array low bound. This only makes sense if the array has one or more element in it. */ - if (len > 0 && !get_array_bounds (type, &low_bound_index, NULL)) + if (len > 0 && !get_array_bounds (val, &low_bound_index, NULL)) { warning (_("unable to get low bound of array, using zero as default")); low_bound_index = 0; @@ -1177,10 +1178,15 @@ val_print_array_elements (struct type *type, const gdb_byte *valaddr, ++rep1; } + /* Set object_address to the address of the element and create a + new, clean value to pass to common_val_print, so that all dyanic + properties are handled correctly. */ + struct value *element_value; + element_value = value_at_lazy(TYPE_TARGET_TYPE (type), data_address(val) + i * stride); + common_val_print(element_value,stream,recurse +1, options, current_language); + if (reps > options->repeat_count_threshold) { - val_print (elttype, valaddr + i * eltlen, 0, address + i * eltlen, - stream, recurse + 1, options, current_language); annotate_elt_rep (reps); fprintf_filtered (stream, " ", reps); annotate_elt_rep_end (); @@ -1190,8 +1196,6 @@ val_print_array_elements (struct type *type, const gdb_byte *valaddr, } else { - val_print (elttype, valaddr + i * eltlen, 0, address + i * eltlen, - stream, recurse + 1, options, current_language); annotate_elt (); things_printed++; } diff --git a/gdb/valprint.h b/gdb/valprint.h index c0be116..9f8e76a 100644 --- a/gdb/valprint.h +++ b/gdb/valprint.h @@ -109,7 +109,7 @@ extern void get_raw_print_options (struct value_print_options *opts); extern void get_formatted_print_options (struct value_print_options *opts, char format); -extern int get_array_bounds (struct type *type, long *low_bound, +extern int get_array_bounds (struct value *val, long *low_bound, long *high_bound); extern void maybe_print_array_index (struct type *index_type, LONGEST index, diff --git a/gdb/value.c b/gdb/value.c index b79d84d..56e7d1c 100644 --- a/gdb/value.c +++ b/gdb/value.c @@ -197,6 +197,13 @@ struct value /* If value is a variable, is it initialized or not. */ int initialized; + CORE_ADDR data_address; + + char calc_length; + long length; + char checked_dynamics; + long lower_bound; + long upper_bound; /* If value is from the stack. If this is set, read_stack will be used instead of read_memory to enable extra caching. */ int stack; @@ -240,7 +247,6 @@ static struct value_history_chunk *value_history_chain; static int value_history_count; /* Abs number of last entry stored */ - /* List of all value objects currently allocated (except for those released by calls to release_value) This is so they can be freed after each command. */ @@ -289,7 +295,7 @@ void allocate_value_contents (struct value *val) { if (!val->contents) - val->contents = (gdb_byte *) xzalloc (TYPE_LENGTH (val->enclosing_type)); + val->contents = (gdb_byte *) xzalloc (value_length_get (val,1)); } /* Allocate a value and its contents for type TYPE. */ @@ -554,9 +560,117 @@ value_raw_address (struct value *value) void set_value_address (struct value *value, CORE_ADDR addr) { + CORE_ADDR data_addr = addr; gdb_assert (value->lval != lval_internalvar && value->lval != lval_internalvar_component); value->location.address = addr; + object_address_get_data (value_type (value), &data_addr); + value->data_address = data_addr; +} + +CORE_ADDR +value_length_get (struct value *value, int full_span) +{ + struct type *target_type = NULL; + struct value *target_value = NULL; + struct type *type = value_type(value); + struct type *range_type; + int count; + CORE_ADDR byte_stride = 0; /* `= 0' for a false GCC warning. */ + CORE_ADDR element_size; + + if (value->calc_length) + { + return value->length; + } + + if (((TYPE_CODE (type) != TYPE_CODE_ARRAY + && TYPE_CODE (type) != TYPE_CODE_STRING))) + { + value->calc_length=1; + value->length=TYPE_LENGTH (check_typedef(type)); + return value->length; + } + + /* Avoid executing TYPE_HIGH_BOUND for invalid (unallocated/unassociated) + Fortran arrays. The allocated data will never be used so they can be + zero-length. */ + if (object_address_data_not_valid (type)) + { + value->calc_length=1; + value->length=0; + return value->length; + } + + range_type = TYPE_INDEX_TYPE (type); + if (TYPE_RANGE_LOWER_BOUND_IS_UNDEFINED (range_type) + || TYPE_RANGE_UPPER_BOUND_IS_UNDEFINED (range_type)) + { + value->calc_length=1; + value->length=0; + return value->length; + } + + count = VALUE_UPPER_BOUND (value) - VALUE_LOWER_BOUND (value) + 1; + /* It may happen for wrong DWARF annotations returning garbage data. */ + if (count < 0) + warning (_("Range for type %s has invalid bounds %d..%d"), + TYPE_NAME (type), VALUE_LOWER_BOUND (value), + VALUE_UPPER_BOUND (value)); + /* The code below does not handle count == 0 right. */ + if (count <= 0) + { + value->calc_length=1; + value->length=0; + return value->length; + } + + if (full_span || count > 1) + { + /* We do not use TYPE_ARRAY_BYTE_STRIDE_VALUE (type) here as we want to + force FULL_SPAN to 1. */ + byte_stride = TYPE_BYTE_STRIDE (range_type); + if (byte_stride == 0) + { + if (data_address(value)==NULL) + { + if (target_type == NULL) + target_type = check_typedef (TYPE_TARGET_TYPE (type)); + byte_stride = TYPE_LENGTH (target_type); + } + else + { + if (target_value == NULL) + target_value = value_at_lazy(TYPE_TARGET_TYPE (type),data_address(value)); + byte_stride = value_length_get (target_value, 1); + } + } + } + if (full_span) + { + value->calc_length=1; + value->length=count * byte_stride; + return value->length; + } + if (target_value == NULL) + target_value = value_at_lazy(TYPE_TARGET_TYPE (type),data_address(value)); + element_size = value_length_get (target_value, 1); + { + value->calc_length=1; + value->length=count * byte_stride; + return (count - 1) * byte_stride + element_size; + } +} + +CORE_ADDR +data_address (struct value *value) +{ + return value->data_address; +} +void +set_data_address (struct value *value, CORE_ADDR addr) +{ + value->data_address = addr; } struct internalvar ** @@ -577,6 +691,89 @@ deprecated_value_regnum_hack (struct value *value) return &value->regnum; } +long +get_bound (struct type *type, int i) +{ + struct type *index = TYPE_INDEX_TYPE (type); + if ((!(index == NULL)) && (TYPE_CODE (index) == TYPE_CODE_RANGE)) + { + int nfields; + nfields = TYPE_NFIELDS (index); + + if (nfields>(i-1)) + { + switch (TYPE_FIELD_LOC_KIND (index, i)) + { + case FIELD_LOC_KIND_BITPOS: + return TYPE_FIELD_BITPOS (index, i); + break; + case FIELD_LOC_KIND_DWARF_BLOCK: + if (TYPE_NOT_ALLOCATED (index) + || TYPE_NOT_ASSOCIATED (index)) + return 0; + else + { + return dwarf_locexpr_baton_eval (TYPE_FIELD_DWARF_BLOCK (index, i)); + } + break; + default: + internal_error (__FILE__, __LINE__, + _("Unexpected type field location kind: %d"), + TYPE_FIELD_LOC_KIND (index, i)); + } + } + } +} + +void +check_value_dynamics (struct value *value) +{ + /* This check is disabled because in some cases the array bounds are + calculated with the wrong object_address set. Thereafter the right + address is set and so the bounds have to be recalculated. This should be + fixed properly later */ + //if (!(&value->checked_dynamics)) + { + if (!(value_address (value) == NULL)) + { + /* In allocate_value memory is allocated before value_address is set. To make this possible, + object_address is set. So we do not have to do this here anymore... + */ + object_address_set (value_address (value)); + } + set_value_lower_bound(value,get_bound (value_type(value),0)); + set_value_upper_bound(value,get_bound (value_type(value),1)); + value->checked_dynamics=1; + } +} + +long * +deprecated_value_lower_bound_hack (struct value *value) +{ + check_value_dynamics(value); + return &value->lower_bound; +} + +void +set_value_lower_bound (struct value *value, long val) +{ + value->lower_bound = val; +} + +long * +deprecated_value_upper_bound_hack (struct value *value) +{ + check_value_dynamics(value); + return &value->upper_bound; +} + +void +set_value_upper_bound (struct value *value, long val) +{ + value->upper_bound = val; +} + + int deprecated_value_modifiable (struct value *value) { diff --git a/gdb/value.h b/gdb/value.h index aa4b3db..5e85141 100644 --- a/gdb/value.h +++ b/gdb/value.h @@ -289,6 +289,11 @@ extern CORE_ADDR value_raw_address (struct value *); /* Set the address of a value. */ extern void set_value_address (struct value *, CORE_ADDR); +extern CORE_ADDR data_address (struct value *); +extern void set_data_address (struct value *, CORE_ADDR); +extern CORE_ADDR value_length_get (struct value *value, int full_span); + + /* Pointer to internal variable. */ extern struct internalvar **deprecated_value_internalvar_hack (struct value *); #define VALUE_INTERNALVAR(val) (*deprecated_value_internalvar_hack (val)) @@ -302,6 +307,14 @@ extern struct frame_id *deprecated_value_frame_id_hack (struct value *); extern short *deprecated_value_regnum_hack (struct value *); #define VALUE_REGNUM(val) (*deprecated_value_regnum_hack (val)) +/* Array bounds */ +extern void set_value_lower_bound (struct value *value, long val); +extern void set_value_upper_bound (struct value *value, long val); +extern long *deprecated_value_lower_bound_hack (struct value *); +extern long *deprecated_value_upper_bound_hack (struct value *); +#define VALUE_LOWER_BOUND(val) (*deprecated_value_lower_bound_hack (val)) +#define VALUE_UPPER_BOUND(val) (*deprecated_value_upper_bound_hack (val)) + /* Convert a REF to the object referenced. */ extern struct value *coerce_ref (struct value *value);