]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blame - gdb/testsuite/gdb.guile/scm-breakpoint.exp
[gdb/testsuite] Fix gdb.guile/scm-breakpoint.exp with guile 3.0
[thirdparty/binutils-gdb.git] / gdb / testsuite / gdb.guile / scm-breakpoint.exp
CommitLineData
3666a048 1# Copyright (C) 2010-2021 Free Software Foundation, Inc.
ed3ef339
DE
2#
3# This program is free software; you can redistribute it and/or modify
4# it under the terms of the GNU General Public License as published by
5# the Free Software Foundation; either version 3 of the License, or
6# (at your option) any later version.
7#
8# This program is distributed in the hope that it will be useful,
9# but WITHOUT ANY WARRANTY; without even the implied warranty of
10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11# GNU General Public License for more details.
12#
13# You should have received a copy of the GNU General Public License
14# along with this program. If not, see <http://www.gnu.org/licenses/>.
15
16# This file is part of the GDB testsuite.
17# It tests the mechanism exposing breakpoints to Guile.
18
19load_lib gdb-guile.exp
20
21standard_testfile
22
5b362f04 23if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile}] } {
ed3ef339
DE
24 return -1
25}
26
27# Skip all tests if Guile scripting is not enabled.
28if { [skip_guile_tests] } { continue }
29
a7ed4ea6 30proc_with_prefix test_bkpt_basic { } {
ed3ef339
DE
31 global srcfile testfile hex decimal
32
a7ed4ea6
AB
33 # Start with a fresh gdb.
34 clean_restart ${testfile}
35
36 if ![gdb_guile_runto_main] {
37 return
ed3ef339 38 }
a7ed4ea6
AB
39
40 # Initially there should be one breakpoint: main.
41
42 gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
43 "get breakpoint list 1"
44 gdb_test "guile (print (car blist))" \
45 "<gdb:breakpoint #1 BP_BREAKPOINT enabled noisy hit:1 ignore:0 @-qualified main>" \
46 "check main breakpoint"
47 gdb_test "guile (print (breakpoint-location (car blist)))" \
48 "main" "check main breakpoint location"
49
50 set mult_line [gdb_get_line_number "Break at multiply."]
51 gdb_breakpoint ${mult_line}
52 gdb_continue_to_breakpoint "Break at multiply, first time"
53
54 # Check that the Guile breakpoint code noted the addition of a
55 # breakpoint "behind the scenes".
56 gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
57 "get breakpoint list 2"
58 gdb_scm_test_silent_cmd "guile (define mult-bkpt (cadr blist))" \
59 "get multiply breakpoint"
60 gdb_test "guile (print (length blist))" \
61 "= 2" "check for two breakpoints"
62 gdb_test "guile (print mult-bkpt)" \
63 "= #<gdb:breakpoint #2 BP_BREAKPOINT enabled noisy hit:1 ignore:0 @.*scm-breakpoint.c:$mult_line>" \
64 "check multiply breakpoint"
65 gdb_test "guile (print (breakpoint-location mult-bkpt))" \
66 "scm-breakpoint\.c:${mult_line}*" \
67 "check multiply breakpoint location"
68
69 # Check hit and ignore counts.
70 gdb_test "guile (print (breakpoint-hit-count mult-bkpt))" \
71 "= 1" "check multiply breakpoint hit count"
72 gdb_scm_test_silent_cmd "guile (set-breakpoint-ignore-count! mult-bkpt 4)" \
73 "set multiply breakpoint ignore count"
74 gdb_continue_to_breakpoint "Break at multiply, second time"
75 gdb_test "guile (print (breakpoint-hit-count mult-bkpt))" \
76 "= 6" "check multiply breakpoint hit count 2"
77 gdb_test "print result" \
78 " = 545" "check expected variable result after 6 iterations"
79
80 # Test breakpoint is enabled and disabled correctly.
81 gdb_breakpoint [gdb_get_line_number "Break at add."]
82 gdb_continue_to_breakpoint "Break at add, first time"
83 gdb_test "guile (print (breakpoint-enabled? mult-bkpt))" \
84 "= #t" "check multiply breakpoint enabled"
85 gdb_scm_test_silent_cmd "guile (set-breakpoint-enabled! mult-bkpt #f)" \
86 "set multiply breakpoint disabled"
87 gdb_continue_to_breakpoint "Break at add, second time"
88 gdb_scm_test_silent_cmd "guile (set-breakpoint-enabled! mult-bkpt #t)" \
89 "set multiply breakpoint enabled"
90 gdb_continue_to_breakpoint "Break at multiply, third time"
91
92 # Test other getters and setters.
93 gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
94 "get breakpoint list 3"
95 gdb_test "guile (print (breakpoint-thread mult-bkpt))" \
96 "= #f" "check breakpoint thread"
97 gdb_test "guile (print (= (breakpoint-type mult-bkpt) BP_BREAKPOINT))" \
98 "= #t" "check breakpoint type"
99 gdb_test "guile (print (map breakpoint-number blist))" \
100 "= \\(1 2 3\\)" "check breakpoint numbers"
ed3ef339
DE
101}
102
a7ed4ea6 103proc_with_prefix test_bkpt_deletion { } {
ed3ef339
DE
104 global srcfile testfile hex decimal
105
a7ed4ea6
AB
106 # Start with a fresh gdb.
107 clean_restart ${testfile}
108
109 if ![gdb_guile_runto_main] {
110 return
ed3ef339 111 }
a7ed4ea6
AB
112
113 # Test breakpoints are deleted correctly.
114 set deltst_location [gdb_get_line_number "Break at multiply."]
115 set end_location [gdb_get_line_number "Break at end."]
116 gdb_scm_test_silent_cmd "guile (define dp1 (make-breakpoint \"$deltst_location\"))" \
117 "create deltst breakpoint"
118 gdb_scm_test_silent_cmd "guile (register-breakpoint! dp1)" \
119 "register dp1"
120 gdb_breakpoint [gdb_get_line_number "Break at end."]
121 gdb_scm_test_silent_cmd "guile (define del-list (breakpoints))" \
122 "get breakpoint list 4"
123 gdb_test "guile (print (length del-list))" \
124 "= 3" "number of breakpoints before delete"
125 gdb_continue_to_breakpoint "Break at multiply." \
126 ".*$srcfile:$deltst_location.*"
127 gdb_scm_test_silent_cmd "guile (delete-breakpoint! dp1)" \
128 "delete breakpoint"
129 gdb_test "guile (print (breakpoint-number dp1))" \
130 "ERROR: .*: Invalid object: <gdb:breakpoint> in position 1: #<gdb:breakpoint #-1>.*" \
131 "check breakpoint invalidated"
132 gdb_scm_test_silent_cmd "guile (set! del-list (breakpoints))" \
133 "get breakpoint list 5"
134 gdb_test "guile (print (length del-list))" \
135 "= 2" "number of breakpoints after delete"
136 gdb_continue_to_breakpoint "Break at end." ".*$srcfile:$end_location.*"
ed3ef339
DE
137}
138
a7ed4ea6 139proc_with_prefix test_bkpt_cond_and_cmds { } {
ed3ef339
DE
140 global srcfile testfile hex decimal
141
a7ed4ea6
AB
142 # Start with a fresh gdb.
143 clean_restart ${testfile}
144
145 if ![gdb_guile_runto_main] {
146 return
ed3ef339 147 }
a7ed4ea6
AB
148
149 # Test conditional setting.
150 set bp_location1 [gdb_get_line_number "Break at multiply."]
151 gdb_scm_test_silent_cmd "guile (define bp1 (make-breakpoint \"$bp_location1\"))" \
152 "create multiply breakpoint"
153 gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \
154 "register bp1"
155 gdb_continue_to_breakpoint "Break at multiply, first time"
156 gdb_scm_test_silent_cmd "guile (set-breakpoint-condition! bp1 \"i == 5\")" \
157 "set condition"
158 gdb_test "guile (print (breakpoint-condition bp1))" \
159 "= i == 5" "test condition has been set"
160 gdb_continue_to_breakpoint "Break at multiply, second time"
161 gdb_test "print i" \
162 "5" "test conditional breakpoint stopped after five iterations"
163 gdb_scm_test_silent_cmd "guile (set-breakpoint-condition! bp1 #f)" \
164 "clear condition"
165 gdb_test "guile (print (breakpoint-condition bp1))" \
166 "= #f" "test condition has been removed"
167 gdb_continue_to_breakpoint "Break at multiply, third time"
168 gdb_test "print i" "6" "test breakpoint stopped after six iterations"
169
170 # Test commands.
171 gdb_breakpoint [gdb_get_line_number "Break at add."]
172 set test {commands $bpnum}
173 gdb_test_multiple $test $test { -re "\r\n>$" { pass $test } }
174 set test {print "Command for breakpoint has been executed."}
175 gdb_test_multiple $test $test { -re "\r\n>$" { pass $test } }
176 set test {print result}
177 gdb_test_multiple $test $test { -re "\r\n>$" { pass $test } }
178 gdb_test "end"
179
180 gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
181 "get breakpoint list 6"
182 gdb_test "guile (print (breakpoint-commands (list-ref blist (- (length blist) 1))))" \
183 "print \"Command for breakpoint has been executed.\".*print result"
ed3ef339
DE
184}
185
a7ed4ea6 186proc_with_prefix test_bkpt_invisible { } {
ed3ef339
DE
187 global srcfile testfile hex decimal
188
a7ed4ea6
AB
189 # Start with a fresh gdb.
190 clean_restart ${testfile}
191
192 if ![gdb_guile_runto_main] {
193 return
ed3ef339 194 }
a7ed4ea6
AB
195
196 # Test invisible breakpoints.
197 delete_breakpoints
198 set ibp_location [gdb_get_line_number "Break at multiply."]
199 gdb_scm_test_silent_cmd "guile (define vbp1 (make-breakpoint \"$ibp_location\" #:internal #f))" \
200 "create visible breakpoint"
201 gdb_scm_test_silent_cmd "guile (register-breakpoint! vbp1)" \
202 "register vbp1"
203 gdb_scm_test_silent_cmd "guile (define vbp (car (breakpoints)))" \
204 "get visible breakpoint"
205 gdb_test "guile (print vbp)" \
206 "= #<gdb:breakpoint #2 BP_BREAKPOINT enabled noisy hit:0 ignore:0 @.*scm-breakpoint.c:$ibp_location>" \
207 "check visible bp obj exists"
208 gdb_test "guile (print (breakpoint-location vbp))" \
209 "scm-breakpoint\.c:$ibp_location*" "check visible breakpoint location"
210 gdb_test "guile (print (breakpoint-visible? vbp))" \
211 "= #t" "check breakpoint visibility"
212 gdb_test "info breakpoints" \
213 "scm-breakpoint\.c:$ibp_location.*" \
214 "check info breakpoints shows visible breakpoints"
215 delete_breakpoints
216 gdb_scm_test_silent_cmd "guile (define ibp (make-breakpoint \"$ibp_location\" #:internal #t))" \
217 "create invisible breakpoint"
218 gdb_scm_test_silent_cmd "guile (register-breakpoint! ibp)" \
219 "register ibp"
220 gdb_test "guile (print ibp)" \
221 "= #<gdb:breakpoint #-$decimal BP_BREAKPOINT enabled noisy hit:0 ignore:0 @.*scm-breakpoint.c:$ibp_location>" \
222 "check invisible bp obj exists"
223 gdb_test "guile (print (breakpoint-location ibp))" \
224 "scm-breakpoint\.c:$ibp_location*" "check invisible breakpoint location"
225 gdb_test "guile (print (breakpoint-visible? ibp))" \
226 "= #f" "check breakpoint invisibility"
227 gdb_test "info breakpoints" \
228 "No breakpoints or watchpoints.*" \
229 "check info breakpoints does not show invisible breakpoints"
230 gdb_test "maint info breakpoints" \
231 "scm-breakpoint\.c:$ibp_location.*" \
232 "check maint info breakpoints shows invisible breakpoints"
ed3ef339
DE
233}
234
a7ed4ea6 235proc_with_prefix test_watchpoints { } {
ed3ef339
DE
236 global srcfile testfile hex decimal
237
a7ed4ea6
AB
238 # Start with a fresh gdb.
239 clean_restart ${testfile}
240
241 # Disable hardware watchpoints if necessary.
242 if [target_info exists gdb,no_hardware_watchpoints] {
243 gdb_test_no_output "set can-use-hw-watchpoints 0" ""
244 }
245 if ![gdb_guile_runto_main] {
246 return
ed3ef339 247 }
a7ed4ea6
AB
248
249 gdb_scm_test_silent_cmd "guile (define wp1 (make-breakpoint \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE))" \
250 "create watchpoint"
0618ecf6
AB
251 gdb_test "guile (display wp1) (newline)" "#<gdb:breakpoint #-1>" \
252 "print watchpoint before registering"
a7ed4ea6
AB
253 gdb_scm_test_silent_cmd "guile (register-breakpoint! wp1)" \
254 "register wp1"
0618ecf6
AB
255 gdb_test "guile (display wp1) (newline)" \
256 "#<gdb:breakpoint #${decimal} BP_(?:HARDWARE_)?WATCHPOINT enabled noisy hit:0 ignore:0>" \
257 "print watchpoint after registering"
a7ed4ea6
AB
258 gdb_test "continue" \
259 ".*\[Ww\]atchpoint.*result.*Old value = 0.*New value = 25.*main.*" \
260 "test watchpoint write"
81b327aa
AB
261
262 gdb_test "guile (define wp2 (make-breakpoint \"result\" #:wp-class WP_WRITE #:type 999))" \
6bbe1a92 263 "(ERROR: )?In procedure gdbscm_make_breakpoint: Out of range: invalid breakpoint type in position 5: 999\r\n.*" \
81b327aa
AB
264 "create a breakpoint with an invalid type number"
265 gdb_test "guile (define wp2 (make-breakpoint \"result\" #:wp-class WP_WRITE #:type BP_NONE))" \
6bbe1a92 266 "(ERROR: )?In procedure gdbscm_make_breakpoint: unsupported breakpoint type in position 5: \"BP_NONE\"\r\n.*" \
81b327aa 267 "create a breakpoint with an unsupported type"
ed3ef339
DE
268}
269
a7ed4ea6 270proc_with_prefix test_bkpt_internal { } {
ed3ef339
DE
271 global srcfile testfile hex decimal
272
a7ed4ea6
AB
273 # Start with a fresh gdb.
274 clean_restart ${testfile}
275
276 # Disable hardware watchpoints if necessary.
277 if [target_info exists gdb,no_hardware_watchpoints] {
278 gdb_test_no_output "set can-use-hw-watchpoints 0" ""
ed3ef339 279 }
a7ed4ea6
AB
280 if ![gdb_guile_runto_main] {
281 return
282 }
283
284 delete_breakpoints
285
286 gdb_scm_test_silent_cmd "guile (define wp1 (make-breakpoint \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE #:internal #t))" \
287 "create invisible watchpoint"
288 gdb_scm_test_silent_cmd "guile (register-breakpoint! wp1)" \
289 "register wp1"
290 gdb_test "info breakpoints" \
291 "No breakpoints or watchpoints.*" \
292 "check info breakpoints does not show invisible watchpoint"
293 gdb_test "maint info breakpoints" \
294 ".*watchpoint.*result.*" \
295 "check maint info breakpoints shows invisible watchpoint"
296 gdb_test "continue" \
297 ".*\[Ww\]atchpoint.*result.*Old value = 0.*New value = 25.*" \
298 "test invisible watchpoint write"
ed3ef339
DE
299}
300
a7ed4ea6 301proc_with_prefix test_bkpt_eval_funcs { } {
ed3ef339
DE
302 global srcfile testfile hex decimal
303
a7ed4ea6
AB
304 # Start with a fresh gdb.
305 clean_restart ${testfile}
306
307 # Disable hardware watchpoints if necessary.
308 if [target_info exists gdb,no_hardware_watchpoints] {
309 gdb_test_no_output "set can-use-hw-watchpoints 0" ""
ed3ef339 310 }
a7ed4ea6
AB
311 if ![gdb_guile_runto_main] {
312 return
313 }
314
315 delete_breakpoints
316
317 # Define create-breakpoint! as a convenient wrapper around
318 # make-breakpoint, register-breakpoint!
319 gdb_test_no_output "guile (define (create-breakpoint! . args) (let ((bp (apply make-breakpoint args))) (register-breakpoint! bp) bp))" \
320 "define create-breakpoint!"
321
322 gdb_test_multiline "data collection breakpoint 1" \
323 "guile" "" \
324 "(define (make-bp-data) (cons 0 0))" "" \
325 "(define bp-data-count car)" "" \
326 "(define set-bp-data-count! set-car!)" "" \
327 "(define bp-data-inf-i cdr)" "" \
328 "(define set-bp-data-inf-i! set-cdr!)" "" \
329 "(define (bp-eval-count bkpt) (bp-data-count (object-property bkpt 'bp-data)))" "" \
330 "(define (bp-eval-inf-i bkpt) (bp-data-inf-i (object-property bkpt 'bp-data)))" "" \
331 "(define (make-bp-eval location)" "" \
332 " (let ((bp (create-breakpoint! location)))" "" \
333 " (set-object-property! bp 'bp-data (make-bp-data))" "" \
334 " (set-breakpoint-stop! bp" "" \
335 " (lambda (bkpt)" "" \
336 " (let ((data (object-property bkpt 'bp-data))" "" \
337 " (inf-i (parse-and-eval \"i\")))" "" \
338 " (set-bp-data-count! data (+ (bp-data-count data) 1))" "" \
339 " (set-bp-data-inf-i! data inf-i)" "" \
340 " (value=? inf-i 3))))" "" \
341 " bp))" "" \
342 "end" ""
343
344 gdb_test_multiline "data collection breakpoint 2" \
345 "guile" "" \
346 "(define (make-bp-also-eval location)" "" \
347 " (let ((bp (create-breakpoint! location)))" "" \
348 " (set-object-property! bp 'bp-data (make-bp-data))" "" \
349 " (set-breakpoint-stop! bp" "" \
350 " (lambda (bkpt)" "" \
351 " (let* ((data (object-property bkpt 'bp-data))" "" \
352 " (count (+ (bp-data-count data) 1)))" "" \
353 " (set-bp-data-count! data count)" "" \
354 " (= count 9))))" "" \
355 " bp))" "" \
356 "end" ""
357
358 gdb_test_multiline "data collection breakpoint 3" \
359 "guile" "" \
360 "(define (make-bp-basic location)" "" \
361 " (let ((bp (create-breakpoint! location)))" "" \
362 " (set-object-property! bp 'bp-data (make-bp-data))" "" \
363 " bp))" "" \
364 "end" ""
365
366 set bp_location2 [gdb_get_line_number "Break at multiply."]
367 set end_location [gdb_get_line_number "Break at end."]
368 gdb_scm_test_silent_cmd "guile (define eval-bp1 (make-bp-eval \"$bp_location2\"))" \
369 "create eval-bp1 breakpoint"
370 gdb_scm_test_silent_cmd "guile (define also-eval-bp1 (make-bp-also-eval \"$bp_location2\"))" \
371 "create also-eval-bp1 breakpoint"
372 gdb_scm_test_silent_cmd "guile (define never-eval-bp1 (make-bp-also-eval \"$end_location\"))" \
373 "create never-eval-bp1 breakpoint"
374 gdb_continue_to_breakpoint "Break at multiply, first time" \
375 ".*$srcfile:$bp_location2.*"
376 gdb_test "print i" "3" "check inferior value matches guile accounting"
377 gdb_test "guile (print (bp-eval-inf-i eval-bp1))" \
378 "= 3" "check guile accounting matches inferior"
379 gdb_test "guile (print (bp-eval-count also-eval-bp1))" \
380 "= 4" \
381 "check non firing same-location breakpoint eval function was also called at each stop 1"
382 gdb_test "guile (print (bp-eval-count eval-bp1))" \
383 "= 4" \
384 "check non firing same-location breakpoint eval function was also called at each stop 2"
385
386 # Check we cannot assign a condition to a breakpoint with a stop-func,
387 # and cannot assign a stop-func to a breakpoint with a condition.
388
389 delete_breakpoints
390 set cond_bp [gdb_get_line_number "Break at multiply."]
391 gdb_scm_test_silent_cmd "guile (define eval-bp1 (make-bp-eval \"$cond_bp\"))" \
392 "create eval-bp1 breakpoint 2"
393 set test_cond {cond $bpnum}
394 gdb_test "$test_cond \"foo==3\"" \
395 "Only one stop condition allowed.*"
396 gdb_scm_test_silent_cmd "guile (define eval-bp2 (make-bp-basic \"$cond_bp\"))" \
397 "create basic breakpoint"
398 gdb_scm_test_silent_cmd "guile (set-breakpoint-condition! eval-bp2 \"1==1\")" \
399 "set a condition"
400 gdb_test_multiline "construct an eval function" \
401 "guile" "" \
402 "(define (stop-func bkpt)" "" \
403 " return #t)" "" \
404 "end" ""
405 gdb_test "guile (set-breakpoint-stop! eval-bp2 stop-func)" \
406 "Only one stop condition allowed.*"
407
408 # Check that stop-func is run when location has normal bp.
409
410 delete_breakpoints
411 gdb_breakpoint [gdb_get_line_number "Break at multiply."]
412 gdb_scm_test_silent_cmd "guile (define check-eval (make-bp-eval \"$bp_location2\"))" \
413 "create check-eval breakpoint"
414 gdb_test "guile (print (bp-eval-count check-eval))" \
415 "= 0" \
416 "test that evaluate function has not been yet executed (ie count = 0)"
417 gdb_continue_to_breakpoint "Break at multiply, second time" \
418 ".*$srcfile:$bp_location2.*"
419 gdb_test "guile (print (bp-eval-count check-eval))" \
420 "= 1" \
421 "test that evaluate function is run when location also has normal bp"
422
423 # Test watchpoints with stop-func.
424
425 gdb_test_multiline "watchpoint stop func" \
426 "guile" "" \
427 "(define (make-wp-eval location)" "" \
428 " (let ((wp (create-breakpoint! location #:type BP_WATCHPOINT #:wp-class WP_WRITE)))" "" \
429 " (set-breakpoint-stop! wp" "" \
430 " (lambda (bkpt)" "" \
431 " (let ((result (parse-and-eval \"result\")))" "" \
432 " (value=? result 788))))" "" \
433 " wp))" "" \
434 "end" ""
435
436 delete_breakpoints
437 gdb_scm_test_silent_cmd "guile (define wp1 (make-wp-eval \"result\"))" \
438 "create watchpoint"
439 gdb_test "continue" ".*\[Ww\]atchpoint.*result.*Old value =.*New value = 788.*" \
440 "test watchpoint write"
441
442 # Misc final tests.
443
444 gdb_test "guile (print (bp-eval-count never-eval-bp1))" \
445 "= 0" \
446 "check that this unrelated breakpoints eval function was never called"
ed3ef339
DE
447}
448
a7ed4ea6 449proc_with_prefix test_bkpt_registration {} {
16f691fb
DE
450 global srcfile testfile
451
a7ed4ea6
AB
452 # Start with a fresh gdb.
453 clean_restart ${testfile}
454
455 if ![gdb_guile_runto_main] {
456 return
16f691fb 457 }
a7ed4ea6
AB
458
459 # Initially there should be one breakpoint: main.
460 gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
461 "get breakpoint list 1"
462 gdb_test "guile (register-breakpoint! (car blist))" \
463 "ERROR: .*: not a Scheme breakpoint.*" \
464 "try to register a non-guile breakpoint"
465
466 set bp_location1 [gdb_get_line_number "Break at multiply."]
467 gdb_scm_test_silent_cmd "guile (define bp1 (make-breakpoint \"$bp_location1\"))" \
468 "create multiply breakpoint"
469 gdb_test "guile (print (breakpoint-valid? bp1))" \
470 "= #f" "breakpoint invalid after creation"
471 gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \
472 "register bp1"
473 gdb_test "guile (print (breakpoint-valid? bp1))" \
474 "= #t" "breakpoint valid after registration"
475 gdb_test "guile (register-breakpoint! bp1)" \
476 "ERROR: .*: breakpoint is already registered.*" \
477 "re-register already registered bp1"
478 gdb_scm_test_silent_cmd "guile (delete-breakpoint! bp1)" \
479 "delete registered breakpoint"
480 gdb_test "guile (print (breakpoint-valid? bp1))" \
481 "= #f" "breakpoint invalid after deletion"
482 gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \
483 "re-register bp1"
484 gdb_test "guile (print (breakpoint-valid? bp1))" \
485 "= #t" "breakpoint valid after re-registration"
16f691fb
DE
486}
487
a7ed4ea6 488proc_with_prefix test_bkpt_address {} {
a96e36da
KS
489 global decimal srcfile
490
491 # Leading whitespace is intentional!
492 gdb_scm_test_silent_cmd \
493 "guile (define bp1 (make-breakpoint \" *multiply\"))" \
494 "create address breakpoint a ' *multiply'" 1
495
496 gdb_test "guile (register-breakpoint! bp1)" \
497 ".*Breakpoint ($decimal)+ at .*$srcfile, line ($decimal)+\."
498}
499
a7ed4ea6 500proc_with_prefix test_bkpt_probe {} {
bac7c5cf
GB
501 global decimal hex testfile srcfile
502
503 if { [prepare_for_testing "failed to prepare" ${testfile}-probes \
504 ${srcfile} {additional_flags=-DUSE_PROBES}] } {
505 return -1
506 }
507
508 if ![gdb_guile_runto_main] then {
509 return
510 }
511
512 gdb_scm_test_silent_cmd \
513 "guile (define bp1 (make-breakpoint \"-probe test:result_updated\"))" \
514 "create probe breakpoint"
515
516 gdb_test \
517 "guile (register-breakpoint! bp1)" \
518 "Breakpoint $decimal at $hex" \
519 "register probe breakpoint"
520}
521
08080f97
AB
522proc_with_prefix test_catchpoints {} {
523 global srcfile testfile
524 global gdb_prompt decimal
525
526 # Start with a fresh gdb.
527 clean_restart ${testfile}
528
529 if ![gdb_guile_runto_main] {
530 return
531 }
532
533 # Try to create a catchpoint, currently this isn't supported via
534 # the guile api.
535 gdb_test "guile (define cp (make-breakpoint \"syscall\" #:type BP_CATCHPOINT))" \
6bbe1a92 536 "(ERROR: )?In procedure gdbscm_make_breakpoint: unsupported breakpoint type in position 3: \"BP_CATCHPOINT\"\r\n.*" \
08080f97
AB
537 "create a catchpoint via the api"
538
539 # Setup a catchpoint.
540 set num "XXX"
541 gdb_test_multiple "catch syscall" "" {
542 -re "The feature \'catch syscall\' is not supported.*\r\n$gdb_prompt $" {
543 unsupported "catch syscall isn't supported"
544 return -1
545 }
546 -re "Catchpoint ($decimal) \\(any syscall\\)\r\n$gdb_prompt $" {
547 set num $expect_out(1,string)
548 pass $gdb_test_name
549 }
550 }
551
552 # Look for the catchpoint in the breakpoint list.
553 gdb_test "guile (for-each (lambda (b) (if (= (breakpoint-type b) BP_CATCHPOINT) (begin (display b) (newline)))) (breakpoints))" \
554 "#<gdb:breakpoint #${num} BP_CATCHPOINT enabled noisy hit:0 ignore:0>" \
555 "look for BP_CATCHPOINT in breakpoint list"
556}
557
ed3ef339
DE
558test_bkpt_basic
559test_bkpt_deletion
560test_bkpt_cond_and_cmds
561test_bkpt_invisible
08080f97 562test_catchpoints
ed3ef339
DE
563test_watchpoints
564test_bkpt_internal
565test_bkpt_eval_funcs
16f691fb 566test_bkpt_registration
a96e36da 567test_bkpt_address
bac7c5cf 568test_bkpt_probe