]>
Commit | Line | Data |
---|---|---|
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 | ||
19 | load_lib gdb-guile.exp | |
20 | ||
21 | standard_testfile | |
22 | ||
5b362f04 | 23 | if { [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. | |
28 | if { [skip_guile_tests] } { continue } | |
29 | ||
a7ed4ea6 | 30 | proc_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 | 103 | proc_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 | 139 | proc_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 | 186 | proc_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 | 235 | proc_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 | 270 | proc_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 | 301 | proc_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 | 449 | proc_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 | 488 | proc_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 | 500 | proc_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 |
522 | proc_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 |
558 | test_bkpt_basic |
559 | test_bkpt_deletion | |
560 | test_bkpt_cond_and_cmds | |
561 | test_bkpt_invisible | |
08080f97 | 562 | test_catchpoints |
ed3ef339 DE |
563 | test_watchpoints |
564 | test_bkpt_internal | |
565 | test_bkpt_eval_funcs | |
16f691fb | 566 | test_bkpt_registration |
a96e36da | 567 | test_bkpt_address |
bac7c5cf | 568 | test_bkpt_probe |