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 .
+
+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 .
+}
+
+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, " ", 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);