* Patch for pascal-dynamic arrays @ 2009-09-14 14:45 Joost van der Sluis 2009-09-16 15:45 ` Jan Kratochvil 0 siblings, 1 reply; 26+ messages in thread From: Joost van der Sluis @ 2009-09-14 14:45 UTC (permalink / raw) To: Project Archer [-- Attachment #1: Type: text/plain, Size: 1695 bytes --] Hi all, I've been working on getting debugging (dynamic) arrays working with fpc (free pascal compiler) Attached is the patch I have so far, including some tests. All pascal-arrays I tested work now, but it could very well be that I broke something else. I'll try to explain that I did... (patch is based on the vla-branch) Some changes are quite fundamental. Most important change is that the length of a variable is not longer only stored in the type struct, but also in the value struct. This is done because with Dwarf-debuginfo, the size of a variable can be dependent on some dwarf-blocks that ask for the evaluation of some data. So the size of a type-struct is not defined. You always need a data-address with it. That's the case in the value-struct. Problem is that there are all sort of hacks to work around this problem, and I tried to keep the code working with these hacks. One of the problems is that in some cases, the memory for the variable is already allocated before the object-address is set. In that case the 'old'-behaviour is used: the length of the struct-type. This length is also cached, so that when the value-length is asked again, the same value is returned as the first time. This is necessary because when memory of the given size is allocated, the given size can not change anymore offcourse. Further array-bounds are now also part of the value struct. And check_typedef is splitted into two parts, one part that searches for the real type, not the references. And the second part that evaluates and copies the data to a new struct. This is because I need the first part without the second on a few places. How do you think about these changes? Joost [-- Attachment #2: fpc_array_patch_20090914.diff --] [-- Type: text/x-patch, Size: 22547 bytes --] 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 <http://www.gnu.org/licenses/>. + +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 <http://www.gnu.org/licenses/>. +} + +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, " <repeats %u times>", 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 */ -\f /* 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); ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2009-09-14 14:45 Patch for pascal-dynamic arrays Joost van der Sluis @ 2009-09-16 15:45 ` Jan Kratochvil 2009-09-16 18:18 ` Joost van der Sluis 2009-09-30 16:00 ` Joost van der Sluis 0 siblings, 2 replies; 26+ messages in thread From: Jan Kratochvil @ 2009-09-16 15:45 UTC (permalink / raw) To: Joost van der Sluis; +Cc: Project Archer On Mon, 14 Sep 2009 16:45:29 +0200, Joost van der Sluis wrote: > Attached is the patch I have so far, including some tests. Please fix it so that it builds with -O2 -Wall -Werror, it also does not follow the GNU coding style (such as space after a function name). Then also please check regressions of the testsuite - `make -C gdb check' and comparing gdb.sum before/after the patch. I had to do some of these fixes but it has too many regressions. Thanks, Jan --- ./gdb/ada-valprint.c 2009-07-02 19:25:52.000000000 +0200 +++ ./gdb/ada-valprint.c 2009-09-15 13:51:35.000000000 +0200 @@ -90,7 +90,8 @@ print_optional_low_bound (struct ui_file if (options->print_array_indexes) return 0; - if (!get_array_bounds (type, &low_bound, &high_bound)) +gdb_assert (0); /* type vs. val */ + if (!get_array_bounds (NULL, &low_bound, &high_bound)) return 0; /* If this is an empty array, then don't print the lower bound. --- ./gdb/valprint.c 2009-09-15 13:30:39.000000000 +0200 +++ ./gdb/valprint.c 2009-09-15 13:46:25.000000000 +0200 @@ -1035,7 +1035,7 @@ print_char_chars (struct ui_file *stream int get_array_bounds (struct value *val, long *low_bound, long *high_bound) { - struct type *index = TYPE_INDEX_TYPE (value_type(val)); + struct type *index = TYPE_INDEX_TYPE (value_type (val)); long low = 0; long high = 0; @@ -1130,16 +1130,17 @@ val_print_array_elements (struct type *t /* Always use the bounds to calculate the amount of elements in the array. */ - long low, hi; - if (get_array_bounds (val, &low, &hi)) - { + { + long low, hi; + + if (get_array_bounds (val, &low, &hi)) len = hi - low + 1; - } - else - { - warning (_("unable to get bounds of array, assuming null array")); - len = 0; - } + else + { + 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. */ @@ -1182,9 +1183,14 @@ val_print_array_elements (struct type *t /* 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); + { + 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) { --- ./gdb/value.c 2009-09-15 13:30:39.000000000 +0200 +++ ./gdb/value.c 2009-09-15 13:48:51.000000000 +0200 @@ -41,6 +41,7 @@ #include "valprint.h" #include "cli/cli-decode.h" #include "observer.h" +#include "dwarf2loc.h" #include "python/python.h" @@ -627,7 +628,7 @@ value_length_get (struct value *value, i 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"), + warning (_("Range for type %s has invalid bounds %ld..%ld"), TYPE_NAME (type), VALUE_LOWER_BOUND (value), VALUE_UPPER_BOUND (value)); /* The code below does not handle count == 0 right. */ @@ -645,7 +646,7 @@ value_length_get (struct value *value, i byte_stride = TYPE_BYTE_STRIDE (range_type); if (byte_stride == 0) { - if (data_address(value)==NULL) + if (data_address (value) == 0) { if (target_type == NULL) target_type = check_typedef (TYPE_TARGET_TYPE (type)); @@ -719,7 +720,6 @@ get_bound (struct type *type, int 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)) @@ -736,6 +736,8 @@ get_bound (struct type *type, int i) } } } + /* NOTREACHED */ + return -1; } void @@ -747,23 +749,24 @@ check_value_dynamics (struct value *valu fixed properly later */ //if (!(&value->checked_dynamics)) { - if (!(value_address (value) == NULL)) + if (value_address (value) != 0) { - /* 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... - */ + /* 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; + 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); + check_value_dynamics (value); return &value->lower_bound; } @@ -776,7 +779,7 @@ set_value_lower_bound (struct value *val long * deprecated_value_upper_bound_hack (struct value *value) { - check_value_dynamics(value); + check_value_dynamics (value); return &value->upper_bound; } ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2009-09-16 15:45 ` Jan Kratochvil @ 2009-09-16 18:18 ` Joost van der Sluis 2009-09-16 18:41 ` Jan Kratochvil 2009-09-30 16:00 ` Joost van der Sluis 1 sibling, 1 reply; 26+ messages in thread From: Joost van der Sluis @ 2009-09-16 18:18 UTC (permalink / raw) To: Project Archer; +Cc: Jan Kratochvil On Wed, 2009-09-16 at 17:44 +0200, Jan Kratochvil wrote: > On Mon, 14 Sep 2009 16:45:29 +0200, Joost van der Sluis wrote: > > Attached is the patch I have so far, including some tests. > > Please fix it so that it builds with -O2 -Wall -Werror, it also does not > follow the GNU coding style (such as space after a function name). Thanks for your comments and your patch. I had tested everything without optimisation (for debugging) and -Werror because that doesn't compile on windows. > Then also please check regressions of the testsuite - `make -C gdb check' and > comparing gdb.sum before/after the patch. About the testsuite... it takes ages to complete. Is there some way to run just one test (or just one .exp test-file?) > I had to do some of these fixes but it has too many regressions. I don't know anything about the GNU coding style, in fact, I know nothing about c. This is the first c code I wrote in my whole live. That makes fixing the regressions on c-code hard. But I think that there are only a few issues which will fix a lot of regressions. I'll have a look at them. Just a remark: some of your changes in the coding-style are corrections for portions of the code that I copy-pasted from other parts. I use the gdb-code as 'example-code' for the coding style. Is this generally a save assumption, or are there a lot of issues regarding the coding-style in the gdb-code? Joost ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2009-09-16 18:18 ` Joost van der Sluis @ 2009-09-16 18:41 ` Jan Kratochvil 2009-09-16 19:09 ` Joost van der Sluis 0 siblings, 1 reply; 26+ messages in thread From: Jan Kratochvil @ 2009-09-16 18:41 UTC (permalink / raw) To: Joost van der Sluis; +Cc: Project Archer On Wed, 16 Sep 2009 20:17:38 +0200, Joost van der Sluis wrote: > I had tested everything without optimisation (for debugging) and -Werror > because that doesn't compile on windows. Could you please run it also on GNU/Linux as some final test? If you do not have one available there are various test boxes available at sourceforge.net and similar sites or contact me offlist. Testsuite on GNU/Linux should IMO catch most of the possible regressions. > > Then also please check regressions of the testsuite - `make -C gdb check' and > > comparing gdb.sum before/after the patch. > > About the testsuite... it takes ages to complete. One `make check' should take at most about 20 minutes in worst cases, some 5 minutes should be more normal. Sure it is being run just as a final test. Many FAIL results are normal, just regressions are worth a check. > Is there some way to run just one test (or just one .exp test-file?) I use cd gdb/testsuite make site.exp # needed just once runtest runtest gdb.base/start.exp but probably more correct is to just run: cd gdb/testsuite make check RUNTESTFLAGS="gdb.base/start.exp" > I don't know anything about the GNU coding style, No problem just please try to follow the spacing/indentation of the code around despite it looks unusual. http://www.gnu.org/prep/standards/standards.html#Formatting > But I think that there are only a few issues which will fix a lot of > regressions. I'll have a look at them. Yes, I agree, it may be even a single problem. > Just a remark: some of your changes in the coding-style are corrections > for portions of the code that I copy-pasted from other parts. :-) Some existing GDB code may not follow it but I do not know much of such places offhand. (The GNU coding style really was not a primary concern of my mail, feel free to keep the code parts which you are not sure about the formatting intact.) Thanks, Jan ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2009-09-16 18:41 ` Jan Kratochvil @ 2009-09-16 19:09 ` Joost van der Sluis 0 siblings, 0 replies; 26+ messages in thread From: Joost van der Sluis @ 2009-09-16 19:09 UTC (permalink / raw) To: Jan Kratochvil; +Cc: Project Archer On Wed, 2009-09-16 at 20:41 +0200, Jan Kratochvil wrote: > On Wed, 16 Sep 2009 20:17:38 +0200, Joost van der Sluis wrote: > > I had tested everything without optimisation (for debugging) and -Werror > > because that doesn't compile on windows. > > Could you please run it also on GNU/Linux as some final test? If you do not > have one available there are various test boxes available at sourceforge.net > and similar sites or contact me offlist. Testsuite on GNU/Linux should IMO > catch most of the possible regressions. No problem, my primary platform is Fedora. I just also tried it on Windows. Regards, Joost. ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2009-09-16 15:45 ` Jan Kratochvil 2009-09-16 18:18 ` Joost van der Sluis @ 2009-09-30 16:00 ` Joost van der Sluis 2009-10-04 14:17 ` Jan Kratochvil 1 sibling, 1 reply; 26+ messages in thread From: Joost van der Sluis @ 2009-09-30 16:00 UTC (permalink / raw) To: Jan Kratochvil; +Cc: Project Archer [-- Attachment #1: Type: text/plain, Size: 820 bytes --] On Wed, 2009-09-16 at 17:44 +0200, Jan Kratochvil wrote: > On Mon, 14 Sep 2009 16:45:29 +0200, Joost van der Sluis wrote: > > Attached is the patch I have so far, including some tests. > > Please fix it so that it builds with -O2 -Wall -Werror, it also does not > follow the GNU coding style (such as space after a function name). > > Then also please check regressions of the testsuite - `make -C gdb check' and > comparing gdb.sum before/after the patch. Attached it the new patch. There were three issues: One was a problem in mine code. Another one was a strange thing in tekhex.c's move_section_contents that did not allow any offset. And the third was a somewhat incorrect behavior in cp-valprint, which wasn't a problem before but with this patch it is. I tested it and I have no regressions anymore. Joost. [-- Attachment #2: fpc_array_patch_20090930.diff --] [-- Type: text/x-patch, Size: 25387 bytes --] diff --git a/bfd/tekhex.c b/bfd/tekhex.c index 052795d..d8425cb 100644 --- a/bfd/tekhex.c +++ b/bfd/tekhex.c @@ -583,8 +583,7 @@ move_section_contents (bfd *abfd, bfd_vma prev_number = 1; /* Nothing can have this as a high bit. */ struct data_struct *d = NULL; - BFD_ASSERT (offset == 0); - for (addr = section->vma; count != 0; count--, addr++) + for (addr = section->vma + offset; count != 0; count--, addr++) { /* Get high bits of address. */ bfd_vma chunk_number = addr & ~(bfd_vma) CHUNK_MASK; diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c index 565172c..af5def1 100644 --- a/gdb/ada-valprint.c +++ b/gdb/ada-valprint.c @@ -90,7 +90,8 @@ print_optional_low_bound (struct ui_file *stream, struct type *type, if (options->print_array_indexes) return 0; - if (!get_array_bounds (type, &low_bound, &high_bound)) +gdb_assert (0); /* type vs. val */ + if (!get_array_bounds (NULL, &low_bound, &high_bound)) return 0; /* If this is an empty array, then don't print the lower bound. diff --git a/gdb/cp-valprint.c b/gdb/cp-valprint.c index 49d71a4..8e5e08c 100644 --- a/gdb/cp-valprint.c +++ b/gdb/cp-valprint.c @@ -293,11 +293,18 @@ cp_print_value_fields (struct type *type, struct type *real_type, { struct value_print_options opts = *options; opts.deref_ref = 0; - val_print (TYPE_FIELD_TYPE (type, i), - valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, - address + TYPE_FIELD_BITPOS (type, i) / 8, - stream, recurse + 1, &opts, - current_language); + if (address != 0) + val_print (TYPE_FIELD_TYPE (type, i), + valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, + address + TYPE_FIELD_BITPOS (type, i) / 8, + stream, recurse + 1, &opts, + current_language); + else + val_print (TYPE_FIELD_TYPE (type, i), + valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, + 0, + stream, recurse + 1, &opts, + current_language); } } annotate_field_end (); diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 0623204..2296582 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..d52fc32 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 <http://www.gnu.org/licenses/>. + +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 <http://www.gnu.org/licenses/>. +} + +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..af6ab05 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,32 @@ 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; - 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; - } - } + /* 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 + { + 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 +1179,29 @@ 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; + + /* When no data_address is given, use the value already stored in the + inferior ar valaddr. Else force a new fetch of the variable into + the inferior */ + + if (data_address (val) == 0) + element_value = value_from_contents_and_address (TYPE_TARGET_TYPE (type), + valaddr + i * stride, + 0); + else + 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, " <repeats %u times>", reps); annotate_elt_rep_end (); @@ -1190,8 +1211,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..b8439c5 100644 --- a/gdb/value.c +++ b/gdb/value.c @@ -40,6 +40,7 @@ #include "valprint.h" #include "cli/cli-decode.h" #include "observer.h" +#include "dwarf2loc.h" #include "python/python.h" @@ -197,6 +198,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 +248,6 @@ static struct value_history_chunk *value_history_chain; static int value_history_count; /* Abs number of last entry stored */ -\f /* 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 +296,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 +561,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 %ld..%ld"), + 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) == 0) + { + 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 +692,91 @@ 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); + 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)); + } + } + } + /* NOTREACHED */ + return -1; +} + +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) != 0) + { + /* 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); ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2009-09-30 16:00 ` Joost van der Sluis @ 2009-10-04 14:17 ` Jan Kratochvil 2009-10-05 10:08 ` Joost van der Sluis ` (2 more replies) 0 siblings, 3 replies; 26+ messages in thread From: Jan Kratochvil @ 2009-10-04 14:17 UTC (permalink / raw) To: Joost van der Sluis; +Cc: Project Archer On Wed, 30 Sep 2009 17:59:34 +0200, Joost van der Sluis wrote: > Attached it the new patch. Please write GNU style ChangeLog entry for it. I am sorry I did not write the entries myself in the log (as a partial excuse it was not reviewed by anyone that time). > I tested it and I have no regressions anymore. Getting a lot of regressions included below. * Some fortran failures only happen with `ulimit -v 500000'. * Are the new Pascal testcase FAILures expected? If a more recent fpc is required the testcase should XFAIL, not FAIL. You need to have installed at least gcc-gfortran + gcc-gnat with ln -s /usr/bin/gfortran src-toplevel-dir/g77 > @@ -197,6 +198,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; Still I do not like duplicating the information already present in `struct main_type'. I find right you have changed passing some `struct type *' to `struct value *' instead but that new `struct value' just could use copy_type_recursive on that linked `struct type'. Regards, Jan -PASS: gdb.ada/array_return.exp: value printed by finish of Create_Small +FAIL: gdb.ada/array_return.exp: value printed by finish of Create_Small (GDB internal error) -PASS: gdb.ada/array_return.exp: value printed by finish of Create_Large +FAIL: gdb.ada/array_return.exp: value printed by finish of Create_Large (GDB internal error) -PASS: gdb.ada/array_return.exp: value printed by finish of Create_Small_Float_Vector +FAIL: gdb.ada/array_return.exp: value printed by finish of Create_Small_Float_Vector (GDB internal error) -PASS: gdb.ada/arrayidx.exp: print one_two_three, indexes off -FAIL: gdb.ada/arrayidx.exp: print e_one_two_three, indexes off -FAIL: gdb.ada/arrayidx.exp: print r_two_three, indexes off -PASS: gdb.ada/arrayidx.exp: print u_one_two_three, indexes off -PASS: gdb.ada/arrayidx.exp: print p_one_two_three, indexes off -PASS: gdb.ada/arrayidx.exp: print few_reps, indexes off -PASS: gdb.ada/arrayidx.exp: print many_reps, indexes off -PASS: gdb.ada/arrayidx.exp: print empty, indexes off +FAIL: gdb.ada/arrayidx.exp: print one_two_three, indexes off (GDB internal error) +FAIL: gdb.ada/arrayidx.exp: print e_one_two_three, indexes off (GDB internal error) +FAIL: gdb.ada/arrayidx.exp: print r_two_three, indexes off (GDB internal error) +FAIL: gdb.ada/arrayidx.exp: print u_one_two_three, indexes off (GDB internal error) +FAIL: gdb.ada/arrayidx.exp: print p_one_two_three, indexes off (GDB internal error) +FAIL: gdb.ada/arrayidx.exp: print few_reps, indexes off (GDB internal error) +FAIL: gdb.ada/arrayidx.exp: print many_reps, indexes off (GDB internal error) +FAIL: gdb.ada/arrayidx.exp: print empty, indexes off (GDB internal error) -PASS: gdb.ada/mod_from_name.exp: print xp +FAIL: gdb.ada/mod_from_name.exp: print xp (GDB internal error) -PASS: gdb.ada/null_array.exp: print my_matrix +FAIL: gdb.ada/null_array.exp: print my_matrix (GDB internal error) -PASS: gdb.ada/packed_array.exp: print var +FAIL: gdb.ada/packed_array.exp: print var (GDB internal error) -PASS: gdb.ada/packed_array.exp: print &var +FAIL: gdb.ada/packed_array.exp: print &var (GDB internal error) -PASS: gdb.ada/type_coercion.exp: p q +FAIL: gdb.ada/type_coercion.exp: p q (GDB internal error) -PASS: gdb.ada/type_coercion.exp: p q +FAIL: gdb.ada/type_coercion.exp: p q (GDB internal error) -PASS: gdb.ada/variant_record_packed_array.exp: print empty +FAIL: gdb.ada/variant_record_packed_array.exp: print empty (GDB internal error) -PASS: gdb.fortran/dwarf-stride.exp: p c40pt(1) -PASS: gdb.fortran/dwarf-stride.exp: p c40pt(2) +FAIL: gdb.fortran/dwarf-stride.exp: p c40pt(1) (GDB internal error) +FAIL: gdb.fortran/dwarf-stride.exp: p c40pt(2) (GDB internal error) -PASS: gdb.fortran/dynamic.exp: ptype varx allocated +FAIL: gdb.fortran/dynamic.exp: ptype varx allocated (GDB internal error) -PASS: gdb.fortran/dynamic.exp: p varx(2, 5, 17) -PASS: gdb.fortran/dynamic.exp: p varx(1, 5, 17) -PASS: gdb.fortran/dynamic.exp: p varx(2, 6, 18) -PASS: gdb.fortran/dynamic.exp: p varx(6, 15, 28) +FAIL: gdb.fortran/dynamic.exp: p varx(2, 5, 17) (GDB internal error) +FAIL: gdb.fortran/dynamic.exp: p varx(1, 5, 17) (GDB internal error) +FAIL: gdb.fortran/dynamic.exp: p varx(2, 6, 18) (GDB internal error) +FAIL: gdb.fortran/dynamic.exp: p varx(6, 15, 28) (GDB internal error) -PASS: gdb.fortran/dynamic.exp: p varx(3, 7, 19) with varv associated -PASS: gdb.fortran/dynamic.exp: p varv(3, 7, 19) associated +FAIL: gdb.fortran/dynamic.exp: p varx(3, 7, 19) with varv associated (GDB internal error) +FAIL: gdb.fortran/dynamic.exp: p varv(3, 7, 19) associated (GDB internal error) -PASS: gdb.fortran/dynamic.exp: ptype varx with varv associated -PASS: gdb.fortran/dynamic.exp: ptype varv associated +FAIL: gdb.fortran/dynamic.exp: ptype varx with varv associated (GDB internal error) +FAIL: gdb.fortran/dynamic.exp: ptype varv associated (GDB internal error) -PASS: gdb.fortran/dynamic.exp: p varx(3, 7, 19) with varv filled -PASS: gdb.fortran/dynamic.exp: p varv(3, 7, 19) filled +FAIL: gdb.fortran/dynamic.exp: p varx(3, 7, 19) with varv filled (GDB internal error) +FAIL: gdb.fortran/dynamic.exp: p varv(3, 7, 19) filled (GDB internal error) -PASS: gdb.fortran/dynamic.exp: continue to breakpoint: vary-passed -PASS: gdb.fortran/dynamic.exp: p vary -PASS: gdb.fortran/dynamic.exp: continue to breakpoint: vary-filled -PASS: gdb.fortran/dynamic.exp: ptype vary -PASS: gdb.fortran/dynamic.exp: p vary(1, 1) -PASS: gdb.fortran/dynamic.exp: p vary(2, 2) -PASS: gdb.fortran/dynamic.exp: p vary(1, 3) -PASS: gdb.fortran/dynamic.exp: p varw -PASS: gdb.fortran/dynamic.exp: continue to breakpoint: varw-almostfilled -PASS: gdb.fortran/dynamic.exp: ptype varw +FAIL: gdb.fortran/dynamic.exp: continue to breakpoint: vary-passed (timeout) +FAIL: gdb.fortran/dynamic.exp: p vary (GDB internal error) +FAIL: gdb.fortran/dynamic.exp: continue to breakpoint: vary-filled (timeout) +FAIL: gdb.fortran/dynamic.exp: ptype vary (GDB internal error) +FAIL: gdb.fortran/dynamic.exp: p vary(1, 1) (GDB internal error) +FAIL: gdb.fortran/dynamic.exp: p vary(2, 2) (GDB internal error) +FAIL: gdb.fortran/dynamic.exp: p vary(1, 3) (GDB internal error) +FAIL: gdb.fortran/dynamic.exp: p varw +FAIL: gdb.fortran/dynamic.exp: continue to breakpoint: varw-almostfilled (timeout) +FAIL: gdb.fortran/dynamic.exp: ptype varw (GDB internal error) -PASS: gdb.fortran/dynamic.exp: p varw filled -PASS: gdb.fortran/dynamic.exp: finish -PASS: gdb.fortran/dynamic.exp: p z(2,4,5) -PASS: gdb.fortran/dynamic.exp: p z(2,4,6) -PASS: gdb.fortran/dynamic.exp: p z(2,4,7) -PASS: gdb.fortran/dynamic.exp: p z(4,4,6) -PASS: gdb.fortran/dynamic.exp: continue to breakpoint: varz-almostfilled -PASS: gdb.fortran/dynamic.exp: ptype varz -PASS: gdb.fortran/dynamic.exp: ptype vart -PASS: gdb.fortran/dynamic.exp: p varz -PASS: gdb.fortran/dynamic.exp: p vart -PASS: gdb.fortran/dynamic.exp: p varz(3) -PASS: gdb.fortran/dynamic.exp: p vart(2,7) -PASS: gdb.fortran/dynamic.exp: p vart(3,8) -PASS: gdb.fortran/dynamic.exp: p vart(2,9) +FAIL: gdb.fortran/dynamic.exp: p varw filled +FAIL: gdb.fortran/dynamic.exp: finish (GDB internal error) +ERROR: Could not resync from internal error (timeout) +UNRESOLVED: gdb.fortran/dynamic.exp: p z(2,4,5) (timeout) +FAIL: gdb.fortran/dynamic.exp: p z(2,4,6) (timeout) +FAIL: gdb.fortran/dynamic.exp: p z(2,4,7) (timeout) +FAIL: gdb.fortran/dynamic.exp: p z(4,4,6) (timeout) +FAIL: gdb.fortran/dynamic.exp: setting breakpoint at 68 (timeout) +FAIL: gdb.fortran/dynamic.exp: continue to breakpoint: varz-almostfilled (timeout) +FAIL: gdb.fortran/dynamic.exp: ptype varz (timeout) +FAIL: gdb.fortran/dynamic.exp: ptype vart (timeout) +FAIL: gdb.fortran/dynamic.exp: p varz (timeout) +FAIL: gdb.fortran/dynamic.exp: p vart (timeout) +FAIL: gdb.fortran/dynamic.exp: p varz(3) (timeout) +FAIL: gdb.fortran/dynamic.exp: p vart(2,7) (timeout) +FAIL: gdb.fortran/dynamic.exp: p vart(3,8) (timeout) +FAIL: gdb.fortran/dynamic.exp: p vart(2,9) (timeout) +Running ./gdb.pascal/arrays.exp ... +PASS: gdb.pascal/arrays.exp: setting breakpoint 1 +PASS: gdb.pascal/arrays.exp: setting breakpoint 2 +PASS: gdb.pascal/arrays.exp: start +PASS: gdb.pascal/arrays.exp: Going to first breakpoint +PASS: gdb.pascal/arrays.exp: Print static array of integer type +PASS: gdb.pascal/arrays.exp: Print static array of integer +PASS: gdb.pascal/arrays.exp: Going to second breakpoint +FAIL: gdb.pascal/arrays.exp: Print dynamic array of integer type +FAIL: gdb.pascal/arrays.exp: Print dynamic array of integer +FAIL: gdb.pascal/arrays.exp: Print string containing null-char +FAIL: gdb.pascal/arrays.exp: Print dynamic array of string +FAIL: gdb.pascal/arrays.exp: Print static array of string +FAIL: gdb.pascal/arrays.exp: Print dynamic array of char +PASS: gdb.pascal/arrays.exp: Print static array of char +PASS: gdb.pascal/arrays.exp: Print static 2-dimensional array of integer ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2009-10-04 14:17 ` Jan Kratochvil @ 2009-10-05 10:08 ` Joost van der Sluis [not found] ` <1254737231.3257.20.camel@wsjoost.cnoc.lan> 2009-10-28 17:35 ` Joost van der Sluis 2 siblings, 0 replies; 26+ messages in thread From: Joost van der Sluis @ 2009-10-05 10:08 UTC (permalink / raw) To: Project Archer On Sun, 2009-10-04 at 16:17 +0200, Jan Kratochvil wrote: > On Wed, 30 Sep 2009 17:59:34 +0200, Joost van der Sluis wrote: > > Attached it the new patch. > > Please write GNU style ChangeLog entry for it. I am sorry I did not write the > entries myself in the log (as a partial excuse it was not reviewed by anyone > that time). > > > > I tested it and I have no regressions anymore. > > Getting a lot of regressions included below. I had no Fortran installed. > * Some fortran failures only happen with `ulimit -v 500000'. > * Are the new Pascal testcase FAILures expected? If a more recent fpc is > required the testcase should XFAIL, not FAIL. Yes, they need a new fpc-version (2.3.1 or higher). > > @@ -197,6 +198,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; > > > Still I do not like duplicating the information already present in `struct > main_type'. I find right you have changed passing some `struct type *' to > `struct value *' instead but that new `struct value' just could use > copy_type_recursive on that linked `struct type'. I didn't thought about that. In principle, that information should be removed from 'struct main_type', since the lower_bound, upper_bound and length aren't defined for plain structures, without any address set. But that would be far to intrusive. But I wanted to do it as 'clean' as possible, that's why the duplication. I'll look if I can fix it without the duplication as you suggested. Thanks for looking at it, Joost ^ permalink raw reply [flat|nested] 26+ messages in thread
[parent not found: <1254737231.3257.20.camel@wsjoost.cnoc.lan>]
* Re: Patch for pascal-dynamic arrays [not found] ` <1254737231.3257.20.camel@wsjoost.cnoc.lan> @ 2009-10-05 14:43 ` Jan Kratochvil 0 siblings, 0 replies; 26+ messages in thread From: Jan Kratochvil @ 2009-10-05 14:43 UTC (permalink / raw) To: Joost van der Sluis; +Cc: Project Archer On Mon, 05 Oct 2009 12:07:11 +0200, Joost van der Sluis wrote: > On Sun, 2009-10-04 at 16:17 +0200, Jan Kratochvil wrote: ... > > * Are the new Pascal testcase FAILures expected? If a more recent fpc is > > required the testcase should XFAIL, not FAIL. > > Yes, they need a new fpc-version (2.3.1 or higher). So the testcase should check the version (or if the seen behavior is clear it is the old version) and setup_xfail appropriately. > In principle, that information should be > removed from 'struct main_type', since the lower_bound, upper_bound and > length aren't defined for plain structures, without any address set. This is again about the question whether dynamic types should be: * fully dynamic, evaluating the bound value on each access by GDB code (it was this way in the very first VLA patch version) I was suggesting this solution in: http://sourceware.org/ml/archer/2009-q2/msg00181.html * static using check_typedef() as the current GDB codebase where a dynamic type gets instantiated into its static type variant before it gets used (this is the current VLA patch version) One needs object_address for the instantiation but not later. Your patch goes +/- the latter way by the instaniation (via field `checked_dynamics') but still it would require to change all the functions handling `struct type *' for possible arrays as even after the instantiation `struct type *' is not enough there'. Anyway if it gets regression-free I am fine with including it into archer-jankratochvil-vla in its current form (after reviewing of the regression-free form). But still for FSF GDB HEAD I would like to see introducing something like `struct dynamic_type *' evaluated dynamically and requiring object_address for it while being passed as normal `struct type *' to the legacy parts of GDB. One should not be able to interchange pre-check_typedef() and post-check_typedef() types in the code as they are two different kinds. But that is not done now. Thanks, Jan ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2009-10-04 14:17 ` Jan Kratochvil 2009-10-05 10:08 ` Joost van der Sluis [not found] ` <1254737231.3257.20.camel@wsjoost.cnoc.lan> @ 2009-10-28 17:35 ` Joost van der Sluis 2009-10-30 9:47 ` Jan Kratochvil 2 siblings, 1 reply; 26+ messages in thread From: Joost van der Sluis @ 2009-10-28 17:35 UTC (permalink / raw) To: Jan Kratochvil; +Cc: Project Archer [-- Attachment #1: Type: text/plain, Size: 3548 bytes --] On Sun, 2009-10-04 at 16:17 +0200, Jan Kratochvil wrote: > On Wed, 30 Sep 2009 17:59:34 +0200, Joost van der Sluis wrote: > > Attached it the new patch. > > Please write GNU style ChangeLog entry for it. I am sorry I did not write the > entries myself in the log (as a partial excuse it was not reviewed by anyone > that time). I've done my best, see below. > > I tested it and I have no regressions anymore. > > Getting a lot of regressions included below. > * Some fortran failures only happen with `ulimit -v 500000'. > * Are the new Pascal testcase FAILures expected? If a more recent fpc is > required the testcase should XFAIL, not FAIL. > You need to have installed at least gcc-gfortran + gcc-gnat with > ln -s /usr/bin/gfortran src-toplevel-dir/g77 > > @@ -197,6 +198,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; > > > Still I do not like duplicating the information already present in `struct > main_type'. I find right you have changed passing some `struct type *' to > `struct value *' instead but that new `struct value' just could use > copy_type_recursive on that linked `struct type'. I've reworked the patch and removed these duplicates. It does not try to do some things fully dynamic anymore. I think this patch is more suitable to be included in FSF GDB. I think you'll like it. I've added some tests to the pascal-tests so they XFail when an older version of fpc is installed, and the tests aren't runned at all when gpc is used as pascal-compiler. I've tested for regressions, this time with ada and fortran enabled and didn't have any regressions. Here's the changelog: 2009-10-28 Joost van der Sluis <joost@cnoc.nl> * tekhex.c (move_section_contents): fixed usage of offset parameter * cp-valprint.c (cp_print_value_fields): when the address is 0, do not pass the 0 value increased with some offset to val_print, but pass 0 instead * gdbtypes.c, gdbtypes.h (check_typedef, check_typedef_target) Added check_typedef_target which resolves the target type without doing a full check_typedef * p-valprint.c (pascal_val_print) Do not Handle arrays of integers as strings * p-valprint.c (pascal_val_print) When printing array-elements use the original passed type, and not one which is handled by check_typedef * arrays.exp New tests for arrays in fpc * pascal.exp Added variables fpcversion_major, fpcversion_minor and fpcversion_release with the version of the used compiler * valprint.c, valprint.h (get_array_bounds) Changed first parameter from struct type into struct value * valprint.c (val_print_array_elements) Calculate the amount of elements in an array always by substracting the upper and lower bound * valprint.c (val_print_array_elements) For each element in the array, create a new struct value and print it using common_val_print, so that all elements are properly evaluated * value.c, value.h (struct value) Added data_address to struct value. Added the functions data_address and set_data_address * value.c, value.h (set_value_address) Use object_address_get_data to set data_addr * value.c, value.h (value_lower_bound, value_upper_bound, get_bound) Added these functions to get the lower and upper bound of an value struct containing an array 2009 Jan Kratochvil <jan.kratochvil@redhat.com>> * ada-valprint.c (print_optional_low_bound): no idea [-- Attachment #2: pascal_array_patch_20091028.diff --] [-- Type: text/x-patch, Size: 22738 bytes --] diff --git a/bfd/tekhex.c b/bfd/tekhex.c index 052795d..d8425cb 100644 --- a/bfd/tekhex.c +++ b/bfd/tekhex.c @@ -583,8 +583,7 @@ move_section_contents (bfd *abfd, bfd_vma prev_number = 1; /* Nothing can have this as a high bit. */ struct data_struct *d = NULL; - BFD_ASSERT (offset == 0); - for (addr = section->vma; count != 0; count--, addr++) + for (addr = section->vma + offset; count != 0; count--, addr++) { /* Get high bits of address. */ bfd_vma chunk_number = addr & ~(bfd_vma) CHUNK_MASK; diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c index 565172c..af5def1 100644 --- a/gdb/ada-valprint.c +++ b/gdb/ada-valprint.c @@ -90,7 +90,8 @@ print_optional_low_bound (struct ui_file *stream, struct type *type, if (options->print_array_indexes) return 0; - if (!get_array_bounds (type, &low_bound, &high_bound)) +gdb_assert (0); /* type vs. val */ + if (!get_array_bounds (NULL, &low_bound, &high_bound)) return 0; /* If this is an empty array, then don't print the lower bound. diff --git a/gdb/cp-valprint.c b/gdb/cp-valprint.c index 49d71a4..8e5e08c 100644 --- a/gdb/cp-valprint.c +++ b/gdb/cp-valprint.c @@ -293,11 +293,18 @@ cp_print_value_fields (struct type *type, struct type *real_type, { struct value_print_options opts = *options; opts.deref_ref = 0; - val_print (TYPE_FIELD_TYPE (type, i), - valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, - address + TYPE_FIELD_BITPOS (type, i) / 8, - stream, recurse + 1, &opts, - current_language); + if (address != 0) + val_print (TYPE_FIELD_TYPE (type, i), + valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, + address + TYPE_FIELD_BITPOS (type, i) / 8, + stream, recurse + 1, &opts, + current_language); + else + val_print (TYPE_FIELD_TYPE (type, i), + valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, + 0, + stream, recurse + 1, &opts, + current_language); } } annotate_field_end (); diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 0623204..2296582 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..b682829 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 type *orgtype; unsigned eltlen; int length_pos, length_size, string_pos; struct type *char_type; LONGEST val; CORE_ADDR addr; + orgtype = type; + 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 (orgtype, 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..ccc6e1e --- /dev/null +++ b/gdb/testsuite/gdb.pascal/arrays.exp @@ -0,0 +1,104 @@ +# 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 <http://www.gnu.org/licenses/>. + +if $tracelevel then { + strace $tracelevel +} + +load_lib "pascal.exp" + +set testfile "arrays" +set srcfile ${testfile}.pas +set binfile ${objdir}/${subdir}/${testfile}$EXEEXT + +# These tests only work with fpc, using the -gw3 compile-option +pascal_init +if { $pascal_compiler_is_fpc != 1 } { + return -1 +} + +# Detect if the fpc version is below 2.3.0 +set fpc_generates_dwarf_for_dynamic_arrays 1 +if { ($fpcversion_major < 2) || ( ($fpcversion_major == 2) && ($fpcversion_minor < 3))} { + set fpc_generates_dwarf_for_dynamic_arrays 0 +} + + +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 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" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrInt" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer type" +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrInt_" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print s" ".* = 'test'#0'string'" "Print string containing null-char" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrStr" ".* = \\{'dstr0', 'dstr1', 'dstr2', 'dstr3', 'dstr4', 'dstr5', 'dstr6', 'dstr7', 'dstr8', 'dstr9', 'dstr10', 'dstr11', 'dstr12'\\}" "Print dynamic array of string" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print StatArrStr" ".* = \\{'str0', 'str1', 'str2', 'str3', 'str4', 'str5', 'str6', 'str7', 'str8', 'str9', 'str10', 'str11', 'str12'\\}" "Print static array of string" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrChar" ".* = 'abcdefghijklm'" "Print dynamic array of char" + 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 <http://www.gnu.org/licenses/>. +} + +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/testsuite/lib/pascal.exp b/gdb/testsuite/lib/pascal.exp index 146eaec..7115f58 100644 --- a/gdb/testsuite/lib/pascal.exp +++ b/gdb/testsuite/lib/pascal.exp @@ -37,6 +37,9 @@ proc pascal_init {} { global pascal_compiler_is_fpc global gpc_compiler global fpc_compiler + global fpcversion_major + global fpcversion_minor + global fpcversion_release global env if { $pascal_init_done == 1 } { @@ -64,6 +67,20 @@ proc pascal_init {} { set pascal_compiler_is_fpc 1 verbose -log "Free Pascal compiler found" } + + # Detect the fpc-version + if { $pascal_compiler_is_fpc == 1 } { + set fpcversion_major 1 + set fpcversion_minor 0 + set fpcversion_release 0 + set fpcversion [ remote_exec host $fpc_compiler "-iV" ] + if [regexp {.*([0-9]+)\.([0-9]+)\.([0-9]+).?} $fpcversion] { + regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\1} fpcversion_major + regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\2} fpcversion_minor + regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\3} fpcversion_release + } + verbose -log "Freepascal version: $fpcversion_major.$fpcversion_minor.$fpcversion_release" + } } set pascal_init_done 1 } diff --git a/gdb/valops.c b/gdb/valops.c index 0ffccaf..c24dabd 100644 --- a/gdb/valops.c +++ b/gdb/valops.c @@ -719,8 +719,8 @@ 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)); + struct type *type = value_enclosing_type (val); + int length = TYPE_LENGTH (check_typedef (type)); if (length) { diff --git a/gdb/valprint.c b/gdb/valprint.c index e5b12f2..f71065e 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,32 @@ 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; - 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; - } - } + /* 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 + { + 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 +1179,29 @@ 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; + + /* When no data_address is given, use the value already stored in the + inferior at valaddr. Else force a new fetch of the variable into + the inferior */ + + if (data_address (val) == 0) + element_value = value_from_contents_and_address (TYPE_TARGET_TYPE (type), + valaddr + i * stride, + 0); + else + 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, " <repeats %u times>", reps); annotate_elt_rep_end (); @@ -1190,8 +1211,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..3475b6e 100644 --- a/gdb/value.c +++ b/gdb/value.c @@ -40,6 +40,7 @@ #include "valprint.h" #include "cli/cli-decode.h" #include "observer.h" +#include "dwarf2loc.h" #include "python/python.h" @@ -197,6 +198,8 @@ struct value /* If value is a variable, is it initialized or not. */ int initialized; + CORE_ADDR data_address; + /* 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 +243,6 @@ static struct value_history_chunk *value_history_chain; static int value_history_count; /* Abs number of last entry stored */ -\f /* 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. */ @@ -554,9 +556,23 @@ 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 +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 +593,53 @@ 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); + 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)); + } + } + } + /* NOTREACHED */ + return -1; +} + +long +value_lower_bound (struct value *value) +{ + return get_bound (value_type (value), 0); +} + +long +value_upper_bound (struct value *value) +{ + return get_bound (value_type (value), 1); +} + int deprecated_value_modifiable (struct value *value) { diff --git a/gdb/value.h b/gdb/value.h index aa4b3db..5011c09 100644 --- a/gdb/value.h +++ b/gdb/value.h @@ -289,6 +289,10 @@ 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); + + /* Pointer to internal variable. */ extern struct internalvar **deprecated_value_internalvar_hack (struct value *); #define VALUE_INTERNALVAR(val) (*deprecated_value_internalvar_hack (val)) @@ -302,6 +306,10 @@ 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 long value_lower_bound (struct value *); +extern long value_upper_bound (struct value *); + /* Convert a REF to the object referenced. */ extern struct value *coerce_ref (struct value *value); ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2009-10-28 17:35 ` Joost van der Sluis @ 2009-10-30 9:47 ` Jan Kratochvil 2009-11-07 21:49 ` Joost van der Sluis 0 siblings, 1 reply; 26+ messages in thread From: Jan Kratochvil @ 2009-10-30 9:47 UTC (permalink / raw) To: Joost van der Sluis; +Cc: Project Archer On Wed, 28 Oct 2009 18:34:46 +0100, Joost van der Sluis wrote: > I've tested for regressions, this time with ada and fortran enabled and > didn't have any regressions. I get: $ cd gdb/testsuite; make site.exp; runtest gdb.ada/variant_record_packed_array.exp Running ./gdb.ada/variant_record_packed_array.exp ... FAIL: gdb.ada/variant_record_packed_array.exp: print empty (GDB internal error) (gdb) print my_buffer $1 = (size => 8, buffer => (ada-valprint.c:93: internal-error: print_optional_low_bound: Assertion `0' failed. A problem internal to GDB has been detected, further debugging may prove unreliable. Quit this debugging session? (y or n) FAIL: gdb.ada/variant_record_packed_array.exp: print empty (GDB internal error) gcc-gnat-4.4.2-4.fc12.x86_64 This is due to my part of the patch as commented below: > 2009 Jan Kratochvil <jan.kratochvil@redhat.com>> > * ada-valprint.c (print_optional_low_bound): no idea I do not understand how could this patch pass your regression testing. (Fortran testcases now PASS for me so this is just a minor point, thanks.) The patch otherwise looks as a nice extension for archer-jankratochvil-vla now but please fix up this ADA part. > * tekhex.c (move_section_contents): fixed usage of offset parameter > --- a/bfd/tekhex.c > +++ b/bfd/tekhex.c > @@ -583,8 +583,7 @@ move_section_contents (bfd *abfd, > bfd_vma prev_number = 1; /* Nothing can have this as a high bit. */ > struct data_struct *d = NULL; > > - BFD_ASSERT (offset == 0); > - for (addr = section->vma; count != 0; count--, addr++) > + for (addr = section->vma + offset; count != 0; count--, addr++) > { > /* Get high bits of address. */ > bfd_vma chunk_number = addr & ~(bfd_vma) CHUNK_MASK; (a) You use tekhex binary format for some builds wrt Pascal? (b) OFFSET is already asserted as 0, this change must be a nop. > 2009 Jan Kratochvil <jan.kratochvil@redhat.com>> > * ada-valprint.c (print_optional_low_bound): no idea > diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c > index 565172c..af5def1 100644 > --- a/gdb/ada-valprint.c > +++ b/gdb/ada-valprint.c > @@ -90,7 +90,8 @@ print_optional_low_bound (struct ui_file *stream, struct type *type, > if (options->print_array_indexes) > return 0; > > - if (!get_array_bounds (type, &low_bound, &high_bound)) > +gdb_assert (0); /* type vs. val */ > + if (!get_array_bounds (NULL, &low_bound, &high_bound)) > return 0; > > /* If this is an empty array, then don't print the lower bound. This patch I wrote to be able to build GDB first the first variant of the patch as you built it without -Wall -Werror and thus the code was invalid. As you changed the get_array_bounds prototype to require now `struct value *' and not `struct type *' as befoer the ADA code was no longer compatible. I did not find simple enough to fix it, there is no `struct value *' available at that specific point of ADA code. Either (a) one should pass `struct value *' there somehow or (b) one should still provide get_array_bounds variant accepting just `struct type *' for such cases. Whether (b) is a feasible way or whether one should go the (a) way I found to be more decided by the author of the patch - you. One needs to care of all the targets and supported languages in the GNU projects as even the generic code benefits from the code contributed by the people around such specific targets/languages as ADA. > * cp-valprint.c (cp_print_value_fields): when the address is 0, do not pass > the 0 value increased with some offset to val_print, but pass 0 instead > --- a/gdb/cp-valprint.c > +++ b/gdb/cp-valprint.c > - val_print (TYPE_FIELD_TYPE (type, i), > - valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, > - address + TYPE_FIELD_BITPOS (type, i) / 8, > - stream, recurse + 1, &opts, > - current_language); > + if (address != 0) > + val_print (TYPE_FIELD_TYPE (type, i), > + valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, > + address + TYPE_FIELD_BITPOS (type, i) / 8, > + stream, recurse + 1, &opts, > + current_language); > + else > + val_print (TYPE_FIELD_TYPE (type, i), > + valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, > + 0, > + stream, recurse + 1, &opts, > + current_language); ADDRESS zero is a valid address of a variable on some targets, it must not be treated as a specific "undefined" case. GDB for example uses for this purpose value ~0 (INVALID_ENTRY_POINT) which is also not right but less probable to be hit in real world cases. (Still this part is OK for archer-jankratochvil-vla but not for FSF GDB.) > + type=check_typedef_target (type); ^^^ -> type = check_typedef http://www.gnu.org/prep/standards/standards.html#Formatting > @@ -240,7 +243,6 @@ static struct value_history_chunk *value_history_chain; > > static int value_history_count; /* Abs number of last entry stored */ > > -\f > /* 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. */ Please drop such excessive patch changes. > @@ -554,9 +556,23 @@ 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 > +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 ** "data_address" is very general name when it is `struct value *' specific, I would prefer some value_data_address / set_value_data_address, don't you? > @@ -577,6 +593,53 @@ 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); > + 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)); > + } > + } > + } > + /* NOTREACHED */ > + return -1; > +} > + > +long > +value_lower_bound (struct value *value) > +{ > + return get_bound (value_type (value), 0); > +} > + > +long > +value_upper_bound (struct value *value) > +{ > + return get_bound (value_type (value), 1); > +} > + > int > deprecated_value_modifiable (struct value *value) > { The `long' data type is neither the minimal static bound as returned for FIELD_LOC_KIND_BITPOS (which is currently `int') nor large enough to catch CORE_ADDR of dwarf_locexpr_baton_eval (on some 32bit hosts with 64bit target requiring `long long'). I would find `int' here more appropriate to just copy the FIELD_LOC_KIND_BITPOS (main_type.fields->loc.bitpos) type. Thanks, Jan ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2009-10-30 9:47 ` Jan Kratochvil @ 2009-11-07 21:49 ` Joost van der Sluis 2010-04-12 11:25 ` Joost van der Sluis 0 siblings, 1 reply; 26+ messages in thread From: Joost van der Sluis @ 2009-11-07 21:49 UTC (permalink / raw) To: Jan Kratochvil; +Cc: Project Archer [-- Attachment #1: Type: text/plain, Size: 5485 bytes --] On Fri, 2009-10-30 at 10:47 +0100, Jan Kratochvil wrote: > On Wed, 28 Oct 2009 18:34:46 +0100, Joost van der Sluis wrote: > > * tekhex.c (move_section_contents): fixed usage of offset parameter > > > --- a/bfd/tekhex.c > > +++ b/bfd/tekhex.c > > @@ -583,8 +583,7 @@ move_section_contents (bfd *abfd, > > bfd_vma prev_number = 1; /* Nothing can have this as a high bit. */ > > struct data_struct *d = NULL; > > > > - BFD_ASSERT (offset == 0); > > - for (addr = section->vma; count != 0; count--, addr++) > > + for (addr = section->vma + offset; count != 0; count--, addr++) > > { > > /* Get high bits of address. */ > > bfd_vma chunk_number = addr & ~(bfd_vma) CHUNK_MASK; > > (a) You use tekhex binary format for some builds wrt Pascal? > (b) OFFSET is already asserted as 0, this change must be a nop. This code caused some regressions, unrelated to pascal. There are some tests that write large arrays to disk and then reads them again. Point is that this function has a parameter 'offset', but I think that someone saw that it was never implemented, and thus added the assert to check that it was always 0. But with my patch, this was not the case, so I implemented the offset for other values then 0. I still think that this is a valid fix, but I saw that I can omit this change without a regression anymore. So that's no problem. > > 2009 Jan Kratochvil <jan.kratochvil@redhat.com>> > > * ada-valprint.c (print_optional_low_bound): no idea > > > diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c > > index 565172c..af5def1 100644 > > --- a/gdb/ada-valprint.c > > +++ b/gdb/ada-valprint.c > > @@ -90,7 +90,8 @@ print_optional_low_bound (struct ui_file *stream, struct type *type, > > if (options->print_array_indexes) > > return 0; > > > > - if (!get_array_bounds (type, &low_bound, &high_bound)) > > +gdb_assert (0); /* type vs. val */ > > + if (!get_array_bounds (NULL, &low_bound, &high_bound)) > > return 0; > > > > /* If this is an empty array, then don't print the lower bound. > > This patch I wrote to be able to build GDB first the first variant of the > patch as you built it without -Wall -Werror and thus the code was invalid. > > As you changed the get_array_bounds prototype to require now `struct value *' > and not `struct type *' as befoer the ADA code was no longer compatible. > > I did not find simple enough to fix it, there is no `struct value *' available > at that specific point of ADA code. Either (a) one should pass > `struct value *' there somehow or (b) one should still provide > get_array_bounds variant accepting just `struct type *' for such cases. > Whether (b) is a feasible way or whether one should go the (a) way I found to > be more decided by the author of the patch - you. Attached is a completely other way. This change from 'struct type' to 'struct value' was not strictly needed anymore. So I removed it. > One needs to care of all the targets and supported languages in the GNU > projects as even the generic code benefits from the code contributed by the > people around such specific targets/languages as ADA. Or Pascal. I do understand this very well.. ;) > > * cp-valprint.c (cp_print_value_fields): when the address is 0, do not pass > > the 0 value increased with some offset to val_print, but pass 0 instead > > > --- a/gdb/cp-valprint.c > > +++ b/gdb/cp-valprint.c > > - val_print (TYPE_FIELD_TYPE (type, i), > > - valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, > > - address + TYPE_FIELD_BITPOS (type, i) / 8, > > - stream, recurse + 1, &opts, > > - current_language); > > + if (address != 0) > > + val_print (TYPE_FIELD_TYPE (type, i), > > + valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, > > + address + TYPE_FIELD_BITPOS (type, i) / 8, > > + stream, recurse + 1, &opts, > > + current_language); > > + else > > + val_print (TYPE_FIELD_TYPE (type, i), > > + valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, > > + 0, > > + stream, recurse + 1, &opts, > > + current_language); > > ADDRESS zero is a valid address of a variable on some targets, it must not be > treated as a specific "undefined" case. GDB for example uses for this purpose > value ~0 (INVALID_ENTRY_POINT) which is also not right but less probable to be > hit in real world cases. > (Still this part is OK for archer-jankratochvil-vla but not for FSF GDB.) Do you have a suggestion how to fix this? I did this to fix one single regression: FAIL: gdb.base/call-rt-st.exp: print print_one_large_struct(*list1) The problem is that cp_print_value_fields is called with an invalid address value of 0. And not ~0. That's not really my fault... Maybe I can fix this one call from the test, but I thought that is was better to fix this for the more general case. > > @@ -240,7 +243,6 @@ static struct value_history_chunk *value_history_chain; > > > > static int value_history_count; /* Abs number of last entry stored */ > > > > -\f > > /* 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. */ > > Please drop such excessive patch changes. A remaining of the few ours I tried to use Eclipse. And I don't know how to get rid of it using git. But I can delete it from the patch. ;) Joost [-- Attachment #2: pascal_array_patch_20091107.diff --] [-- Type: text/x-patch, Size: 19676 bytes --] diff --git a/gdb/cp-valprint.c b/gdb/cp-valprint.c index 49d71a4..8e5e08c 100644 --- a/gdb/cp-valprint.c +++ b/gdb/cp-valprint.c @@ -293,11 +293,18 @@ cp_print_value_fields (struct type *type, struct type *real_type, { struct value_print_options opts = *options; opts.deref_ref = 0; - val_print (TYPE_FIELD_TYPE (type, i), - valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, - address + TYPE_FIELD_BITPOS (type, i) / 8, - stream, recurse + 1, &opts, - current_language); + if (address != 0) + val_print (TYPE_FIELD_TYPE (type, i), + valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, + address + TYPE_FIELD_BITPOS (type, i) / 8, + stream, recurse + 1, &opts, + current_language); + else + val_print (TYPE_FIELD_TYPE (type, i), + valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8, + 0, + stream, recurse + 1, &opts, + current_language); } } annotate_field_end (); diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 0623204..f5d71c7 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..b682829 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 type *orgtype; unsigned eltlen; int length_pos, length_size, string_pos; struct type *char_type; LONGEST val; CORE_ADDR addr; + orgtype = type; + 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 (orgtype, 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..ccc6e1e --- /dev/null +++ b/gdb/testsuite/gdb.pascal/arrays.exp @@ -0,0 +1,104 @@ +# 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 <http://www.gnu.org/licenses/>. + +if $tracelevel then { + strace $tracelevel +} + +load_lib "pascal.exp" + +set testfile "arrays" +set srcfile ${testfile}.pas +set binfile ${objdir}/${subdir}/${testfile}$EXEEXT + +# These tests only work with fpc, using the -gw3 compile-option +pascal_init +if { $pascal_compiler_is_fpc != 1 } { + return -1 +} + +# Detect if the fpc version is below 2.3.0 +set fpc_generates_dwarf_for_dynamic_arrays 1 +if { ($fpcversion_major < 2) || ( ($fpcversion_major == 2) && ($fpcversion_minor < 3))} { + set fpc_generates_dwarf_for_dynamic_arrays 0 +} + + +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 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" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrInt" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer type" +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrInt_" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print s" ".* = 'test'#0'string'" "Print string containing null-char" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrStr" ".* = \\{'dstr0', 'dstr1', 'dstr2', 'dstr3', 'dstr4', 'dstr5', 'dstr6', 'dstr7', 'dstr8', 'dstr9', 'dstr10', 'dstr11', 'dstr12'\\}" "Print dynamic array of string" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print StatArrStr" ".* = \\{'str0', 'str1', 'str2', 'str3', 'str4', 'str5', 'str6', 'str7', 'str8', 'str9', 'str10', 'str11', 'str12'\\}" "Print static array of string" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrChar" ".* = 'abcdefghijklm'" "Print dynamic array of char" + 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 <http://www.gnu.org/licenses/>. +} + +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/testsuite/lib/pascal.exp b/gdb/testsuite/lib/pascal.exp index 146eaec..7115f58 100644 --- a/gdb/testsuite/lib/pascal.exp +++ b/gdb/testsuite/lib/pascal.exp @@ -37,6 +37,9 @@ proc pascal_init {} { global pascal_compiler_is_fpc global gpc_compiler global fpc_compiler + global fpcversion_major + global fpcversion_minor + global fpcversion_release global env if { $pascal_init_done == 1 } { @@ -64,6 +67,20 @@ proc pascal_init {} { set pascal_compiler_is_fpc 1 verbose -log "Free Pascal compiler found" } + + # Detect the fpc-version + if { $pascal_compiler_is_fpc == 1 } { + set fpcversion_major 1 + set fpcversion_minor 0 + set fpcversion_release 0 + set fpcversion [ remote_exec host $fpc_compiler "-iV" ] + if [regexp {.*([0-9]+)\.([0-9]+)\.([0-9]+).?} $fpcversion] { + regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\1} fpcversion_major + regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\2} fpcversion_minor + regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\3} fpcversion_release + } + verbose -log "Freepascal version: $fpcversion_major.$fpcversion_minor.$fpcversion_release" + } } set pascal_init_done 1 } diff --git a/gdb/valprint.c b/gdb/valprint.c index e5b12f2..51be803 100644 --- a/gdb/valprint.c +++ b/gdb/valprint.c @@ -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 (type); + high = value_upper_bound (type); } 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,28 +1119,28 @@ 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; - 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; - } - } + /* Always use the bounds to calculate the amount of + elements in the array. */ + { + 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; + } + } /* Get the array low bound. This only makes sense if the array has one or more element in it. */ @@ -1177,10 +1179,29 @@ 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; + + /* When no data_address is given, use the value already stored in the + inferior at valaddr. Else force a new fetch of the variable into + the inferior */ + + if (value_data_address (val) == 0) + element_value = value_from_contents_and_address (TYPE_TARGET_TYPE (type), + valaddr + i * stride, + 0); + else + element_value = value_at_lazy (TYPE_TARGET_TYPE (type), value_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, " <repeats %u times>", reps); annotate_elt_rep_end (); @@ -1190,8 +1211,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/value.c b/gdb/value.c index b79d84d..8c06d08 100644 --- a/gdb/value.c +++ b/gdb/value.c @@ -40,6 +40,7 @@ #include "valprint.h" #include "cli/cli-decode.h" #include "observer.h" +#include "dwarf2loc.h" #include "python/python.h" @@ -197,6 +198,8 @@ struct value /* If value is a variable, is it initialized or not. */ int initialized; + CORE_ADDR value_data_address; + /* 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; @@ -554,9 +556,24 @@ 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); + set_value_data_address (value, data_addr); +} + +CORE_ADDR +value_data_address (struct value *value) +{ + return value->value_data_address; +} + +void +set_value_data_address (struct value *value, CORE_ADDR addr) +{ + value->value_data_address = addr; } struct internalvar ** @@ -578,6 +595,53 @@ deprecated_value_regnum_hack (struct value *value) } int +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); + 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)); + } + } + } + /* NOTREACHED */ + return -1; +} + +int +value_lower_bound (struct type *type) +{ + return get_bound (type, 0); +} + +int +value_upper_bound (struct type *type) +{ + return get_bound (type, 1); +} + +int deprecated_value_modifiable (struct value *value) { return value->modifiable; diff --git a/gdb/value.h b/gdb/value.h index aa4b3db..f73e873 100644 --- a/gdb/value.h +++ b/gdb/value.h @@ -289,6 +289,10 @@ 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 value_data_address (struct value *); +extern void set_value_data_address (struct value *, CORE_ADDR); + + /* Pointer to internal variable. */ extern struct internalvar **deprecated_value_internalvar_hack (struct value *); #define VALUE_INTERNALVAR(val) (*deprecated_value_internalvar_hack (val)) @@ -302,6 +306,10 @@ 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 int value_lower_bound (struct type *); +extern int value_upper_bound (struct type *); + /* Convert a REF to the object referenced. */ extern struct value *coerce_ref (struct value *value); ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2009-11-07 21:49 ` Joost van der Sluis @ 2010-04-12 11:25 ` Joost van der Sluis 2010-04-12 19:51 ` Jan Kratochvil 0 siblings, 1 reply; 26+ messages in thread From: Joost van der Sluis @ 2010-04-12 11:25 UTC (permalink / raw) To: Jan Kratochvil; +Cc: Project Archer [-- Attachment #1: Type: text/plain, Size: 2748 bytes --] On Sat, 2009-11-07 at 22:48 +0100, Joost van der Sluis wrote: > On Fri, 2009-10-30 at 10:47 +0100, Jan Kratochvil wrote: Some time has passed, and to my suprise one of the problems got solved in the FSF-gdb head. (in cp-valprint.c) I have a new patch now that doesn't cause any regressions on my system, but fixes problems with pascal-dynamic arrays. The patch is attached, the changelog below. Any comments, improvements, suggestions? (patch is against the archer-jankratochvil-vla branch) 2010-04-12 Joost van der Sluis <joost@cnoc.nl> * tekhex.c (move_section_contents): implemented usage of offset parameter, which was always 0 but not anymore due to changes is val_print_array_elements * gdbtypes.c, gdbtypes.h (check_typedef, check_typedef_target) Added check_typedef_target which resolves the target type without doing a full check_typedef, so that the result still can be dynamic * p-valprint.c (pascal_val_print) Do not Handle arrays of integers as strings * p-valprint.c (pascal_val_print) When printing array-elements use the original passed type, and not one which is handled by check_typedef * p-valprint.c (pascal_val_print) Pass the embedded offset as a separate parameter to val_print_array_elements * arrays.exp New tests for arrays in fpc * pascal.exp Added variables fpcversion_major, fpcversion_minor and fpcversion_release with the version of the used compiler * valprint.c, valprint.h (val_print_array_elements) Added the embedded_offset parameter which is needed to calculate the the position of an element in the exterior * valprint.c (get_array_bounds) Use value_lower_bound and value_higher_bound to resolve array bounds * valprint.c (val_print_array_elements) Always calculate the amount of elements in an array by substracting the upper and lower bound * valprint.c (val_print_array_elements) For each element in the array, create a new struct value using value_data_address and check_typedef_target and print it using common_val_print, so that all elements are properly evaluated * value.c, value.h (struct value) Added value_data_address to struct value. Added the functions value_data_address and set_value_data_address * value.c, value.h (set_value_address) Use object_address_get_data to set value_data_addr * value.c, value.h (value_lower_bound, value_upper_bound) Added these functions to get the lower and upper bound of an value struct containing an array * ada-valprint.c (ada_val_print_array): Pass an embedded offset of 0 to val_print_array_elements * c-valprint.c (c_val_print): Pass the embedded offset as a separate parameter to val_print_array_elements * m2-valprint.c (m2_print_array_contents, m2_val_print): Pass the embedded offset as a separate parameter to val_print_array_elements [-- Attachment #2: dyn_array_patch.tgz --] [-- Type: application/x-compressed-tar, Size: 6258 bytes --] ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2010-04-12 11:25 ` Joost van der Sluis @ 2010-04-12 19:51 ` Jan Kratochvil 2010-04-14 10:35 ` Joost van der Sluis 0 siblings, 1 reply; 26+ messages in thread From: Jan Kratochvil @ 2010-04-12 19:51 UTC (permalink / raw) To: Joost van der Sluis; +Cc: Project Archer On Mon, 12 Apr 2010 13:25:02 +0200, Joost van der Sluis wrote: > I have a new patch now that doesn't cause any regressions on my system, on Fedora 12 for x86_64-m32 and native i386 (but not for x86_64 native 64bit): -PASS: gdb.base/store.exp: var struct 4 u; print old u, expecting {s = \{0, 0, 0, 0}} +FAIL: gdb.base/store.exp: var struct 4 u; print old u, expecting {s = \{0, 0, 0, 0}} -PASS: gdb.base/store.exp: up struct 4 u; print old u, expecting {s = \{0, 0, 0, 0}} +FAIL: gdb.base/store.exp: up struct 4 u; print old u, expecting {s = \{0, 0, 0, 0}} Therefore if you have x86_64 native system reproducible by: cd gdb/testsuite; make site.exp; runtest --target_board unix/-m32 gdb.base/store.exp > Any comments, improvements, suggestions? I have to admit I do not fell so comfortable with the part: @@ -1045,8 +1045,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 (type); + high = value_upper_bound (type); } as it converts the state pre-check_typedef-ed evaluation to a dynamic one. Going to try some alternative adjustment of this part. Thanks, Jan ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2010-04-12 19:51 ` Jan Kratochvil @ 2010-04-14 10:35 ` Joost van der Sluis 2010-05-06 23:05 ` Jan Kratochvil 0 siblings, 1 reply; 26+ messages in thread From: Joost van der Sluis @ 2010-04-14 10:35 UTC (permalink / raw) To: Jan Kratochvil; +Cc: Project Archer [-- Attachment #1: Type: text/plain, Size: 2231 bytes --] On Mon, 2010-04-12 at 21:51 +0200, Jan Kratochvil wrote: > On Mon, 12 Apr 2010 13:25:02 +0200, Joost van der Sluis wrote: > > I have a new patch now that doesn't cause any regressions on my system, > > on Fedora 12 for x86_64-m32 and native i386 (but not for x86_64 native 64bit): > -PASS: gdb.base/store.exp: var struct 4 u; print old u, expecting {s = \{0, 0, 0, 0}} > +FAIL: gdb.base/store.exp: var struct 4 u; print old u, expecting {s = \{0, 0, 0, 0}} > -PASS: gdb.base/store.exp: up struct 4 u; print old u, expecting {s = \{0, 0, 0, 0}} > +FAIL: gdb.base/store.exp: up struct 4 u; print old u, expecting {s = \{0, 0, 0, 0}} > > Therefore if you have x86_64 native system reproducible by: > cd gdb/testsuite; make site.exp; runtest --target_board unix/-m32 gdb.base/store.exp Was hard to find, but attached is a patch. On computed values, the pointer to the struct with the functions for calculating the actual value was returned as the data-address. At some point the value struct got lost and re-created using the value contents and (invalid) address. > > Any comments, improvements, suggestions? > > I have to admit I do not fell so comfortable with the part: > > @@ -1045,8 +1045,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 (type); > + high = value_upper_bound (type); > } > > as it converts the state pre-check_typedef-ed evaluation to a dynamic one. Hard to get around that. Because all array-elements use the same type-struct. But they can have different sizes. > Going to try some alternative adjustment of this part. Another approach could be to do a full check_typedef before the code-block above. But then the OBJECT_ADDRESS (as used by check_typedef to evaluate all dynamic properties) has to be set to the right (=value_data_address) value. Iirc I've already tried that in an earlier patch I've send. But if you have any other suggestions or ideas that's also welcome. I do not care if the problem is solved as I would do it, as long as we can find an acceptable solution. Joost. [-- Attachment #2: computed_values.diff --] [-- Type: text/x-patch, Size: 739 bytes --] diff --git a/gdb/value.c b/gdb/value.c index cedfc45..bc309d7 100644 --- a/gdb/value.c +++ b/gdb/value.c @@ -546,7 +546,8 @@ CORE_ADDR value_address (struct value *value) { if (value->lval == lval_internalvar - || value->lval == lval_internalvar_component) + || value->lval == lval_internalvar_component + || value->lval == lval_computed) return 0; return value->location.address + value->offset; } @@ -555,7 +556,8 @@ CORE_ADDR value_raw_address (struct value *value) { if (value->lval == lval_internalvar - || value->lval == lval_internalvar_component) + || value->lval == lval_internalvar_component + || value->lval == lval_computed) return 0; return value->location.address; } ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2010-04-14 10:35 ` Joost van der Sluis @ 2010-05-06 23:05 ` Jan Kratochvil 2010-05-14 21:58 ` Joost van der Sluis 0 siblings, 1 reply; 26+ messages in thread From: Jan Kratochvil @ 2010-05-06 23:05 UTC (permalink / raw) To: Joost van der Sluis; +Cc: Project Archer On Wed, 14 Apr 2010 12:34:52 +0200, Joost van der Sluis wrote: > On Mon, 2010-04-12 at 21:51 +0200, Jan Kratochvil wrote: > > Going to try some alternative adjustment of this part. > > Another approach could be to do a full check_typedef before the > code-block above. But then the OBJECT_ADDRESS (as used by check_typedef > to evaluate all dynamic properties) has to be set to the right > (=value_data_address) value. Iirc I've already tried that in an earlier > patch I've send. Attached patch should match it I hope. It is on top of gdb-7.1-18.fc13. No regressions on {x86_64,x86_64-m32,i686}-fedora13-linux-gnu. The gdb.pascal/arrays.exp full-PASS has been tested only for x86_64-fedora14-linux-gnu. gdb.pascal/arrays.exp requires fpc-2.4.0-1.fc14 with your FPC upstream patch r15038 as requested in Fedora Bug 589495. Do you agree with this patch or would you like some changes? I would push it only for F-14 (=Rawhide) as fpc-2.4.0+ is only there anyway. Thanks, Jan gdb/ 2010-05-07 Jan Kratochvil <jan.kratochvil@redhat.com> Joost van der Sluis <joost@cnoc.nl> * p-valprint.c: Include dwarf2loc.h. (pascal_val_print): New variables back_to, saved_type and saved_address. Initialize them. Call object_address_get_data instead of CHECK_TYPEDEF, return on its failure. Reread valaddr content if ADDRESS has changed. Pass SAVED_TYPE and SAVED_ADDRESS to val_print_array_elements. Cleanup to BACK_TO on any return code path. Never print TYPE_CODE_INT array for language_pascal as a string. * valprint.c: Include dwarf2loc.h. (val_print_array_elements): New variables back_to, saved_type and saved_address. Initialize them. Call object_address_get_data, return on its failure. Reread valaddr content if ADDRESS has changed. Cleanup to BACK_TO on any return code path. Protect ELTTYPE against check_typedef. Initialize ELTLEN by the byte stride now. Remove the TYPE_LENGTH bounds initialization possibility. * valops.c (object_address_get_data): Return now struct type *. Adjust the function comment and function code. * value.h (object_address_get_data): Likewise. gdb/testsuite/ 2010-04-12 Joost van der Sluis <joost@cnoc.nl> * gdb.pascal/arrays.exp, gdb.pascal/arrays.pas: New. * lib/pascal.exp: Added variables fpcversion_major, fpcversion_minor and fpcversion_release with the version of the used compiler. --- ./gdb/p-valprint.c 2010-01-14 09:03:36.000000000 +0100 +++ ./gdb/p-valprint.c 2010-05-07 00:17:16.000000000 +0200 @@ -38,6 +38,7 @@ #include "p-lang.h" #include "cp-abi.h" #include "cp-support.h" +#include "dwarf2loc.h" \f @@ -66,8 +67,27 @@ pascal_val_print (struct type *type, con struct type *char_type; LONGEST val; CORE_ADDR addr; + struct cleanup *back_to; + struct type *saved_type = type; + CORE_ADDR saved_address = address; + + back_to = make_cleanup (null_cleanup, 0); + type = object_address_get_data (type, &address); + if (type == NULL) + { + fputs_filtered (object_address_data_not_valid (saved_type), stream); + gdb_flush (stream); + do_cleanups (back_to); + return 0; + } + if (address != saved_address) + { + size_t length = TYPE_LENGTH (type); - CHECK_TYPEDEF (type); + valaddr = xmalloc (length); + make_cleanup (xfree, (gdb_byte *) valaddr); + read_memory (address, (gdb_byte *) valaddr, length); + } switch (TYPE_CODE (type)) { case TYPE_CODE_ARRAY: @@ -82,9 +102,10 @@ pascal_val_print (struct type *type, con } /* 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_INT) + || (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,8 +143,9 @@ pascal_val_print (struct type *type, con { i = 0; } - val_print_array_elements (type, valaddr + embedded_offset, address, stream, - recurse, options, i); + val_print_array_elements (saved_type, valaddr + embedded_offset, + saved_address, stream, recurse, options, + i); fprintf_filtered (stream, "}"); } break; @@ -161,6 +183,7 @@ pascal_val_print (struct type *type, con /* Try to print what function it points to. */ print_address_demangle (gdbarch, addr, stream, demangle); /* Return value is irrelevant except for string pointers. */ + do_cleanups (back_to); return (0); } @@ -248,6 +271,7 @@ pascal_val_print (struct type *type, con /* Return number of characters printed, including the terminating '\0' if we reached the end. val_print_string takes care including the terminating '\0' if necessary. */ + do_cleanups (back_to); return i; } break; @@ -535,6 +559,7 @@ pascal_val_print (struct type *type, con error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type)); } gdb_flush (stream); + do_cleanups (back_to); return (0); } \f --- ./gdb/testsuite/gdb.pascal/arrays.exp 1970-01-01 01:00:00.000000000 +0100 +++ ./gdb/testsuite/gdb.pascal/arrays.exp 2010-05-07 00:17:13.000000000 +0200 @@ -0,0 +1,104 @@ +# 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 <http://www.gnu.org/licenses/>. + +if $tracelevel then { + strace $tracelevel +} + +load_lib "pascal.exp" + +set testfile "arrays" +set srcfile ${testfile}.pas +set binfile ${objdir}/${subdir}/${testfile}$EXEEXT + +# These tests only work with fpc, using the -gw3 compile-option +pascal_init +if { $pascal_compiler_is_fpc != 1 } { + return -1 +} + +# Detect if the fpc version is below 2.3.0 +set fpc_generates_dwarf_for_dynamic_arrays 1 +if { ($fpcversion_major < 2) || ( ($fpcversion_major == 2) && ($fpcversion_minor < 3))} { + set fpc_generates_dwarf_for_dynamic_arrays 0 +} + + +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 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" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrInt" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer type" +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrInt_" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print s" ".* = 'test'#0'string'" "Print string containing null-char" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrStr" ".* = \\{'dstr0', 'dstr1', 'dstr2', 'dstr3', 'dstr4', 'dstr5', 'dstr6', 'dstr7', 'dstr8', 'dstr9', 'dstr10', 'dstr11', 'dstr12'\\}" "Print dynamic array of string" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print StatArrStr" ".* = \\{'str0', 'str1', 'str2', 'str3', 'str4', 'str5', 'str6', 'str7', 'str8', 'str9', 'str10', 'str11', 'str12'\\}" "Print static array of string" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrChar" ".* = 'abcdefghijklm'" "Print dynamic array of char" + --- ./gdb/testsuite/gdb.pascal/arrays.pas 1970-01-01 01:00:00.000000000 +0100 +++ ./gdb/testsuite/gdb.pascal/arrays.pas 2010-05-07 00:17:13.000000000 +0200 @@ -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 <http://www.gnu.org/licenses/>. +} + +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. --- ./gdb/testsuite/lib/pascal.exp 2010-01-01 08:32:07.000000000 +0100 +++ ./gdb/testsuite/lib/pascal.exp 2010-05-07 00:17:13.000000000 +0200 @@ -37,6 +37,9 @@ proc pascal_init {} { global pascal_compiler_is_fpc global gpc_compiler global fpc_compiler + global fpcversion_major + global fpcversion_minor + global fpcversion_release global env if { $pascal_init_done == 1 } { @@ -64,6 +67,20 @@ proc pascal_init {} { set pascal_compiler_is_fpc 1 verbose -log "Free Pascal compiler found" } + + # Detect the fpc-version + if { $pascal_compiler_is_fpc == 1 } { + set fpcversion_major 1 + set fpcversion_minor 0 + set fpcversion_release 0 + set fpcversion [ remote_exec host $fpc_compiler "-iV" ] + if [regexp {.*([0-9]+)\.([0-9]+)\.([0-9]+).?} $fpcversion] { + regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\1} fpcversion_major + regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\2} fpcversion_minor + regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\3} fpcversion_release + } + verbose -log "Freepascal version: $fpcversion_major.$fpcversion_minor.$fpcversion_release" + } } set pascal_init_done 1 } --- ./gdb/valops.c 2010-05-07 00:16:49.000000000 +0200 +++ ./gdb/valops.c 2010-05-07 00:17:16.000000000 +0200 @@ -868,14 +868,15 @@ object_address_data_not_valid (struct ty return NULL; } -/* Return non-zero if the variable is valid. If it is valid the function - may store the data address (DW_AT_DATA_LOCATION) of TYPE at *ADDRESS_RETURN. - You must set *ADDRESS_RETURN from value_raw_address (VAL) before calling this - function. If no DW_AT_DATA_LOCATION is present for TYPE the address at - *ADDRESS_RETURN is left unchanged. ADDRESS_RETURN must not be NULL, use +/* Return non-NULL check_typedef result on TYPE if the variable is valid. If + it is valid the function may store the data address (DW_AT_DATA_LOCATION) of + TYPE at *ADDRESS_RETURN. You must set *ADDRESS_RETURN from + value_raw_address (VAL) before calling this function. If no + DW_AT_DATA_LOCATION is present for TYPE the address at *ADDRESS_RETURN is + left unchanged. ADDRESS_RETURN must not be NULL, use object_address_data_not_valid () for just the data validity check. */ -int +struct type * object_address_get_data (struct type *type, CORE_ADDR *address_return) { gdb_assert (address_return != NULL); @@ -890,7 +891,7 @@ object_address_get_data (struct type *ty { /* Do not try to evaluate DW_AT_data_location as it may even crash (it would just return the value zero in the gfortran case). */ - return 0; + return NULL; } if (TYPE_DATA_LOCATION_IS_ADDR (type)) @@ -899,7 +900,7 @@ object_address_get_data (struct type *ty *address_return = dwarf_locexpr_baton_eval (TYPE_DATA_LOCATION_DWARF_BLOCK (type)); - return 1; + return type; } /* Helper function for value_at, value_at_lazy, and value_at_lazy_stack. */ --- ./gdb/valprint.c 2010-05-07 00:16:49.000000000 +0200 +++ ./gdb/valprint.c 2010-05-07 00:23:48.000000000 +0200 @@ -35,6 +35,7 @@ #include "exceptions.h" #include "dfp.h" #include "python/python.h" +#include "dwarf2loc.h" #include <errno.h> @@ -1109,6 +1110,7 @@ val_print_array_elements (struct type *t { unsigned int things_printed = 0; unsigned len; + struct type *saved_type = type; struct type *elttype, *index_type; unsigned eltlen; /* Position of the array element we are examining to see @@ -1117,9 +1119,33 @@ val_print_array_elements (struct type *t /* Number of repetitions we have detected so far. */ unsigned int reps; long low_bound_index = 0; + struct cleanup *back_to; + CORE_ADDR saved_address = address; + + back_to = make_cleanup (null_cleanup, 0); + type = object_address_get_data (type, &address); + if (!type) + { + fputs_filtered (object_address_data_not_valid (type), stream); + do_cleanups (back_to); + return; + } + if (address != saved_address) + { + size_t length = TYPE_LENGTH (type); - elttype = TYPE_TARGET_TYPE (type); - eltlen = TYPE_LENGTH (check_typedef (elttype)); + valaddr = xmalloc (length); + make_cleanup (xfree, (gdb_byte *) valaddr); + read_memory (address, (gdb_byte *) valaddr, length); + } + + /* Skip typedefs but do not resolve TYPE_DYNAMIC. */ + elttype = saved_type; + while (TYPE_CODE (elttype) == TYPE_CODE_TYPEDEF) + elttype = TYPE_TARGET_TYPE (elttype); + elttype = TYPE_TARGET_TYPE (elttype); + + eltlen = TYPE_ARRAY_BYTE_STRIDE_VALUE (type); index_type = TYPE_INDEX_TYPE (type); /* Compute the number of elements in the array. On most arrays, @@ -1127,9 +1153,6 @@ val_print_array_elements (struct type *t 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; - else { long low, hi; if (get_array_bounds (type, &low, &hi)) @@ -1203,6 +1226,8 @@ val_print_array_elements (struct type *t { fprintf_filtered (stream, "..."); } + + do_cleanups (back_to); } /* Read LEN bytes of target memory at address MEMADDR, placing the --- ./gdb/value.h 2010-05-07 00:16:49.000000000 +0200 +++ ./gdb/value.h 2010-05-07 00:17:16.000000000 +0200 @@ -349,8 +349,8 @@ extern struct value *value_from_decfloat const gdb_byte *decbytes); extern const char *object_address_data_not_valid (struct type *type); -extern int object_address_get_data (struct type *type, - CORE_ADDR *address_return); +extern struct type *object_address_get_data (struct type *type, + CORE_ADDR *address_return); extern struct value *value_at (struct type *type, CORE_ADDR addr); extern struct value *value_at_lazy (struct type *type, CORE_ADDR addr); ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2010-05-06 23:05 ` Jan Kratochvil @ 2010-05-14 21:58 ` Joost van der Sluis 2010-05-14 22:46 ` Jan Kratochvil 0 siblings, 1 reply; 26+ messages in thread From: Joost van der Sluis @ 2010-05-14 21:58 UTC (permalink / raw) To: Jan Kratochvil; +Cc: Project Archer On Fri, 2010-05-07 at 01:05 +0200, Jan Kratochvil wrote: > On Wed, 14 Apr 2010 12:34:52 +0200, Joost van der Sluis wrote: > > On Mon, 2010-04-12 at 21:51 +0200, Jan Kratochvil wrote: > > > Going to try some alternative adjustment of this part. > > > > Another approach could be to do a full check_typedef before the > > code-block above. But then the OBJECT_ADDRESS (as used by check_typedef > > to evaluate all dynamic properties) has to be set to the right > > (=value_data_address) value. Iirc I've already tried that in an earlier > > patch I've send. > > Attached patch should match it I hope. It is on top of gdb-7.1-18.fc13. I can't apply it. I'm not sure where to get the code of 'gdb-7.1-18.fc3'. I've tried fedora-cvs (cvs co gdb -r gdb-7_1-18_fc13) and then in F-13: make x86_64. Then cd gdb-7.1 and applied the patch. But there are more hunks failing then succeeding. It also doesn't work on any archer-branch which sounds logical to me. So how can I use it? Joost. ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2010-05-14 21:58 ` Joost van der Sluis @ 2010-05-14 22:46 ` Jan Kratochvil 2010-05-15 20:24 ` Joost van der Sluis 0 siblings, 1 reply; 26+ messages in thread From: Jan Kratochvil @ 2010-05-14 22:46 UTC (permalink / raw) To: Joost van der Sluis; +Cc: Project Archer On Fri, 14 May 2010 23:57:30 +0200, Joost van der Sluis wrote: > I can't apply it. OK, sorry for the inconvenience. (set -ex;cvs -d :pserver:anonymous:@cvs.fedoraproject.org:/cvs/pkgs co gdb/F-13;cd gdb/F-13;make sources;rpmbuild --define "_builddir $PWD" --define "_sourcedir $PWD" -bp gdb.spec;cd gdb-7.1;wget -O - 'http://sourceware.org/cgi-bin/get-raw-msg?listname=archer&date=2010-q2&msgid=20100506230504.GA21919%40host0.dyn.jankratochvil.net'|patch -p1;./configure;make;echo OK) or scratch-built it now as: https://koji.fedoraproject.org/koji/taskinfo?taskID=2188889 https://koji.fedoraproject.org/scratch/jkratoch/task_2188889/ https://koji.fedoraproject.org/scratch/jkratoch/task_2188889/gdb-7.1-20vlapascal0.fc13.src.rpm > I'm not sure where to get the code of > 'gdb-7.1-18.fc3'. Command above downloads HEAD (currently gdb-7.1-20.fc3) where are no differences significant for this VLA-Pascal patch. Specifically gdb-7.1-18.fc3 could be checked out by: (set -ex;cvs -d :pserver:anonymous:@cvs.fedoraproject.org:/cvs/pkgs co -r gdb-7_1-18_fc13 gdb/F-13;cd gdb/F-13;make sources;rpmbuild --define "_builddir $PWD" --define "_sourcedir $PWD" -bp gdb.spec;echo OK) > I've tried fedora-cvs (cvs co gdb -r gdb-7_1-18_fc13) cvs server: cannot find module `-r' - ignored cvs server: cannot find module `gdb-7_1-18_fc13' - ignored cvs [checkout aborted]: cannot expand modules > and then in F-13: make x86_64. Then cd gdb-7.1 and applied the patch. > But there are more hunks failing then succeeding. There had to be some mistake, it works for me: (set -ex;cvs -d :pserver:anonymous:@cvs.fedoraproject.org:/cvs/pkgs co -r gdb-7_1-18_fc13 gdb; cd gdb/F-13; make x86_64;cd gdb-7.1;wget -O - 'http://sourceware.org/cgi-bin/get-raw-msg?listname=archer&date=2010-q2&msgid=20100506230504.GA21919%40host0.dyn.jankratochvil.net'|patch -p1;make -C build-x86_64-redhat-linux-gnu;echo OK) > It also doesn't work on any archer-branch which sounds logical to me. I did not try it but I agree it does not have to. Thanks, Jan ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2010-05-14 22:46 ` Jan Kratochvil @ 2010-05-15 20:24 ` Joost van der Sluis 2010-05-15 21:44 ` Jan Kratochvil 0 siblings, 1 reply; 26+ messages in thread From: Joost van der Sluis @ 2010-05-15 20:24 UTC (permalink / raw) To: Jan Kratochvil; +Cc: Project Archer On Sat, 2010-05-15 at 00:46 +0200, Jan Kratochvil wrote: > On Fri, 14 May 2010 23:57:30 +0200, Joost van der Sluis wrote: > > I can't apply it. > > OK, sorry for the inconvenience. No problem, I've got it to work! In principle I did the same as you suggested. Eventually I've applied the patch 'manually' by copy-pasting the right bits. I think there were some eol-differences, or something. But it works great. I don't understand the cleanup-bit entirely, but you've found another solution for this problem I didn't think of. Thanks for the help. A few details, though. Take a look a this bug-report (http://sourceware.org/bugzilla/show_bug.cgi?id=11492) about the identification of arrays. It has a better fix for that, and it avoids problems when merging this later. And when you do a 'print s' when the breakpoint is before line 80. (In arrays.pas) you get 'Object is not allocated'. In theory this is true, but unallocated strings in pascal are handled as empty strings (''). But that's a minor issue that's fixable in p-valprint only. The next challenge is to print individual items from the array. (print DynArrStr[3]). But that didn't work with my patch either. And I think that with your solution it's easier to implement this. Again, thanks for the help, this patch works perfectly. Joost. ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2010-05-15 20:24 ` Joost van der Sluis @ 2010-05-15 21:44 ` Jan Kratochvil 2010-05-16 12:04 ` Jonas Maebe 0 siblings, 1 reply; 26+ messages in thread From: Jan Kratochvil @ 2010-05-15 21:44 UTC (permalink / raw) To: Joost van der Sluis; +Cc: Project Archer On Sat, 15 May 2010 22:24:02 +0200, Joost van der Sluis wrote: > But it works great. Thanks, checked-in as: b468b41f5c4cf1a5a55fc33402ce4695ace3579c > Take a look a this bug-report > (http://sourceware.org/bugzilla/show_bug.cgi?id=11492) about the > identification of arrays. It has a better fix for that, and it avoids > problems when merging this later. OK, removed that part from the patch above. It will get merged again only with new FSF GDB HEAD anyway. > And when you do a 'print s' when the breakpoint is before line 80. (In > arrays.pas) you get 'Object is not allocated'. In theory this is true, > but unallocated strings in pascal are handled as empty strings (''). But > that's a minor issue that's fixable in p-valprint only. 33:var StatArrInt: TStatArrInt; 44: s: string; 48:begin 80: s := 'test'#0'string'; I believe In such case the DWARF data should not use DW_AT_allocated at all. <1><255>: Abbrev Number: 21 (DW_TAG_array_type) <256> DW_AT_name : AnsiString <261> DW_AT_data_location: 2 byte block: 97 6 (DW_OP_push_object_address; DW_OP_deref) <264> DW_AT_allocated : 2 byte block: 97 6 (DW_OP_push_object_address; DW_OP_deref) <267> DW_AT_type : <0x437> <2><26b>: Abbrev Number: 22 (DW_TAG_subrange_type) <26c> DW_AT_lower_bound : 1 <26d> DW_AT_upper_bound : 5 byte block: 97 6 38 1c 6 (DW_OP_push_object_address; DW_OP_deref; DW_OP_lit8; DW_OP_minus; DW_OP_deref) In the case of Fortran the runtime crashes (on a NULL dereference) while accessing non-allocated object. But if the "allocation" is just an internal compiler issue which should be hidden by the same compiler at the DWARF level. Therefore I would guess to use some: drop DW_TAG_array_type -> DW_AT_allocated DW_TAG_subrange_type -> DW_AT_upper_bound: DW_OP_push_object_address DW_OP_deref DW_OP_dup DW_OP_bra allocated DW_OP_lit0 DW_OP_skip end allocated: DW_OP_lit8 DW_OP_minus DW_OP_deref end: > The next challenge is to print individual items from the array. (print > DynArrStr[3]). But that didn't work with my patch either. And I think > that with your solution it's easier to implement this. $1 = {'dstr0', 'dstr1', 'dstr2', 'dstr3', 'dstr4', 'dstr5', 'dstr6', 'dstr7', 'dstr8', 'dstr9', 'dstr10', 'dstr11', 'dstr12'} $2 = '?`???'#127#0#0'0a??' OK... hopefully some new similar patch would work. Thanks, Jan ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2010-05-15 21:44 ` Jan Kratochvil @ 2010-05-16 12:04 ` Jonas Maebe 2010-05-16 17:06 ` Joost van der Sluis 2010-05-16 18:31 ` Jan Kratochvil 0 siblings, 2 replies; 26+ messages in thread From: Jonas Maebe @ 2010-05-16 12:04 UTC (permalink / raw) To: Jan Kratochvil; +Cc: Project Archer, Joost van der Sluis [-- Attachment #1: Type: text/plain, Size: 1204 bytes --] On 15 May 2010, at 23:44, Jan Kratochvil wrote: > But if the "allocation" is just an internal > compiler issue which should be hidden by the same compiler at the DWARF level. > Therefore I would guess to use some: > drop DW_TAG_array_type -> DW_AT_allocated > DW_TAG_subrange_type -> DW_AT_upper_bound: > DW_OP_push_object_address > DW_OP_deref > DW_OP_dup > DW_OP_bra allocated > DW_OP_lit0 > DW_OP_skip end > allocated: > DW_OP_lit8 > DW_OP_minus > DW_OP_deref > end: I agree. Joost, I've attached a patch for FPC's DWARF writer to fix it. I can't test whether it works (the dumped DWARF info looks ok though), because I can't get gdb/F-13 to build: *** ... Patch #329 (gdb-6.8-bz254229-gcore-prpsinfo.patch): + patch -p1 -s misordered hunks! output would be garbled 1 out of 3 hunks FAILED -- saving rejects to file bfd/elf.c.rej error: Bad exit status from /var/tmp/rpm-tmp.88969 (%prep) RPM build errors: Bad exit status from /var/tmp/rpm-tmp.88969 (%prep) *** This is on a Scientific Linux 5.4 machine (which corresponds to RHEL 5.4). Maybe I need a newer version of the "patch" utility? (it has version 2.5.4) Jonas [-- Attachment #2: fpc-dwarf3-arrstrupperbound.patch --] [-- Type: application/octet-stream, Size: 5270 bytes --] Index: dbgdwarf.pas =================================================================== --- dbgdwarf.pas (revision 15239) +++ dbgdwarf.pas (working copy) @@ -3558,9 +3558,6 @@ ]); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); - append_block1(DW_AT_allocated,2); - current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); - current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef)); finish_entry; @@ -3568,10 +3565,19 @@ append_entry(DW_TAG_subrange_type,false,[ DW_AT_byte_stride,DW_FORM_udata,def.elesize, DW_AT_lower_bound,DW_FORM_udata,0, - DW_AT_upper_bound,DW_FORM_block1,5 + DW_AT_upper_bound,DW_FORM_block1,13 ]); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_dup))); + { pointer = nil? } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_bra))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(4)); + { yes -> length = 0 } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_skip))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(3)); + { no -> load length } current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+sizeof(ptrint))); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_minus))); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); @@ -3607,13 +3613,6 @@ we point to address of the string } current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); - - { also add how to detect whether or not the string is allocated: if the pointer is 0 - then it isn't, otherwise it is - } - append_block1(DW_AT_allocated,2); - current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); - current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); end else begin @@ -3630,9 +3629,9 @@ if deref then begin if (chardef.size=1) then - upperopcodes:=5 + upperopcodes:=13 else - upperopcodes:=7; + upperopcodes:=15; { lower bound is always 1, upper bound (length) needs to be calculated } append_entry(DW_TAG_subrange_type,false,[ DW_AT_lower_bound,DW_FORM_udata,1, @@ -3642,14 +3641,24 @@ { high(string) is stored sizeof(ptrint) bytes before the string data } current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_dup))); + { pointer = nil? } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_bra))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(4)); + { yes -> length = 0 } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_skip))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(3)); + { no -> load length } current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+sizeof(ptrint))); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_minus))); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); + { for widestrings, the length is specified in bytes, so divide by two } - if (upperopcodes=7) then + if (upperopcodes=15) then begin current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit1))); - current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_shra))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_shr))); end; end else ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2010-05-16 12:04 ` Jonas Maebe @ 2010-05-16 17:06 ` Joost van der Sluis 2010-05-16 17:31 ` Jan Kratochvil 2010-05-16 18:31 ` Jan Kratochvil 1 sibling, 1 reply; 26+ messages in thread From: Joost van der Sluis @ 2010-05-16 17:06 UTC (permalink / raw) To: Jonas Maebe; +Cc: Project Archer, Jan Kratochvil [-- Attachment #1: Type: text/plain, Size: 1543 bytes --] On Sun, 2010-05-16 at 14:04 +0200, Jonas Maebe wrote: > On 15 May 2010, at 23:44, Jan Kratochvil wrote: > > > But if the "allocation" is just an internal > > compiler issue which should be hidden by the same compiler at the DWARF level. > > Therefore I would guess to use some: > > drop DW_TAG_array_type -> DW_AT_allocated > > DW_TAG_subrange_type -> DW_AT_upper_bound: > > DW_OP_push_object_address > > DW_OP_deref > > DW_OP_dup > > DW_OP_bra allocated > > DW_OP_lit0 > > DW_OP_skip end > > allocated: > > DW_OP_lit8 > > DW_OP_minus > > DW_OP_deref > > end: > > I agree. Joost, I've attached a patch for FPC's DWARF writer to fix it. I can't test whether it works (the dumped DWARF info looks ok though), because I can't get gdb/F-13 to build: It doesn't work. That's because type_length_get() (gdbtypes.c) does not return 0 when the high and low-bound are equal to each other. Instead it returns the element-size. Then allocate_value_lazy tries to read element-size bytes from the base-address (being 0x0) -> av. I think that type_length_get() not returning 0 is a bug, (also because there is a comment in the function that some part of the code doesn't handle count=0 right. But I think that should be count=1) but it could be that it's on purpose for Fortran. Jan, can you comment on this? There's also a second problem. The lower bound is 1 for strings. With Jonas' patch for fpc the upper bound of strings is 0 when not allocated. Leading to a size of -1. An easy fix, new patch is attached. Joost. [-- Attachment #2: fpc-dwarf3-arrstrupperbound2.patch --] [-- Type: text/x-patch, Size: 5270 bytes --] Index: dbgdwarf.pas =================================================================== --- dbgdwarf.pas (revision 15284) +++ dbgdwarf.pas (working copy) @@ -3558,9 +3558,6 @@ ]); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); - append_block1(DW_AT_allocated,2); - current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); - current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef)); finish_entry; @@ -3568,10 +3565,19 @@ append_entry(DW_TAG_subrange_type,false,[ DW_AT_byte_stride,DW_FORM_udata,def.elesize, DW_AT_lower_bound,DW_FORM_udata,0, - DW_AT_upper_bound,DW_FORM_block1,5 + DW_AT_upper_bound,DW_FORM_block1,13 ]); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_dup))); + { pointer = nil? } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_bra))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(4)); + { yes -> length = 0 } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_skip))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(3)); + { no -> load length } current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+sizeof(ptrint))); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_minus))); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); @@ -3607,13 +3613,6 @@ we point to address of the string } current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); - - { also add how to detect whether or not the string is allocated: if the pointer is 0 - then it isn't, otherwise it is - } - append_block1(DW_AT_allocated,2); - current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); - current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); end else begin @@ -3630,9 +3629,9 @@ if deref then begin if (chardef.size=1) then - upperopcodes:=5 + upperopcodes:=13 else - upperopcodes:=7; + upperopcodes:=15; { lower bound is always 1, upper bound (length) needs to be calculated } append_entry(DW_TAG_subrange_type,false,[ DW_AT_lower_bound,DW_FORM_udata,1, @@ -3642,14 +3641,24 @@ { high(string) is stored sizeof(ptrint) bytes before the string data } current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_dup))); + { pointer = nil? } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_bra))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(4)); + { yes -> length = 0 } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit1))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_skip))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(3)); + { no -> load length } current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+sizeof(ptrint))); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_minus))); current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); + { for widestrings, the length is specified in bytes, so divide by two } - if (upperopcodes=7) then + if (upperopcodes=15) then begin current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit1))); - current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_shra))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_shr))); end; end else ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2010-05-16 17:06 ` Joost van der Sluis @ 2010-05-16 17:31 ` Jan Kratochvil 2010-05-16 21:49 ` Jonas Maebe 0 siblings, 1 reply; 26+ messages in thread From: Jan Kratochvil @ 2010-05-16 17:31 UTC (permalink / raw) To: Joost van der Sluis; +Cc: Jonas Maebe, Project Archer On Sun, 16 May 2010 19:04:27 +0200, Joost van der Sluis wrote: > That's because type_length_get() (gdbtypes.c) does not return 0 when the > high and low-bound are equal to each other. That's correct. Both DW_AT_lower_bound and DW_AT_upper_bound express the boundaries inclusively. Array of length 0 must have DW_AT_upper_bound equal to DW_AT_lower_bound minus one. If you do not feel confortable with DW_AT_upper_bound that way you can also use DW_AT_lower_bound and DW_AT_count with value 0. > There's also a second problem. The lower bound is 1 for strings. With > Jonas' patch for fpc the upper bound of strings is 0 when not allocated. That looks correct. > Leading to a size of -1. That should lead to a size of 0. I am not sure where is a problem there but GDB handles non-pascal arrays of length zero right AFAIK. Thanks, Jan ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2010-05-16 17:31 ` Jan Kratochvil @ 2010-05-16 21:49 ` Jonas Maebe 2010-05-16 21:55 ` Jonas Maebe 0 siblings, 1 reply; 26+ messages in thread From: Jonas Maebe @ 2010-05-16 21:49 UTC (permalink / raw) To: Jan Kratochvil; +Cc: Joost van der Sluis, Project Archer On 16 May 2010, at 19:23, Jan Kratochvil wrote: > That's correct. Both DW_AT_lower_bound and DW_AT_upper_bound express the > boundaries inclusively. Array of length 0 must have DW_AT_upper_bound equal > to DW_AT_lower_bound minus one. I've fixed this, thanks. I've also committed the patch to FPC svn. > I am not sure where is a problem there but GDB handles non-pascal arrays of > length zero right AFAIK. Thanks to your patch, I can now successfully build the new gdb on SL54. In Pascal language mode, both empty arrays and strings are printed as '0x0'. That's probably an issue in the Pascal value printer. In C language mode (with the same binary), an empty string is (correctly) printed as '0x625418 ""', while an empty array is printed as just the address of the variable containing the pointer to the array (which looks a bit strange, but I guess it's consistent with how in C arrays and pointers are pretty much the same). Array: 19 setlength(a,8); (gdb) set lang pascal (gdb) ptype a type = array [0..-1] of LongInt (gdb) p a $12 = 0x0 (gdb) set lang c (gdb) ptype a type = LongInt [0] (gdb) p a $13 = 0x625418 (gdb) n 20 a[0]:=5; (gdb) set lang pascal (gdb) ptype a type = array [0..7] of LongInt (gdb) p a $14 = {0, 0, 0, 0, 0, 0, 0, 0} (gdb) set lang c (gdb) ptype a type = LongInt [8] (gdb) p a $15 = {0, 0, 0, 0, 0, 0, 0, 0} String: 45 setlength(s,8); (gdb) set lang pascal (gdb) ptype s type = array [1..0] of Char (gdb) p s $16 = 0x0 (gdb) set lang c (gdb) ptype s type = Char [0] (gdb) p s $17 = 0x625428 "" (gdb) n 46 s[1]:=chr(5); (gdb) set lang pascal (gdb) ptype s type = array [1..8] of Char (gdb) p s $18 = #0#0#0#0#0#0#0 (gdb) set lang c (gdb) ptype s type = Char [8] (gdb) p s $19 = "\000\000\000\000\000\000\000" Jonas ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2010-05-16 21:49 ` Jonas Maebe @ 2010-05-16 21:55 ` Jonas Maebe 0 siblings, 0 replies; 26+ messages in thread From: Jonas Maebe @ 2010-05-16 21:55 UTC (permalink / raw) To: Project Archer; +Cc: Jan Kratochvil, Joost van der Sluis On 16 May 2010, at 23:49, Jonas Maebe wrote: > (gdb) ptype s > type = array [1..8] of Char > (gdb) p s > $18 = #0#0#0#0#0#0#0 > (gdb) set lang c > (gdb) ptype s > type = Char [8] > (gdb) p s > $19 = "\000\000\000\000\000\000\000" Actually, it seems one element too few is printed here (at least in Pascal mode, where strings are not null-terminated): only 7 instead of 8 characters are shown in both Pascal and C mode. Jonas ^ permalink raw reply [flat|nested] 26+ messages in thread
* Re: Patch for pascal-dynamic arrays 2010-05-16 12:04 ` Jonas Maebe 2010-05-16 17:06 ` Joost van der Sluis @ 2010-05-16 18:31 ` Jan Kratochvil 1 sibling, 0 replies; 26+ messages in thread From: Jan Kratochvil @ 2010-05-16 18:31 UTC (permalink / raw) To: Jonas Maebe; +Cc: Project Archer, Joost van der Sluis On Sun, 16 May 2010 14:04:08 +0200, Jonas Maebe wrote: > Patch #329 (gdb-6.8-bz254229-gcore-prpsinfo.patch): > + patch -p1 -s > misordered hunks! output would be garbled > 1 out of 3 hunks FAILED -- saving rejects to file bfd/elf.c.rej > error: Bad exit status from /var/tmp/rpm-tmp.88969 (%prep) ... > This is on a Scientific Linux 5.4 machine (which corresponds to RHEL 5.4). OK, fixed in gdb-7.1-21.fc13 (CVS only) by a glue patch content as HEAD is intended to be backward compatible with RHEL-5. Thanks, Jan ^ permalink raw reply [flat|nested] 26+ messages in thread
end of thread, other threads:[~2010-05-16 21:55 UTC | newest] Thread overview: 26+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2009-09-14 14:45 Patch for pascal-dynamic arrays Joost van der Sluis 2009-09-16 15:45 ` Jan Kratochvil 2009-09-16 18:18 ` Joost van der Sluis 2009-09-16 18:41 ` Jan Kratochvil 2009-09-16 19:09 ` Joost van der Sluis 2009-09-30 16:00 ` Joost van der Sluis 2009-10-04 14:17 ` Jan Kratochvil 2009-10-05 10:08 ` Joost van der Sluis [not found] ` <1254737231.3257.20.camel@wsjoost.cnoc.lan> 2009-10-05 14:43 ` Jan Kratochvil 2009-10-28 17:35 ` Joost van der Sluis 2009-10-30 9:47 ` Jan Kratochvil 2009-11-07 21:49 ` Joost van der Sluis 2010-04-12 11:25 ` Joost van der Sluis 2010-04-12 19:51 ` Jan Kratochvil 2010-04-14 10:35 ` Joost van der Sluis 2010-05-06 23:05 ` Jan Kratochvil 2010-05-14 21:58 ` Joost van der Sluis 2010-05-14 22:46 ` Jan Kratochvil 2010-05-15 20:24 ` Joost van der Sluis 2010-05-15 21:44 ` Jan Kratochvil 2010-05-16 12:04 ` Jonas Maebe 2010-05-16 17:06 ` Joost van der Sluis 2010-05-16 17:31 ` Jan Kratochvil 2010-05-16 21:49 ` Jonas Maebe 2010-05-16 21:55 ` Jonas Maebe 2010-05-16 18:31 ` Jan Kratochvil
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).