e2882c8578
gdb/ChangeLog: Update copyright year range in all GDB files
511 lines
19 KiB
Plaintext
511 lines
19 KiB
Plaintext
# Copyright (C) 2010-2018 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/>.
|
|
|
|
# This file is part of the GDB testsuite.
|
|
# It tests the mechanism exposing breakpoints to Guile.
|
|
|
|
load_lib gdb-guile.exp
|
|
|
|
standard_testfile
|
|
|
|
if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile}] } {
|
|
return -1
|
|
}
|
|
|
|
# Skip all tests if Guile scripting is not enabled.
|
|
if { [skip_guile_tests] } { continue }
|
|
|
|
proc 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 @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."
|
|
|
|
# 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."
|
|
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."
|
|
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_scm_test_silent_cmd "guile (set-breakpoint-enabled! mult-bkpt #t)" \
|
|
"set multiply breakpoint enabled"
|
|
gdb_continue_to_breakpoint "Break at multiply."
|
|
|
|
# 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 { } {
|
|
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.*"
|
|
}
|
|
}
|
|
|
|
proc 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."
|
|
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_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_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 { } {
|
|
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"
|
|
}
|
|
}
|
|
|
|
proc 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"
|
|
}
|
|
}
|
|
|
|
proc 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"
|
|
}
|
|
}
|
|
|
|
proc 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." ".*$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." ".*$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 {} {
|
|
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"
|
|
}
|
|
}
|
|
|
|
proc test_bkpt_address {} {
|
|
global decimal srcfile
|
|
|
|
# Leading whitespace is intentional!
|
|
gdb_scm_test_silent_cmd \
|
|
"guile (define bp1 (make-breakpoint \" *multiply\"))" \
|
|
"create address breakpoint a ' *multiply'" 1
|
|
|
|
gdb_test "guile (register-breakpoint! bp1)" \
|
|
".*Breakpoint ($decimal)+ at .*$srcfile, line ($decimal)+\."
|
|
}
|
|
|
|
test_bkpt_basic
|
|
test_bkpt_deletion
|
|
test_bkpt_cond_and_cmds
|
|
test_bkpt_invisible
|
|
test_watchpoints
|
|
test_bkpt_internal
|
|
test_bkpt_eval_funcs
|
|
test_bkpt_registration
|
|
test_bkpt_address
|