# 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!
".*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 \
projects / deliverable / binutils-gdb.git / commitdiff
