* [PATCH 0/2] Fix crash when printing watchpoints using guile API
@ 2021-05-05 18:10 Andrew Burgess
2021-05-05 18:10 ` [PATCH 1/2] gdb/testsuite: resolve duplicate test names in gdb.guile/scm-breakpoint.exp Andrew Burgess
2021-05-05 18:10 ` [PATCH 2/2] gdb/guile: don't try to print location for watchpoints Andrew Burgess
0 siblings, 2 replies; 6+ messages in thread
From: Andrew Burgess @ 2021-05-05 18:10 UTC (permalink / raw)
To: gdb-patches
Printing a watchpoint using the guile API will crash GDB. This seems bad.
---
Andrew Burgess (2):
gdb/testsuite: resolve duplicate test names in
gdb.guile/scm-breakpoint.exp
gdb/guile: don't try to print location for watchpoints
gdb/ChangeLog | 5 ++++
gdb/guile/scm-breakpoint.c | 9 +++++---
gdb/testsuite/ChangeLog | 12 ++++++++++
gdb/testsuite/gdb.guile/scm-breakpoint.exp | 27 ++++++++++++++--------
4 files changed, 40 insertions(+), 13 deletions(-)
--
2.25.4
^ permalink raw reply [flat|nested] 6+ messages in thread
* [PATCH 1/2] gdb/testsuite: resolve duplicate test names in gdb.guile/scm-breakpoint.exp
2021-05-05 18:10 [PATCH 0/2] Fix crash when printing watchpoints using guile API Andrew Burgess
@ 2021-05-05 18:10 ` Andrew Burgess
2021-05-06 2:02 ` Simon Marchi
2021-05-05 18:10 ` [PATCH 2/2] gdb/guile: don't try to print location for watchpoints Andrew Burgess
1 sibling, 1 reply; 6+ messages in thread
From: Andrew Burgess @ 2021-05-05 18:10 UTC (permalink / raw)
To: gdb-patches
Extend some test names to avoid duplicates.
gdb/testsuite/ChangeLog:
* gdb.guile/scm-breakpoint.exp (test_bkpt_basic): Extend test
names to avoid duplicates.
(test_bkpt_cond_and_cmds): Likewise.
(test_bkpt_eval_funcs): Likewise.
---
gdb/testsuite/ChangeLog | 7 +++++++
gdb/testsuite/gdb.guile/scm-breakpoint.exp | 22 ++++++++++++----------
2 files changed, 19 insertions(+), 10 deletions(-)
diff --git a/gdb/testsuite/gdb.guile/scm-breakpoint.exp b/gdb/testsuite/gdb.guile/scm-breakpoint.exp
index 071a6f66f7e..1fc34dd3412 100644
--- a/gdb/testsuite/gdb.guile/scm-breakpoint.exp
+++ b/gdb/testsuite/gdb.guile/scm-breakpoint.exp
@@ -50,7 +50,7 @@ proc test_bkpt_basic { } {
set mult_line [gdb_get_line_number "Break at multiply."]
gdb_breakpoint ${mult_line}
- gdb_continue_to_breakpoint "Break at multiply."
+ gdb_continue_to_breakpoint "Break at multiply, first time"
# Check that the Guile breakpoint code noted the addition of a
# breakpoint "behind the scenes".
@@ -72,7 +72,7 @@ proc test_bkpt_basic { } {
"= 1" "check multiply breakpoint hit count"
gdb_scm_test_silent_cmd "guile (set-breakpoint-ignore-count! mult-bkpt 4)" \
"set multiply breakpoint ignore count"
- gdb_continue_to_breakpoint "Break at multiply."
+ gdb_continue_to_breakpoint "Break at multiply, second time"
gdb_test "guile (print (breakpoint-hit-count mult-bkpt))" \
"= 6" "check multiply breakpoint hit count 2"
gdb_test "print result" \
@@ -80,15 +80,15 @@ proc test_bkpt_basic { } {
# Test breakpoint is enabled and disabled correctly.
gdb_breakpoint [gdb_get_line_number "Break at add."]
- gdb_continue_to_breakpoint "Break at add."
+ gdb_continue_to_breakpoint "Break at add, first time"
gdb_test "guile (print (breakpoint-enabled? mult-bkpt))" \
"= #t" "check multiply breakpoint enabled"
gdb_scm_test_silent_cmd "guile (set-breakpoint-enabled! mult-bkpt #f)" \
"set multiply breakpoint disabled"
- gdb_continue_to_breakpoint "Break at add."
+ gdb_continue_to_breakpoint "Break at add, second time"
gdb_scm_test_silent_cmd "guile (set-breakpoint-enabled! mult-bkpt #t)" \
"set multiply breakpoint enabled"
- gdb_continue_to_breakpoint "Break at multiply."
+ gdb_continue_to_breakpoint "Break at multiply, third time"
# Test other getters and setters.
gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
@@ -157,19 +157,19 @@ proc test_bkpt_cond_and_cmds { } {
"create multiply breakpoint"
gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \
"register bp1"
- gdb_continue_to_breakpoint "Break at multiply."
+ gdb_continue_to_breakpoint "Break at multiply, first time"
gdb_scm_test_silent_cmd "guile (set-breakpoint-condition! bp1 \"i == 5\")" \
"set condition"
gdb_test "guile (print (breakpoint-condition bp1))" \
"= i == 5" "test condition has been set"
- gdb_continue_to_breakpoint "Break at multiply."
+ gdb_continue_to_breakpoint "Break at multiply, second time"
gdb_test "print i" \
"5" "test conditional breakpoint stopped after five iterations"
gdb_scm_test_silent_cmd "guile (set-breakpoint-condition! bp1 #f)" \
"clear condition"
gdb_test "guile (print (breakpoint-condition bp1))" \
"= #f" "test condition has been removed"
- gdb_continue_to_breakpoint "Break at multiply."
+ gdb_continue_to_breakpoint "Break at multiply, third time"
gdb_test "print i" "6" "test breakpoint stopped after six iterations"
# Test commands.
@@ -372,7 +372,8 @@ proc test_bkpt_eval_funcs { } {
"create also-eval-bp1 breakpoint"
gdb_scm_test_silent_cmd "guile (define never-eval-bp1 (make-bp-also-eval \"$end_location\"))" \
"create never-eval-bp1 breakpoint"
- gdb_continue_to_breakpoint "Break at multiply." ".*$srcfile:$bp_location2.*"
+ gdb_continue_to_breakpoint "Break at multiply, first time" \
+ ".*$srcfile:$bp_location2.*"
gdb_test "print i" "3" "check inferior value matches guile accounting"
gdb_test "guile (print (bp-eval-inf-i eval-bp1))" \
"= 3" "check guile accounting matches inferior"
@@ -414,7 +415,8 @@ proc test_bkpt_eval_funcs { } {
gdb_test "guile (print (bp-eval-count check-eval))" \
"= 0" \
"test that evaluate function has not been yet executed (ie count = 0)"
- gdb_continue_to_breakpoint "Break at multiply." ".*$srcfile:$bp_location2.*"
+ gdb_continue_to_breakpoint "Break at multiply, second time" \
+ ".*$srcfile:$bp_location2.*"
gdb_test "guile (print (bp-eval-count check-eval))" \
"= 1" \
"test that evaluate function is run when location also has normal bp"
--
2.25.4
^ permalink raw reply [flat|nested] 6+ messages in thread
* [PATCH 2/2] gdb/guile: don't try to print location for watchpoints
2021-05-05 18:10 [PATCH 0/2] Fix crash when printing watchpoints using guile API Andrew Burgess
2021-05-05 18:10 ` [PATCH 1/2] gdb/testsuite: resolve duplicate test names in gdb.guile/scm-breakpoint.exp Andrew Burgess
@ 2021-05-05 18:10 ` Andrew Burgess
2021-05-06 2:09 ` Simon Marchi
1 sibling, 1 reply; 6+ messages in thread
From: Andrew Burgess @ 2021-05-05 18:10 UTC (permalink / raw)
To: gdb-patches
Currently, using the guile API, if a user tries to print a breakpoint
object that represents a watchpoint, then GDB will crash. For
example:
(gdb) guile (use-modules (gdb))
(gdb) guile (define wp1 (make-breakpoint "some_variable" #:type BP_WATCHPOINT #:wp-class WP_WRITE))
(gdb) guile (register-breakpoint! wp1)
(gdb) guile (display wp1) (newline)
Aborted (core dumped)
This turns out to be because GDB calls event_location_to_string on the
breakpoints location, and watchpoint breakpoints don't have a
location.
This commit resolves the crash by just skipping the printing of the
location if the breakpoint doesn't have one.
Potentially, we could improve on this by printing details about what
the watchpoint is watching, however, I'm considering this a possible
future enhancement, this commit focuses just on having GDB not crash.
gdb/ChangeLog:
* guile/scm-breakpoint.c (bpscm_print_breakpoint_smob): Only print
breakpoint locations when the breakpoint actually has a location.
gdb/testsuite/ChangeLog:
* gdb.guile/scm-breakpoint.exp (test_watchpoints): Print the
watchpoint object before and after registering it with GDB.
---
gdb/ChangeLog | 5 +++++
gdb/guile/scm-breakpoint.c | 9 ++++++---
gdb/testsuite/ChangeLog | 5 +++++
gdb/testsuite/gdb.guile/scm-breakpoint.exp | 5 +++++
4 files changed, 21 insertions(+), 3 deletions(-)
diff --git a/gdb/guile/scm-breakpoint.c b/gdb/guile/scm-breakpoint.c
index 25b438b7210..791e3051f6d 100644
--- a/gdb/guile/scm-breakpoint.c
+++ b/gdb/guile/scm-breakpoint.c
@@ -184,9 +184,12 @@ bpscm_print_breakpoint_smob (SCM self, SCM port, scm_print_state *pstate)
gdbscm_printf (port, " hit:%d", b->hit_count);
gdbscm_printf (port, " ignore:%d", b->ignore_count);
- str = event_location_to_string (b->location.get ());
- if (str != NULL)
- gdbscm_printf (port, " @%s", str);
+ if (b->location.get () != nullptr)
+ {
+ str = event_location_to_string (b->location.get ());
+ if (str != NULL)
+ gdbscm_printf (port, " @%s", str);
+ }
}
scm_puts (">", port);
diff --git a/gdb/testsuite/gdb.guile/scm-breakpoint.exp b/gdb/testsuite/gdb.guile/scm-breakpoint.exp
index 1fc34dd3412..4316269efd3 100644
--- a/gdb/testsuite/gdb.guile/scm-breakpoint.exp
+++ b/gdb/testsuite/gdb.guile/scm-breakpoint.exp
@@ -257,8 +257,13 @@ proc test_watchpoints { } {
gdb_scm_test_silent_cmd "guile (define wp1 (make-breakpoint \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE))" \
"create watchpoint"
+ gdb_test "guile (display wp1) (newline)" "#<gdb:breakpoint #-1>" \
+ "print watchpoint before registering"
gdb_scm_test_silent_cmd "guile (register-breakpoint! wp1)" \
"register wp1"
+ gdb_test "guile (display wp1) (newline)" \
+ "#<gdb:breakpoint #${decimal} BP_(?:HARDWARE_)?WATCHPOINT enabled noisy hit:0 ignore:0>" \
+ "print watchpoint after registering"
gdb_test "continue" \
".*\[Ww\]atchpoint.*result.*Old value = 0.*New value = 25.*main.*" \
"test watchpoint write"
--
2.25.4
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [PATCH 1/2] gdb/testsuite: resolve duplicate test names in gdb.guile/scm-breakpoint.exp
2021-05-05 18:10 ` [PATCH 1/2] gdb/testsuite: resolve duplicate test names in gdb.guile/scm-breakpoint.exp Andrew Burgess
@ 2021-05-06 2:02 ` Simon Marchi
2021-05-06 9:59 ` Andrew Burgess
0 siblings, 1 reply; 6+ messages in thread
From: Simon Marchi @ 2021-05-06 2:02 UTC (permalink / raw)
To: Andrew Burgess, gdb-patches
On 2021-05-05 2:10 p.m., Andrew Burgess wrote:
> Extend some test names to avoid duplicates.
LGTM. If you'd like to clean this up further (push an obvious patch on
top of that), you could change all the:
proc foo { } {
with_test_prefix foo {
...
}
}
To:
proc_with_prefix foo { } {
...
}
That would remove a level of indentation.
Simon
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [PATCH 2/2] gdb/guile: don't try to print location for watchpoints
2021-05-05 18:10 ` [PATCH 2/2] gdb/guile: don't try to print location for watchpoints Andrew Burgess
@ 2021-05-06 2:09 ` Simon Marchi
0 siblings, 0 replies; 6+ messages in thread
From: Simon Marchi @ 2021-05-06 2:09 UTC (permalink / raw)
To: Andrew Burgess, gdb-patches
On 2021-05-05 2:10 p.m., Andrew Burgess wrote:
> Currently, using the guile API, if a user tries to print a breakpoint
> object that represents a watchpoint, then GDB will crash. For
> example:
>
> (gdb) guile (use-modules (gdb))
> (gdb) guile (define wp1 (make-breakpoint "some_variable" #:type BP_WATCHPOINT #:wp-class WP_WRITE))
> (gdb) guile (register-breakpoint! wp1)
> (gdb) guile (display wp1) (newline)
> Aborted (core dumped)
>
> This turns out to be because GDB calls event_location_to_string on the
> breakpoints location, and watchpoint breakpoints don't have a
> location.
>
> This commit resolves the crash by just skipping the printing of the
> location if the breakpoint doesn't have one.
>
> Potentially, we could improve on this by printing details about what
> the watchpoint is watching, however, I'm considering this a possible
> future enhancement, this commit focuses just on having GDB not crash.
>
> gdb/ChangeLog:
>
> * guile/scm-breakpoint.c (bpscm_print_breakpoint_smob): Only print
> breakpoint locations when the breakpoint actually has a location.
>
> gdb/testsuite/ChangeLog:
>
> * gdb.guile/scm-breakpoint.exp (test_watchpoints): Print the
> watchpoint object before and after registering it with GDB.
LGTM, I noted some nits below.
> diff --git a/gdb/guile/scm-breakpoint.c b/gdb/guile/scm-breakpoint.c
> index 25b438b7210..791e3051f6d 100644
> --- a/gdb/guile/scm-breakpoint.c
> +++ b/gdb/guile/scm-breakpoint.c
> @@ -184,9 +184,12 @@ bpscm_print_breakpoint_smob (SCM self, SCM port, scm_print_state *pstate)
> gdbscm_printf (port, " hit:%d", b->hit_count);
> gdbscm_printf (port, " ignore:%d", b->ignore_count);
>
> - str = event_location_to_string (b->location.get ());
> - if (str != NULL)
> - gdbscm_printf (port, " @%s", str);
> + if (b->location.get () != nullptr)
Nit 1: for the purpose of the comparison, you don't have to use `.get ()`.
> + {
> + str = event_location_to_string (b->location.get ());
Nit 2: declare `str` here.
> + if (str != NULL)
Nit 3: change NULL to nullptr.
Simon
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [PATCH 1/2] gdb/testsuite: resolve duplicate test names in gdb.guile/scm-breakpoint.exp
2021-05-06 2:02 ` Simon Marchi
@ 2021-05-06 9:59 ` Andrew Burgess
0 siblings, 0 replies; 6+ messages in thread
From: Andrew Burgess @ 2021-05-06 9:59 UTC (permalink / raw)
To: Simon Marchi; +Cc: gdb-patches
* Simon Marchi <simon.marchi@polymtl.ca> [2021-05-05 22:02:20 -0400]:
> On 2021-05-05 2:10 p.m., Andrew Burgess wrote:
> > Extend some test names to avoid duplicates.
>
> LGTM. If you'd like to clean this up further (push an obvious patch on
> top of that), you could change all the:
>
> proc foo { } {
> with_test_prefix foo {
> ...
> }
> }
>
> To:
>
> proc_with_prefix foo { } {
> ...
> }
>
> That would remove a level of indentation.
>
> Simon
Good idea. I pushed the patch below.
Thanks,
Andrew
---
commit a7ed4ea6af8a333fccf1760cf38bf7d3634afd59
Author: Andrew Burgess <andrew.burgess@embecosm.com>
Date: Thu May 6 10:37:04 2021 +0100
gdb/testsuite: use proc_with_prefix in gdb.guile/scm-breakpoint.exp
Convert gdb.guile/scm-breakpoint.exp to use proc_with_prefix instead
of using nested with_test_prefix calls. Allows a level of indentation
to be removed from most of the test procs.
There were two procs that didn't use with_test_prefix, but I converted
them to be proc_with_prefix anyway, for consistency.
gdb/testsuite/ChangeLog:
* gdb.guile/scm-breakpoint.exp (test_bkpt_basic): Convert to
'proc_with_prefix', remove use of 'with_test_prefix', and
reindent.
(test_bkpt_deletion): Likewise.
(test_bkpt_cond_and_cmds): Likewise.
(test_bkpt_invisible): Likewise.
(test_watchpoints): Likewise.
(test_bkpt_internal): Likewise.
(test_bkpt_eval_funcs): Likewise.
(test_bkpt_registration): Likewise.
(test_bkpt_address): Convert to 'proc_with_prefix'.
(test_bkpt_probe): Likewise.
diff --git a/gdb/testsuite/gdb.guile/scm-breakpoint.exp b/gdb/testsuite/gdb.guile/scm-breakpoint.exp
index 1fc34dd3412..9d271739852 100644
--- a/gdb/testsuite/gdb.guile/scm-breakpoint.exp
+++ b/gdb/testsuite/gdb.guile/scm-breakpoint.exp
@@ -27,469 +27,453 @@ if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile}] } {
# Skip all tests if Guile scripting is not enabled.
if { [skip_guile_tests] } { continue }
-proc test_bkpt_basic { } {
+proc_with_prefix test_bkpt_basic { } {
global srcfile testfile hex decimal
- with_test_prefix "test_bkpt_basic" {
- # Start with a fresh gdb.
- clean_restart ${testfile}
-
- if ![gdb_guile_runto_main] {
- return
- }
-
- # Initially there should be one breakpoint: main.
-
- gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
- "get breakpoint list 1"
- gdb_test "guile (print (car blist))" \
- "<gdb:breakpoint #1 BP_BREAKPOINT enabled noisy hit:1 ignore:0 @-qualified main>" \
- "check main breakpoint"
- gdb_test "guile (print (breakpoint-location (car blist)))" \
- "main" "check main breakpoint location"
-
- set mult_line [gdb_get_line_number "Break at multiply."]
- gdb_breakpoint ${mult_line}
- gdb_continue_to_breakpoint "Break at multiply, first time"
-
- # Check that the Guile breakpoint code noted the addition of a
- # breakpoint "behind the scenes".
- gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
- "get breakpoint list 2"
- gdb_scm_test_silent_cmd "guile (define mult-bkpt (cadr blist))" \
- "get multiply breakpoint"
- gdb_test "guile (print (length blist))" \
- "= 2" "check for two breakpoints"
- gdb_test "guile (print mult-bkpt)" \
- "= #<gdb:breakpoint #2 BP_BREAKPOINT enabled noisy hit:1 ignore:0 @.*scm-breakpoint.c:$mult_line>" \
- "check multiply breakpoint"
- gdb_test "guile (print (breakpoint-location mult-bkpt))" \
- "scm-breakpoint\.c:${mult_line}*" \
- "check multiply breakpoint location"
-
- # Check hit and ignore counts.
- gdb_test "guile (print (breakpoint-hit-count mult-bkpt))" \
- "= 1" "check multiply breakpoint hit count"
- gdb_scm_test_silent_cmd "guile (set-breakpoint-ignore-count! mult-bkpt 4)" \
- "set multiply breakpoint ignore count"
- gdb_continue_to_breakpoint "Break at multiply, second time"
- gdb_test "guile (print (breakpoint-hit-count mult-bkpt))" \
- "= 6" "check multiply breakpoint hit count 2"
- gdb_test "print result" \
- " = 545" "check expected variable result after 6 iterations"
-
- # Test breakpoint is enabled and disabled correctly.
- gdb_breakpoint [gdb_get_line_number "Break at add."]
- gdb_continue_to_breakpoint "Break at add, first time"
- gdb_test "guile (print (breakpoint-enabled? mult-bkpt))" \
- "= #t" "check multiply breakpoint enabled"
- gdb_scm_test_silent_cmd "guile (set-breakpoint-enabled! mult-bkpt #f)" \
- "set multiply breakpoint disabled"
- gdb_continue_to_breakpoint "Break at add, second time"
- gdb_scm_test_silent_cmd "guile (set-breakpoint-enabled! mult-bkpt #t)" \
- "set multiply breakpoint enabled"
- gdb_continue_to_breakpoint "Break at multiply, third time"
-
- # Test other getters and setters.
- gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
- "get breakpoint list 3"
- gdb_test "guile (print (breakpoint-thread mult-bkpt))" \
- "= #f" "check breakpoint thread"
- gdb_test "guile (print (= (breakpoint-type mult-bkpt) BP_BREAKPOINT))" \
- "= #t" "check breakpoint type"
- gdb_test "guile (print (map breakpoint-number blist))" \
- "= \\(1 2 3\\)" "check breakpoint numbers"
+ # Start with a fresh gdb.
+ clean_restart ${testfile}
+
+ if ![gdb_guile_runto_main] {
+ return
}
+
+ # Initially there should be one breakpoint: main.
+
+ gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
+ "get breakpoint list 1"
+ gdb_test "guile (print (car blist))" \
+ "<gdb:breakpoint #1 BP_BREAKPOINT enabled noisy hit:1 ignore:0 @-qualified main>" \
+ "check main breakpoint"
+ gdb_test "guile (print (breakpoint-location (car blist)))" \
+ "main" "check main breakpoint location"
+
+ set mult_line [gdb_get_line_number "Break at multiply."]
+ gdb_breakpoint ${mult_line}
+ gdb_continue_to_breakpoint "Break at multiply, first time"
+
+ # Check that the Guile breakpoint code noted the addition of a
+ # breakpoint "behind the scenes".
+ gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
+ "get breakpoint list 2"
+ gdb_scm_test_silent_cmd "guile (define mult-bkpt (cadr blist))" \
+ "get multiply breakpoint"
+ gdb_test "guile (print (length blist))" \
+ "= 2" "check for two breakpoints"
+ gdb_test "guile (print mult-bkpt)" \
+ "= #<gdb:breakpoint #2 BP_BREAKPOINT enabled noisy hit:1 ignore:0 @.*scm-breakpoint.c:$mult_line>" \
+ "check multiply breakpoint"
+ gdb_test "guile (print (breakpoint-location mult-bkpt))" \
+ "scm-breakpoint\.c:${mult_line}*" \
+ "check multiply breakpoint location"
+
+ # Check hit and ignore counts.
+ gdb_test "guile (print (breakpoint-hit-count mult-bkpt))" \
+ "= 1" "check multiply breakpoint hit count"
+ gdb_scm_test_silent_cmd "guile (set-breakpoint-ignore-count! mult-bkpt 4)" \
+ "set multiply breakpoint ignore count"
+ gdb_continue_to_breakpoint "Break at multiply, second time"
+ gdb_test "guile (print (breakpoint-hit-count mult-bkpt))" \
+ "= 6" "check multiply breakpoint hit count 2"
+ gdb_test "print result" \
+ " = 545" "check expected variable result after 6 iterations"
+
+ # Test breakpoint is enabled and disabled correctly.
+ gdb_breakpoint [gdb_get_line_number "Break at add."]
+ gdb_continue_to_breakpoint "Break at add, first time"
+ gdb_test "guile (print (breakpoint-enabled? mult-bkpt))" \
+ "= #t" "check multiply breakpoint enabled"
+ gdb_scm_test_silent_cmd "guile (set-breakpoint-enabled! mult-bkpt #f)" \
+ "set multiply breakpoint disabled"
+ gdb_continue_to_breakpoint "Break at add, second time"
+ gdb_scm_test_silent_cmd "guile (set-breakpoint-enabled! mult-bkpt #t)" \
+ "set multiply breakpoint enabled"
+ gdb_continue_to_breakpoint "Break at multiply, third time"
+
+ # Test other getters and setters.
+ gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
+ "get breakpoint list 3"
+ gdb_test "guile (print (breakpoint-thread mult-bkpt))" \
+ "= #f" "check breakpoint thread"
+ gdb_test "guile (print (= (breakpoint-type mult-bkpt) BP_BREAKPOINT))" \
+ "= #t" "check breakpoint type"
+ gdb_test "guile (print (map breakpoint-number blist))" \
+ "= \\(1 2 3\\)" "check breakpoint numbers"
}
-proc test_bkpt_deletion { } {
+proc_with_prefix test_bkpt_deletion { } {
global srcfile testfile hex decimal
- with_test_prefix test_bkpt_deletion {
- # Start with a fresh gdb.
- clean_restart ${testfile}
-
- if ![gdb_guile_runto_main] {
- return
- }
-
- # Test breakpoints are deleted correctly.
- set deltst_location [gdb_get_line_number "Break at multiply."]
- set end_location [gdb_get_line_number "Break at end."]
- gdb_scm_test_silent_cmd "guile (define dp1 (make-breakpoint \"$deltst_location\"))" \
- "create deltst breakpoint"
- gdb_scm_test_silent_cmd "guile (register-breakpoint! dp1)" \
- "register dp1"
- gdb_breakpoint [gdb_get_line_number "Break at end."]
- gdb_scm_test_silent_cmd "guile (define del-list (breakpoints))" \
- "get breakpoint list 4"
- gdb_test "guile (print (length del-list))" \
- "= 3" "number of breakpoints before delete"
- gdb_continue_to_breakpoint "Break at multiply." \
- ".*$srcfile:$deltst_location.*"
- gdb_scm_test_silent_cmd "guile (delete-breakpoint! dp1)" \
- "delete breakpoint"
- gdb_test "guile (print (breakpoint-number dp1))" \
- "ERROR: .*: Invalid object: <gdb:breakpoint> in position 1: #<gdb:breakpoint #-1>.*" \
- "check breakpoint invalidated"
- gdb_scm_test_silent_cmd "guile (set! del-list (breakpoints))" \
- "get breakpoint list 5"
- gdb_test "guile (print (length del-list))" \
- "= 2" "number of breakpoints after delete"
- gdb_continue_to_breakpoint "Break at end." ".*$srcfile:$end_location.*"
+ # Start with a fresh gdb.
+ clean_restart ${testfile}
+
+ if ![gdb_guile_runto_main] {
+ return
}
+
+ # Test breakpoints are deleted correctly.
+ set deltst_location [gdb_get_line_number "Break at multiply."]
+ set end_location [gdb_get_line_number "Break at end."]
+ gdb_scm_test_silent_cmd "guile (define dp1 (make-breakpoint \"$deltst_location\"))" \
+ "create deltst breakpoint"
+ gdb_scm_test_silent_cmd "guile (register-breakpoint! dp1)" \
+ "register dp1"
+ gdb_breakpoint [gdb_get_line_number "Break at end."]
+ gdb_scm_test_silent_cmd "guile (define del-list (breakpoints))" \
+ "get breakpoint list 4"
+ gdb_test "guile (print (length del-list))" \
+ "= 3" "number of breakpoints before delete"
+ gdb_continue_to_breakpoint "Break at multiply." \
+ ".*$srcfile:$deltst_location.*"
+ gdb_scm_test_silent_cmd "guile (delete-breakpoint! dp1)" \
+ "delete breakpoint"
+ gdb_test "guile (print (breakpoint-number dp1))" \
+ "ERROR: .*: Invalid object: <gdb:breakpoint> in position 1: #<gdb:breakpoint #-1>.*" \
+ "check breakpoint invalidated"
+ gdb_scm_test_silent_cmd "guile (set! del-list (breakpoints))" \
+ "get breakpoint list 5"
+ gdb_test "guile (print (length del-list))" \
+ "= 2" "number of breakpoints after delete"
+ gdb_continue_to_breakpoint "Break at end." ".*$srcfile:$end_location.*"
}
-proc test_bkpt_cond_and_cmds { } {
+proc_with_prefix test_bkpt_cond_and_cmds { } {
global srcfile testfile hex decimal
- with_test_prefix test_bkpt_cond_and_cmds {
- # Start with a fresh gdb.
- clean_restart ${testfile}
-
- if ![gdb_guile_runto_main] {
- return
- }
-
- # Test conditional setting.
- set bp_location1 [gdb_get_line_number "Break at multiply."]
- gdb_scm_test_silent_cmd "guile (define bp1 (make-breakpoint \"$bp_location1\"))" \
- "create multiply breakpoint"
- gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \
- "register bp1"
- gdb_continue_to_breakpoint "Break at multiply, first time"
- gdb_scm_test_silent_cmd "guile (set-breakpoint-condition! bp1 \"i == 5\")" \
- "set condition"
- gdb_test "guile (print (breakpoint-condition bp1))" \
- "= i == 5" "test condition has been set"
- gdb_continue_to_breakpoint "Break at multiply, second time"
- gdb_test "print i" \
- "5" "test conditional breakpoint stopped after five iterations"
- gdb_scm_test_silent_cmd "guile (set-breakpoint-condition! bp1 #f)" \
- "clear condition"
- gdb_test "guile (print (breakpoint-condition bp1))" \
- "= #f" "test condition has been removed"
- gdb_continue_to_breakpoint "Break at multiply, third time"
- gdb_test "print i" "6" "test breakpoint stopped after six iterations"
-
- # Test commands.
- gdb_breakpoint [gdb_get_line_number "Break at add."]
- set test {commands $bpnum}
- gdb_test_multiple $test $test { -re "\r\n>$" { pass $test } }
- set test {print "Command for breakpoint has been executed."}
- gdb_test_multiple $test $test { -re "\r\n>$" { pass $test } }
- set test {print result}
- gdb_test_multiple $test $test { -re "\r\n>$" { pass $test } }
- gdb_test "end"
-
- gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
- "get breakpoint list 6"
- gdb_test "guile (print (breakpoint-commands (list-ref blist (- (length blist) 1))))" \
- "print \"Command for breakpoint has been executed.\".*print result"
+ # Start with a fresh gdb.
+ clean_restart ${testfile}
+
+ if ![gdb_guile_runto_main] {
+ return
}
+
+ # Test conditional setting.
+ set bp_location1 [gdb_get_line_number "Break at multiply."]
+ gdb_scm_test_silent_cmd "guile (define bp1 (make-breakpoint \"$bp_location1\"))" \
+ "create multiply breakpoint"
+ gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \
+ "register bp1"
+ gdb_continue_to_breakpoint "Break at multiply, first time"
+ gdb_scm_test_silent_cmd "guile (set-breakpoint-condition! bp1 \"i == 5\")" \
+ "set condition"
+ gdb_test "guile (print (breakpoint-condition bp1))" \
+ "= i == 5" "test condition has been set"
+ gdb_continue_to_breakpoint "Break at multiply, second time"
+ gdb_test "print i" \
+ "5" "test conditional breakpoint stopped after five iterations"
+ gdb_scm_test_silent_cmd "guile (set-breakpoint-condition! bp1 #f)" \
+ "clear condition"
+ gdb_test "guile (print (breakpoint-condition bp1))" \
+ "= #f" "test condition has been removed"
+ gdb_continue_to_breakpoint "Break at multiply, third time"
+ gdb_test "print i" "6" "test breakpoint stopped after six iterations"
+
+ # Test commands.
+ gdb_breakpoint [gdb_get_line_number "Break at add."]
+ set test {commands $bpnum}
+ gdb_test_multiple $test $test { -re "\r\n>$" { pass $test } }
+ set test {print "Command for breakpoint has been executed."}
+ gdb_test_multiple $test $test { -re "\r\n>$" { pass $test } }
+ set test {print result}
+ gdb_test_multiple $test $test { -re "\r\n>$" { pass $test } }
+ gdb_test "end"
+
+ gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
+ "get breakpoint list 6"
+ gdb_test "guile (print (breakpoint-commands (list-ref blist (- (length blist) 1))))" \
+ "print \"Command for breakpoint has been executed.\".*print result"
}
-proc test_bkpt_invisible { } {
+proc_with_prefix test_bkpt_invisible { } {
global srcfile testfile hex decimal
- with_test_prefix test_bkpt_invisible {
- # Start with a fresh gdb.
- clean_restart ${testfile}
-
- if ![gdb_guile_runto_main] {
- return
- }
-
- # Test invisible breakpoints.
- delete_breakpoints
- set ibp_location [gdb_get_line_number "Break at multiply."]
- gdb_scm_test_silent_cmd "guile (define vbp1 (make-breakpoint \"$ibp_location\" #:internal #f))" \
- "create visible breakpoint"
- gdb_scm_test_silent_cmd "guile (register-breakpoint! vbp1)" \
- "register vbp1"
- gdb_scm_test_silent_cmd "guile (define vbp (car (breakpoints)))" \
- "get visible breakpoint"
- gdb_test "guile (print vbp)" \
- "= #<gdb:breakpoint #2 BP_BREAKPOINT enabled noisy hit:0 ignore:0 @.*scm-breakpoint.c:$ibp_location>" \
- "check visible bp obj exists"
- gdb_test "guile (print (breakpoint-location vbp))" \
- "scm-breakpoint\.c:$ibp_location*" "check visible breakpoint location"
- gdb_test "guile (print (breakpoint-visible? vbp))" \
- "= #t" "check breakpoint visibility"
- gdb_test "info breakpoints" \
- "scm-breakpoint\.c:$ibp_location.*" \
- "check info breakpoints shows visible breakpoints"
- delete_breakpoints
- gdb_scm_test_silent_cmd "guile (define ibp (make-breakpoint \"$ibp_location\" #:internal #t))" \
- "create invisible breakpoint"
- gdb_scm_test_silent_cmd "guile (register-breakpoint! ibp)" \
- "register ibp"
- gdb_test "guile (print ibp)" \
- "= #<gdb:breakpoint #-$decimal BP_BREAKPOINT enabled noisy hit:0 ignore:0 @.*scm-breakpoint.c:$ibp_location>" \
- "check invisible bp obj exists"
- gdb_test "guile (print (breakpoint-location ibp))" \
- "scm-breakpoint\.c:$ibp_location*" "check invisible breakpoint location"
- gdb_test "guile (print (breakpoint-visible? ibp))" \
- "= #f" "check breakpoint invisibility"
- gdb_test "info breakpoints" \
- "No breakpoints or watchpoints.*" \
- "check info breakpoints does not show invisible breakpoints"
- gdb_test "maint info breakpoints" \
- "scm-breakpoint\.c:$ibp_location.*" \
- "check maint info breakpoints shows invisible breakpoints"
+ # Start with a fresh gdb.
+ clean_restart ${testfile}
+
+ if ![gdb_guile_runto_main] {
+ return
}
+
+ # Test invisible breakpoints.
+ delete_breakpoints
+ set ibp_location [gdb_get_line_number "Break at multiply."]
+ gdb_scm_test_silent_cmd "guile (define vbp1 (make-breakpoint \"$ibp_location\" #:internal #f))" \
+ "create visible breakpoint"
+ gdb_scm_test_silent_cmd "guile (register-breakpoint! vbp1)" \
+ "register vbp1"
+ gdb_scm_test_silent_cmd "guile (define vbp (car (breakpoints)))" \
+ "get visible breakpoint"
+ gdb_test "guile (print vbp)" \
+ "= #<gdb:breakpoint #2 BP_BREAKPOINT enabled noisy hit:0 ignore:0 @.*scm-breakpoint.c:$ibp_location>" \
+ "check visible bp obj exists"
+ gdb_test "guile (print (breakpoint-location vbp))" \
+ "scm-breakpoint\.c:$ibp_location*" "check visible breakpoint location"
+ gdb_test "guile (print (breakpoint-visible? vbp))" \
+ "= #t" "check breakpoint visibility"
+ gdb_test "info breakpoints" \
+ "scm-breakpoint\.c:$ibp_location.*" \
+ "check info breakpoints shows visible breakpoints"
+ delete_breakpoints
+ gdb_scm_test_silent_cmd "guile (define ibp (make-breakpoint \"$ibp_location\" #:internal #t))" \
+ "create invisible breakpoint"
+ gdb_scm_test_silent_cmd "guile (register-breakpoint! ibp)" \
+ "register ibp"
+ gdb_test "guile (print ibp)" \
+ "= #<gdb:breakpoint #-$decimal BP_BREAKPOINT enabled noisy hit:0 ignore:0 @.*scm-breakpoint.c:$ibp_location>" \
+ "check invisible bp obj exists"
+ gdb_test "guile (print (breakpoint-location ibp))" \
+ "scm-breakpoint\.c:$ibp_location*" "check invisible breakpoint location"
+ gdb_test "guile (print (breakpoint-visible? ibp))" \
+ "= #f" "check breakpoint invisibility"
+ gdb_test "info breakpoints" \
+ "No breakpoints or watchpoints.*" \
+ "check info breakpoints does not show invisible breakpoints"
+ gdb_test "maint info breakpoints" \
+ "scm-breakpoint\.c:$ibp_location.*" \
+ "check maint info breakpoints shows invisible breakpoints"
}
-proc test_watchpoints { } {
+proc_with_prefix test_watchpoints { } {
global srcfile testfile hex decimal
- with_test_prefix test_watchpoints {
- # Start with a fresh gdb.
- clean_restart ${testfile}
-
- # Disable hardware watchpoints if necessary.
- if [target_info exists gdb,no_hardware_watchpoints] {
- gdb_test_no_output "set can-use-hw-watchpoints 0" ""
- }
- if ![gdb_guile_runto_main] {
- return
- }
-
- gdb_scm_test_silent_cmd "guile (define wp1 (make-breakpoint \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE))" \
- "create watchpoint"
- gdb_scm_test_silent_cmd "guile (register-breakpoint! wp1)" \
- "register wp1"
- gdb_test "continue" \
- ".*\[Ww\]atchpoint.*result.*Old value = 0.*New value = 25.*main.*" \
- "test watchpoint write"
+ # Start with a fresh gdb.
+ clean_restart ${testfile}
+
+ # Disable hardware watchpoints if necessary.
+ if [target_info exists gdb,no_hardware_watchpoints] {
+ gdb_test_no_output "set can-use-hw-watchpoints 0" ""
+ }
+ if ![gdb_guile_runto_main] {
+ return
}
+
+ gdb_scm_test_silent_cmd "guile (define wp1 (make-breakpoint \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE))" \
+ "create watchpoint"
+ gdb_scm_test_silent_cmd "guile (register-breakpoint! wp1)" \
+ "register wp1"
+ gdb_test "continue" \
+ ".*\[Ww\]atchpoint.*result.*Old value = 0.*New value = 25.*main.*" \
+ "test watchpoint write"
}
-proc test_bkpt_internal { } {
+proc_with_prefix test_bkpt_internal { } {
global srcfile testfile hex decimal
- with_test_prefix test_bkpt_internal {
- # Start with a fresh gdb.
- clean_restart ${testfile}
-
- # Disable hardware watchpoints if necessary.
- if [target_info exists gdb,no_hardware_watchpoints] {
- gdb_test_no_output "set can-use-hw-watchpoints 0" ""
- }
- if ![gdb_guile_runto_main] {
- return
- }
-
- delete_breakpoints
-
- gdb_scm_test_silent_cmd "guile (define wp1 (make-breakpoint \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE #:internal #t))" \
- "create invisible watchpoint"
- gdb_scm_test_silent_cmd "guile (register-breakpoint! wp1)" \
- "register wp1"
- gdb_test "info breakpoints" \
- "No breakpoints or watchpoints.*" \
- "check info breakpoints does not show invisible watchpoint"
- gdb_test "maint info breakpoints" \
- ".*watchpoint.*result.*" \
- "check maint info breakpoints shows invisible watchpoint"
- gdb_test "continue" \
- ".*\[Ww\]atchpoint.*result.*Old value = 0.*New value = 25.*" \
- "test invisible watchpoint write"
+ # Start with a fresh gdb.
+ clean_restart ${testfile}
+
+ # Disable hardware watchpoints if necessary.
+ if [target_info exists gdb,no_hardware_watchpoints] {
+ gdb_test_no_output "set can-use-hw-watchpoints 0" ""
}
+ if ![gdb_guile_runto_main] {
+ return
+ }
+
+ delete_breakpoints
+
+ gdb_scm_test_silent_cmd "guile (define wp1 (make-breakpoint \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE #:internal #t))" \
+ "create invisible watchpoint"
+ gdb_scm_test_silent_cmd "guile (register-breakpoint! wp1)" \
+ "register wp1"
+ gdb_test "info breakpoints" \
+ "No breakpoints or watchpoints.*" \
+ "check info breakpoints does not show invisible watchpoint"
+ gdb_test "maint info breakpoints" \
+ ".*watchpoint.*result.*" \
+ "check maint info breakpoints shows invisible watchpoint"
+ gdb_test "continue" \
+ ".*\[Ww\]atchpoint.*result.*Old value = 0.*New value = 25.*" \
+ "test invisible watchpoint write"
}
-proc test_bkpt_eval_funcs { } {
+proc_with_prefix test_bkpt_eval_funcs { } {
global srcfile testfile hex decimal
- with_test_prefix test_bkpt_eval_funcs {
- # Start with a fresh gdb.
- clean_restart ${testfile}
-
- # Disable hardware watchpoints if necessary.
- if [target_info exists gdb,no_hardware_watchpoints] {
- gdb_test_no_output "set can-use-hw-watchpoints 0" ""
- }
- if ![gdb_guile_runto_main] {
- return
- }
-
- delete_breakpoints
-
- # Define create-breakpoint! as a convenient wrapper around
- # make-breakpoint, register-breakpoint!
- gdb_test_no_output "guile (define (create-breakpoint! . args) (let ((bp (apply make-breakpoint args))) (register-breakpoint! bp) bp))" \
- "define create-breakpoint!"
-
- gdb_test_multiline "data collection breakpoint 1" \
- "guile" "" \
- "(define (make-bp-data) (cons 0 0))" "" \
- "(define bp-data-count car)" "" \
- "(define set-bp-data-count! set-car!)" "" \
- "(define bp-data-inf-i cdr)" "" \
- "(define set-bp-data-inf-i! set-cdr!)" "" \
- "(define (bp-eval-count bkpt) (bp-data-count (object-property bkpt 'bp-data)))" "" \
- "(define (bp-eval-inf-i bkpt) (bp-data-inf-i (object-property bkpt 'bp-data)))" "" \
- "(define (make-bp-eval location)" "" \
- " (let ((bp (create-breakpoint! location)))" "" \
- " (set-object-property! bp 'bp-data (make-bp-data))" "" \
- " (set-breakpoint-stop! bp" "" \
- " (lambda (bkpt)" "" \
- " (let ((data (object-property bkpt 'bp-data))" "" \
- " (inf-i (parse-and-eval \"i\")))" "" \
- " (set-bp-data-count! data (+ (bp-data-count data) 1))" "" \
- " (set-bp-data-inf-i! data inf-i)" "" \
- " (value=? inf-i 3))))" "" \
- " bp))" "" \
- "end" ""
-
- gdb_test_multiline "data collection breakpoint 2" \
- "guile" "" \
- "(define (make-bp-also-eval location)" "" \
- " (let ((bp (create-breakpoint! location)))" "" \
- " (set-object-property! bp 'bp-data (make-bp-data))" "" \
- " (set-breakpoint-stop! bp" "" \
- " (lambda (bkpt)" "" \
- " (let* ((data (object-property bkpt 'bp-data))" "" \
- " (count (+ (bp-data-count data) 1)))" "" \
- " (set-bp-data-count! data count)" "" \
- " (= count 9))))" "" \
- " bp))" "" \
- "end" ""
-
- gdb_test_multiline "data collection breakpoint 3" \
- "guile" "" \
- "(define (make-bp-basic location)" "" \
- " (let ((bp (create-breakpoint! location)))" "" \
- " (set-object-property! bp 'bp-data (make-bp-data))" "" \
- " bp))" "" \
- "end" ""
-
- set bp_location2 [gdb_get_line_number "Break at multiply."]
- set end_location [gdb_get_line_number "Break at end."]
- gdb_scm_test_silent_cmd "guile (define eval-bp1 (make-bp-eval \"$bp_location2\"))" \
- "create eval-bp1 breakpoint"
- gdb_scm_test_silent_cmd "guile (define also-eval-bp1 (make-bp-also-eval \"$bp_location2\"))" \
- "create also-eval-bp1 breakpoint"
- gdb_scm_test_silent_cmd "guile (define never-eval-bp1 (make-bp-also-eval \"$end_location\"))" \
- "create never-eval-bp1 breakpoint"
- gdb_continue_to_breakpoint "Break at multiply, first time" \
- ".*$srcfile:$bp_location2.*"
- gdb_test "print i" "3" "check inferior value matches guile accounting"
- gdb_test "guile (print (bp-eval-inf-i eval-bp1))" \
- "= 3" "check guile accounting matches inferior"
- gdb_test "guile (print (bp-eval-count also-eval-bp1))" \
- "= 4" \
- "check non firing same-location breakpoint eval function was also called at each stop 1"
- gdb_test "guile (print (bp-eval-count eval-bp1))" \
- "= 4" \
- "check non firing same-location breakpoint eval function was also called at each stop 2"
-
- # Check we cannot assign a condition to a breakpoint with a stop-func,
- # and cannot assign a stop-func to a breakpoint with a condition.
-
- delete_breakpoints
- set cond_bp [gdb_get_line_number "Break at multiply."]
- gdb_scm_test_silent_cmd "guile (define eval-bp1 (make-bp-eval \"$cond_bp\"))" \
- "create eval-bp1 breakpoint 2"
- set test_cond {cond $bpnum}
- gdb_test "$test_cond \"foo==3\"" \
- "Only one stop condition allowed.*"
- gdb_scm_test_silent_cmd "guile (define eval-bp2 (make-bp-basic \"$cond_bp\"))" \
- "create basic breakpoint"
- gdb_scm_test_silent_cmd "guile (set-breakpoint-condition! eval-bp2 \"1==1\")" \
- "set a condition"
- gdb_test_multiline "construct an eval function" \
- "guile" "" \
- "(define (stop-func bkpt)" "" \
- " return #t)" "" \
- "end" ""
- gdb_test "guile (set-breakpoint-stop! eval-bp2 stop-func)" \
- "Only one stop condition allowed.*"
-
- # Check that stop-func is run when location has normal bp.
-
- delete_breakpoints
- gdb_breakpoint [gdb_get_line_number "Break at multiply."]
- gdb_scm_test_silent_cmd "guile (define check-eval (make-bp-eval \"$bp_location2\"))" \
- "create check-eval breakpoint"
- gdb_test "guile (print (bp-eval-count check-eval))" \
- "= 0" \
- "test that evaluate function has not been yet executed (ie count = 0)"
- gdb_continue_to_breakpoint "Break at multiply, second time" \
- ".*$srcfile:$bp_location2.*"
- gdb_test "guile (print (bp-eval-count check-eval))" \
- "= 1" \
- "test that evaluate function is run when location also has normal bp"
-
- # Test watchpoints with stop-func.
-
- gdb_test_multiline "watchpoint stop func" \
- "guile" "" \
- "(define (make-wp-eval location)" "" \
- " (let ((wp (create-breakpoint! location #:type BP_WATCHPOINT #:wp-class WP_WRITE)))" "" \
- " (set-breakpoint-stop! wp" "" \
- " (lambda (bkpt)" "" \
- " (let ((result (parse-and-eval \"result\")))" "" \
- " (value=? result 788))))" "" \
- " wp))" "" \
- "end" ""
-
- delete_breakpoints
- gdb_scm_test_silent_cmd "guile (define wp1 (make-wp-eval \"result\"))" \
- "create watchpoint"
- gdb_test "continue" ".*\[Ww\]atchpoint.*result.*Old value =.*New value = 788.*" \
- "test watchpoint write"
-
- # Misc final tests.
-
- gdb_test "guile (print (bp-eval-count never-eval-bp1))" \
- "= 0" \
- "check that this unrelated breakpoints eval function was never called"
+ # Start with a fresh gdb.
+ clean_restart ${testfile}
+
+ # Disable hardware watchpoints if necessary.
+ if [target_info exists gdb,no_hardware_watchpoints] {
+ gdb_test_no_output "set can-use-hw-watchpoints 0" ""
}
+ if ![gdb_guile_runto_main] {
+ return
+ }
+
+ delete_breakpoints
+
+ # Define create-breakpoint! as a convenient wrapper around
+ # make-breakpoint, register-breakpoint!
+ gdb_test_no_output "guile (define (create-breakpoint! . args) (let ((bp (apply make-breakpoint args))) (register-breakpoint! bp) bp))" \
+ "define create-breakpoint!"
+
+ gdb_test_multiline "data collection breakpoint 1" \
+ "guile" "" \
+ "(define (make-bp-data) (cons 0 0))" "" \
+ "(define bp-data-count car)" "" \
+ "(define set-bp-data-count! set-car!)" "" \
+ "(define bp-data-inf-i cdr)" "" \
+ "(define set-bp-data-inf-i! set-cdr!)" "" \
+ "(define (bp-eval-count bkpt) (bp-data-count (object-property bkpt 'bp-data)))" "" \
+ "(define (bp-eval-inf-i bkpt) (bp-data-inf-i (object-property bkpt 'bp-data)))" "" \
+ "(define (make-bp-eval location)" "" \
+ " (let ((bp (create-breakpoint! location)))" "" \
+ " (set-object-property! bp 'bp-data (make-bp-data))" "" \
+ " (set-breakpoint-stop! bp" "" \
+ " (lambda (bkpt)" "" \
+ " (let ((data (object-property bkpt 'bp-data))" "" \
+ " (inf-i (parse-and-eval \"i\")))" "" \
+ " (set-bp-data-count! data (+ (bp-data-count data) 1))" "" \
+ " (set-bp-data-inf-i! data inf-i)" "" \
+ " (value=? inf-i 3))))" "" \
+ " bp))" "" \
+ "end" ""
+
+ gdb_test_multiline "data collection breakpoint 2" \
+ "guile" "" \
+ "(define (make-bp-also-eval location)" "" \
+ " (let ((bp (create-breakpoint! location)))" "" \
+ " (set-object-property! bp 'bp-data (make-bp-data))" "" \
+ " (set-breakpoint-stop! bp" "" \
+ " (lambda (bkpt)" "" \
+ " (let* ((data (object-property bkpt 'bp-data))" "" \
+ " (count (+ (bp-data-count data) 1)))" "" \
+ " (set-bp-data-count! data count)" "" \
+ " (= count 9))))" "" \
+ " bp))" "" \
+ "end" ""
+
+ gdb_test_multiline "data collection breakpoint 3" \
+ "guile" "" \
+ "(define (make-bp-basic location)" "" \
+ " (let ((bp (create-breakpoint! location)))" "" \
+ " (set-object-property! bp 'bp-data (make-bp-data))" "" \
+ " bp))" "" \
+ "end" ""
+
+ set bp_location2 [gdb_get_line_number "Break at multiply."]
+ set end_location [gdb_get_line_number "Break at end."]
+ gdb_scm_test_silent_cmd "guile (define eval-bp1 (make-bp-eval \"$bp_location2\"))" \
+ "create eval-bp1 breakpoint"
+ gdb_scm_test_silent_cmd "guile (define also-eval-bp1 (make-bp-also-eval \"$bp_location2\"))" \
+ "create also-eval-bp1 breakpoint"
+ gdb_scm_test_silent_cmd "guile (define never-eval-bp1 (make-bp-also-eval \"$end_location\"))" \
+ "create never-eval-bp1 breakpoint"
+ gdb_continue_to_breakpoint "Break at multiply, first time" \
+ ".*$srcfile:$bp_location2.*"
+ gdb_test "print i" "3" "check inferior value matches guile accounting"
+ gdb_test "guile (print (bp-eval-inf-i eval-bp1))" \
+ "= 3" "check guile accounting matches inferior"
+ gdb_test "guile (print (bp-eval-count also-eval-bp1))" \
+ "= 4" \
+ "check non firing same-location breakpoint eval function was also called at each stop 1"
+ gdb_test "guile (print (bp-eval-count eval-bp1))" \
+ "= 4" \
+ "check non firing same-location breakpoint eval function was also called at each stop 2"
+
+ # Check we cannot assign a condition to a breakpoint with a stop-func,
+ # and cannot assign a stop-func to a breakpoint with a condition.
+
+ delete_breakpoints
+ set cond_bp [gdb_get_line_number "Break at multiply."]
+ gdb_scm_test_silent_cmd "guile (define eval-bp1 (make-bp-eval \"$cond_bp\"))" \
+ "create eval-bp1 breakpoint 2"
+ set test_cond {cond $bpnum}
+ gdb_test "$test_cond \"foo==3\"" \
+ "Only one stop condition allowed.*"
+ gdb_scm_test_silent_cmd "guile (define eval-bp2 (make-bp-basic \"$cond_bp\"))" \
+ "create basic breakpoint"
+ gdb_scm_test_silent_cmd "guile (set-breakpoint-condition! eval-bp2 \"1==1\")" \
+ "set a condition"
+ gdb_test_multiline "construct an eval function" \
+ "guile" "" \
+ "(define (stop-func bkpt)" "" \
+ " return #t)" "" \
+ "end" ""
+ gdb_test "guile (set-breakpoint-stop! eval-bp2 stop-func)" \
+ "Only one stop condition allowed.*"
+
+ # Check that stop-func is run when location has normal bp.
+
+ delete_breakpoints
+ gdb_breakpoint [gdb_get_line_number "Break at multiply."]
+ gdb_scm_test_silent_cmd "guile (define check-eval (make-bp-eval \"$bp_location2\"))" \
+ "create check-eval breakpoint"
+ gdb_test "guile (print (bp-eval-count check-eval))" \
+ "= 0" \
+ "test that evaluate function has not been yet executed (ie count = 0)"
+ gdb_continue_to_breakpoint "Break at multiply, second time" \
+ ".*$srcfile:$bp_location2.*"
+ gdb_test "guile (print (bp-eval-count check-eval))" \
+ "= 1" \
+ "test that evaluate function is run when location also has normal bp"
+
+ # Test watchpoints with stop-func.
+
+ gdb_test_multiline "watchpoint stop func" \
+ "guile" "" \
+ "(define (make-wp-eval location)" "" \
+ " (let ((wp (create-breakpoint! location #:type BP_WATCHPOINT #:wp-class WP_WRITE)))" "" \
+ " (set-breakpoint-stop! wp" "" \
+ " (lambda (bkpt)" "" \
+ " (let ((result (parse-and-eval \"result\")))" "" \
+ " (value=? result 788))))" "" \
+ " wp))" "" \
+ "end" ""
+
+ delete_breakpoints
+ gdb_scm_test_silent_cmd "guile (define wp1 (make-wp-eval \"result\"))" \
+ "create watchpoint"
+ gdb_test "continue" ".*\[Ww\]atchpoint.*result.*Old value =.*New value = 788.*" \
+ "test watchpoint write"
+
+ # Misc final tests.
+
+ gdb_test "guile (print (bp-eval-count never-eval-bp1))" \
+ "= 0" \
+ "check that this unrelated breakpoints eval function was never called"
}
-proc test_bkpt_registration {} {
+proc_with_prefix test_bkpt_registration {} {
global srcfile testfile
- with_test_prefix "test_bkpt_registration" {
- # Start with a fresh gdb.
- clean_restart ${testfile}
-
- if ![gdb_guile_runto_main] {
- return
- }
-
- # Initially there should be one breakpoint: main.
- gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
- "get breakpoint list 1"
- gdb_test "guile (register-breakpoint! (car blist))" \
- "ERROR: .*: not a Scheme breakpoint.*" \
- "try to register a non-guile breakpoint"
-
- set bp_location1 [gdb_get_line_number "Break at multiply."]
- gdb_scm_test_silent_cmd "guile (define bp1 (make-breakpoint \"$bp_location1\"))" \
- "create multiply breakpoint"
- gdb_test "guile (print (breakpoint-valid? bp1))" \
- "= #f" "breakpoint invalid after creation"
- gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \
- "register bp1"
- gdb_test "guile (print (breakpoint-valid? bp1))" \
- "= #t" "breakpoint valid after registration"
- gdb_test "guile (register-breakpoint! bp1)" \
- "ERROR: .*: breakpoint is already registered.*" \
- "re-register already registered bp1"
- gdb_scm_test_silent_cmd "guile (delete-breakpoint! bp1)" \
- "delete registered breakpoint"
- gdb_test "guile (print (breakpoint-valid? bp1))" \
- "= #f" "breakpoint invalid after deletion"
- gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \
- "re-register bp1"
- gdb_test "guile (print (breakpoint-valid? bp1))" \
- "= #t" "breakpoint valid after re-registration"
+ # Start with a fresh gdb.
+ clean_restart ${testfile}
+
+ if ![gdb_guile_runto_main] {
+ return
}
+
+ # Initially there should be one breakpoint: main.
+ gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
+ "get breakpoint list 1"
+ gdb_test "guile (register-breakpoint! (car blist))" \
+ "ERROR: .*: not a Scheme breakpoint.*" \
+ "try to register a non-guile breakpoint"
+
+ set bp_location1 [gdb_get_line_number "Break at multiply."]
+ gdb_scm_test_silent_cmd "guile (define bp1 (make-breakpoint \"$bp_location1\"))" \
+ "create multiply breakpoint"
+ gdb_test "guile (print (breakpoint-valid? bp1))" \
+ "= #f" "breakpoint invalid after creation"
+ gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \
+ "register bp1"
+ gdb_test "guile (print (breakpoint-valid? bp1))" \
+ "= #t" "breakpoint valid after registration"
+ gdb_test "guile (register-breakpoint! bp1)" \
+ "ERROR: .*: breakpoint is already registered.*" \
+ "re-register already registered bp1"
+ gdb_scm_test_silent_cmd "guile (delete-breakpoint! bp1)" \
+ "delete registered breakpoint"
+ gdb_test "guile (print (breakpoint-valid? bp1))" \
+ "= #f" "breakpoint invalid after deletion"
+ gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \
+ "re-register bp1"
+ gdb_test "guile (print (breakpoint-valid? bp1))" \
+ "= #t" "breakpoint valid after re-registration"
}
-proc test_bkpt_address {} {
+proc_with_prefix test_bkpt_address {} {
global decimal srcfile
# Leading whitespace is intentional!
@@ -501,7 +485,7 @@ proc test_bkpt_address {} {
".*Breakpoint ($decimal)+ at .*$srcfile, line ($decimal)+\."
}
-proc test_bkpt_probe {} {
+proc_with_prefix test_bkpt_probe {} {
global decimal hex testfile srcfile
if { [prepare_for_testing "failed to prepare" ${testfile}-probes \
^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2021-05-06 9:59 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-05-05 18:10 [PATCH 0/2] Fix crash when printing watchpoints using guile API Andrew Burgess
2021-05-05 18:10 ` [PATCH 1/2] gdb/testsuite: resolve duplicate test names in gdb.guile/scm-breakpoint.exp Andrew Burgess
2021-05-06 2:02 ` Simon Marchi
2021-05-06 9:59 ` Andrew Burgess
2021-05-05 18:10 ` [PATCH 2/2] gdb/guile: don't try to print location for watchpoints Andrew Burgess
2021-05-06 2:09 ` Simon Marchi
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).