-# Copyright (C) 2010-2014 Free Software Foundation, Inc.
+# Copyright (C) 2010-2019 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
standard_testfile
-if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
+if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile}] } {
return -1
}
# 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 (create-breakpoint! \"$deltst_location\"))" \
+ 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 (breakpoint-delete! dp1)" \
+ ".*$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 #2>.*" \
+ "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.*"
+ gdb_continue_to_breakpoint "Break at end." ".*$srcfile:$end_location.*"
}
}
# Test conditional setting.
set bp_location1 [gdb_get_line_number "Break at multiply."]
- gdb_scm_test_silent_cmd "guile (define bp1 (create-breakpoint! \"$bp_location1\"))" \
+ 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"
# Test invisible breakpoints.
delete_breakpoints
set ibp_location [gdb_get_line_number "Break at multiply."]
- gdb_scm_test_silent_cmd "guile (define vbp (create-breakpoint! \"$ibp_location\" #:internal #f))" \
+ 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)" \
"scm-breakpoint\.c:$ibp_location.*" \
"check info breakpoints shows visible breakpoints"
delete_breakpoints
- gdb_scm_test_silent_cmd "guile (define ibp (create-breakpoint! \"$ibp_location\" #:internal #t))" \
+ 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"
return
}
- gdb_scm_test_silent_cmd "guile (define wp1 (create-breakpoint! \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE))" \
+ 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"
delete_breakpoints
- gdb_scm_test_silent_cmd "guile (define wp1 (create-breakpoint! \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE #:internal #t))" \
+ 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"
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 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 (gsmob-property bkpt 'bp-data)))" "" \
- "(define (bp-eval-inf-i bkpt) (bp-data-inf-i (gsmob-property bkpt 'bp-data)))" "" \
+ "(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-gsmob-property! bp 'bp-data (make-bp-data))" "" \
+ " (set-object-property! bp 'bp-data (make-bp-data))" "" \
" (set-breakpoint-stop! bp" "" \
" (lambda (bkpt)" "" \
- " (let ((data (gsmob-property bkpt 'bp-data))" "" \
+ " (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)" "" \
"guile" "" \
"(define (make-bp-also-eval location)" "" \
" (let ((bp (create-breakpoint! location)))" "" \
- " (set-gsmob-property! bp 'bp-data (make-bp-data))" "" \
+ " (set-object-property! bp 'bp-data (make-bp-data))" "" \
" (set-breakpoint-stop! bp" "" \
" (lambda (bkpt)" "" \
- " (let* ((data (gsmob-property bkpt 'bp-data))" "" \
+ " (let* ((data (object-property bkpt 'bp-data))" "" \
" (count (+ (bp-data-count data) 1)))" "" \
" (set-bp-data-count! data count)" "" \
" (= count 9))))" "" \
"guile" "" \
"(define (make-bp-basic location)" "" \
" (let ((bp (create-breakpoint! location)))" "" \
- " (set-gsmob-property! bp 'bp-data (make-bp-data))" "" \
+ " (set-object-property! bp 'bp-data (make-bp-data))" "" \
" bp))" "" \
"end" ""
"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." ".*$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 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." ".*$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"
}
}
+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)+\."
+}
+
+proc test_bkpt_probe {} {
+ global decimal hex testfile srcfile
+
+ if { [prepare_for_testing "failed to prepare" ${testfile}-probes \
+ ${srcfile} {additional_flags=-DUSE_PROBES}] } {
+ return -1
+ }
+
+ if ![gdb_guile_runto_main] then {
+ return
+ }
+
+ gdb_scm_test_silent_cmd \
+ "guile (define bp1 (make-breakpoint \"-probe test:result_updated\"))" \
+ "create probe breakpoint"
+
+ gdb_test \
+ "guile (register-breakpoint! bp1)" \
+ "Breakpoint $decimal at $hex" \
+ "register probe breakpoint"
+}
+
test_bkpt_basic
test_bkpt_deletion
test_bkpt_cond_and_cmds
test_watchpoints
test_bkpt_internal
test_bkpt_eval_funcs
+test_bkpt_registration
+test_bkpt_address
+test_bkpt_probe
projects / deliverable / binutils-gdb.git / blobdiff