* 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
* 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 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
* 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
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).