public inbox for archer-commits@sourceware.org
help / color / mirror / Atom feed
* [SCM] archer-jankratochvil-vla: gdb/ 2010-05-07 Jan Kratochvil <jan.kratochvil@redhat.com> Joost van der Sluis <joost@cnoc.nl>
@ 2010-05-15 20:59 jkratoch
0 siblings, 0 replies; only message in thread
From: jkratoch @ 2010-05-15 20:59 UTC (permalink / raw)
To: archer-commits
The branch, archer-jankratochvil-vla has been updated
via b9497b56c745769698b9557715f8a1cc84d61d9a (commit)
from a683bac73af74a757591672d89d720169c0b5ec9 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email.
- Log -----------------------------------------------------------------
commit b9497b56c745769698b9557715f8a1cc84d61d9a
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date: Sat May 15 22:59:00 2010 +0200
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.
-----------------------------------------------------------------------
Summary of changes:
gdb/p-valprint.c | 30 +++++++++-
gdb/testsuite/gdb.pascal/arrays.exp | 104 +++++++++++++++++++++++++++++++++++
gdb/testsuite/gdb.pascal/arrays.pas | 82 +++++++++++++++++++++++++++
gdb/testsuite/lib/pascal.exp | 17 ++++++
gdb/valops.c | 17 +++---
gdb/valprint.c | 49 +++++++++++++---
gdb/value.h | 4 +-
7 files changed, 280 insertions(+), 23 deletions(-)
create mode 100644 gdb/testsuite/gdb.pascal/arrays.exp
create mode 100644 gdb/testsuite/gdb.pascal/arrays.pas
First 500 lines of diff:
diff --git a/gdb/p-valprint.c b/gdb/p-valprint.c
index 260b97d..bcdd0d9 100644
--- a/gdb/p-valprint.c
+++ b/gdb/p-valprint.c
@@ -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, const gdb_byte *valaddr,
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:
@@ -122,8 +142,9 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr,
{
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 +182,7 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr,
/* 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 +270,7 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr,
/* 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 +558,7 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr,
error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type));
}
gdb_flush (stream);
+ do_cleanups (back_to);
return (0);
}
\f
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 9691bc1..13ea8b5 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 4580389..443a66e 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -870,14 +870,15 @@ object_address_data_not_valid (struct type *type)
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);
@@ -892,7 +893,7 @@ object_address_get_data (struct type *type, CORE_ADDR *address_return)
{
/* 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))
@@ -901,7 +902,7 @@ object_address_get_data (struct type *type, CORE_ADDR *address_return)
*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. */
diff --git a/gdb/valprint.c b/gdb/valprint.c
index 32a8247..23e6cef 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -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 *type, const gdb_byte *valaddr,
{
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,27 @@ val_print_array_elements (struct type *type, const gdb_byte *valaddr,
/* 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)
+ valaddr = NULL;
- elttype = TYPE_TARGET_TYPE (type);
- eltlen = TYPE_LENGTH (check_typedef (elttype));
+ /* 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 +1147,6 @@ val_print_array_elements (struct type *type, const gdb_byte *valaddr,
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))
@@ -1171,17 +1188,29 @@ val_print_array_elements (struct type *type, const gdb_byte *valaddr,
rep1 = i + 1;
reps = 1;
- while ((rep1 < len) &&
+ while (valaddr && (rep1 < len) &&
!memcmp (valaddr + i * eltlen, valaddr + rep1 * eltlen, eltlen))
{
++reps;
++rep1;
}
+ if (valaddr)
+ val_print (elttype, valaddr + i * eltlen, 0, address + i * eltlen,
+ stream, recurse + 1, options, current_language);
+ else
+ {
+ char *mem = xmalloc (eltlen);
+ struct cleanup *back_to = make_cleanup (xfree, mem);
+
+ read_memory (address + i * eltlen, mem, eltlen);
+ val_print (elttype, mem, 0, address + i * eltlen, stream, recurse + 1,
+ options, current_language);
+ do_cleanups (back_to);
+ }
+
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 ();
@@ -1191,8 +1220,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++;
}
@@ -1202,6 +1229,8 @@ val_print_array_elements (struct type *type, const gdb_byte *valaddr,
{
fprintf_filtered (stream, "...");
}
+
+ do_cleanups (back_to);
}
/* Read LEN bytes of target memory at address MEMADDR, placing the
diff --git a/gdb/value.h b/gdb/value.h
index 0ed7dfb..6a8ad46 100644
--- a/gdb/value.h
+++ b/gdb/value.h
@@ -348,8 +348,8 @@ extern struct value *value_from_decfloat (struct type *type,
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);
hooks/post-receive
--
Repository for Project Archer.
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2010-05-15 20:59 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2010-05-15 20:59 [SCM] archer-jankratochvil-vla: gdb/ 2010-05-07 Jan Kratochvil <jan.kratochvil@redhat.com> Joost van der Sluis <joost@cnoc.nl> jkratoch
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).