]>
Commit | Line | Data |
---|---|---|
e2882c85 | 1 | # Copyright (C) 2010-2018 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 | ||
30 | proc test_bkpt_basic { } { | |
31 | global srcfile testfile hex decimal | |
32 | ||
33 | with_test_prefix "test_bkpt_basic" { | |
34 | # Start with a fresh gdb. | |
35 | clean_restart ${testfile} | |
36 | ||
37 | if ![gdb_guile_runto_main] { | |
38 | return | |
39 | } | |
40 | ||
41 | # Initially there should be one breakpoint: main. | |
42 | ||
43 | gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \ | |
44 | "get breakpoint list 1" | |
45 | gdb_test "guile (print (car blist))" \ | |
46 | "<gdb:breakpoint #1 BP_BREAKPOINT enabled noisy hit:1 ignore:0 @main>" \ | |
47 | "check main breakpoint" | |
48 | gdb_test "guile (print (breakpoint-location (car blist)))" \ | |
49 | "main" "check main breakpoint location" | |
50 | ||
51 | set mult_line [gdb_get_line_number "Break at multiply."] | |
52 | gdb_breakpoint ${mult_line} | |
53 | gdb_continue_to_breakpoint "Break at multiply." | |
54 | ||
55 | # Check that the Guile breakpoint code noted the addition of a | |
56 | # breakpoint "behind the scenes". | |
57 | gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \ | |
58 | "get breakpoint list 2" | |
59 | gdb_scm_test_silent_cmd "guile (define mult-bkpt (cadr blist))" \ | |
60 | "get multiply breakpoint" | |
61 | gdb_test "guile (print (length blist))" \ | |
62 | "= 2" "check for two breakpoints" | |
63 | gdb_test "guile (print mult-bkpt)" \ | |
64 | "= #<gdb:breakpoint #2 BP_BREAKPOINT enabled noisy hit:1 ignore:0 @.*scm-breakpoint.c:$mult_line>" \ | |
65 | "check multiply breakpoint" | |
66 | gdb_test "guile (print (breakpoint-location mult-bkpt))" \ | |
67 | "scm-breakpoint\.c:${mult_line}*" \ | |
68 | "check multiply breakpoint location" | |
69 | ||
70 | # Check hit and ignore counts. | |
71 | gdb_test "guile (print (breakpoint-hit-count mult-bkpt))" \ | |
72 | "= 1" "check multiply breakpoint hit count" | |
73 | gdb_scm_test_silent_cmd "guile (set-breakpoint-ignore-count! mult-bkpt 4)" \ | |
74 | "set multiply breakpoint ignore count" | |
75 | gdb_continue_to_breakpoint "Break at multiply." | |
76 | gdb_test "guile (print (breakpoint-hit-count mult-bkpt))" \ | |
77 | "= 6" "check multiply breakpoint hit count 2" | |
78 | gdb_test "print result" \ | |
79 | " = 545" "check expected variable result after 6 iterations" | |
80 | ||
81 | # Test breakpoint is enabled and disabled correctly. | |
82 | gdb_breakpoint [gdb_get_line_number "Break at add."] | |
83 | gdb_continue_to_breakpoint "Break at add." | |
84 | gdb_test "guile (print (breakpoint-enabled? mult-bkpt))" \ | |
85 | "= #t" "check multiply breakpoint enabled" | |
86 | gdb_scm_test_silent_cmd "guile (set-breakpoint-enabled! mult-bkpt #f)" \ | |
87 | "set multiply breakpoint disabled" | |
88 | gdb_continue_to_breakpoint "Break at add." | |
89 | gdb_scm_test_silent_cmd "guile (set-breakpoint-enabled! mult-bkpt #t)" \ | |
90 | "set multiply breakpoint enabled" | |
91 | gdb_continue_to_breakpoint "Break at multiply." | |
92 | ||
93 | # Test other getters and setters. | |
94 | gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \ | |
95 | "get breakpoint list 3" | |
96 | gdb_test "guile (print (breakpoint-thread mult-bkpt))" \ | |
97 | "= #f" "check breakpoint thread" | |
98 | gdb_test "guile (print (= (breakpoint-type mult-bkpt) BP_BREAKPOINT))" \ | |
99 | "= #t" "check breakpoint type" | |
100 | gdb_test "guile (print (map breakpoint-number blist))" \ | |
101 | "= \\(1 2 3\\)" "check breakpoint numbers" | |
102 | } | |
103 | } | |
104 | ||
105 | proc test_bkpt_deletion { } { | |
106 | global srcfile testfile hex decimal | |
107 | ||
108 | with_test_prefix test_bkpt_deletion { | |
109 | # Start with a fresh gdb. | |
110 | clean_restart ${testfile} | |
111 | ||
112 | if ![gdb_guile_runto_main] { | |
113 | return | |
114 | } | |
115 | ||
116 | # Test breakpoints are deleted correctly. | |
117 | set deltst_location [gdb_get_line_number "Break at multiply."] | |
118 | set end_location [gdb_get_line_number "Break at end."] | |
16f691fb | 119 | gdb_scm_test_silent_cmd "guile (define dp1 (make-breakpoint \"$deltst_location\"))" \ |
ed3ef339 | 120 | "create deltst breakpoint" |
16f691fb DE |
121 | gdb_scm_test_silent_cmd "guile (register-breakpoint! dp1)" \ |
122 | "register dp1" | |
ed3ef339 DE |
123 | gdb_breakpoint [gdb_get_line_number "Break at end."] |
124 | gdb_scm_test_silent_cmd "guile (define del-list (breakpoints))" \ | |
125 | "get breakpoint list 4" | |
126 | gdb_test "guile (print (length del-list))" \ | |
127 | "= 3" "number of breakpoints before delete" | |
128 | gdb_continue_to_breakpoint "Break at multiply." \ | |
a80db015 | 129 | ".*$srcfile:$deltst_location.*" |
16f691fb | 130 | gdb_scm_test_silent_cmd "guile (delete-breakpoint! dp1)" \ |
ed3ef339 DE |
131 | "delete breakpoint" |
132 | gdb_test "guile (print (breakpoint-number dp1))" \ | |
16f691fb | 133 | "ERROR: .*: Invalid object: <gdb:breakpoint> in position 1: #<gdb:breakpoint #-1>.*" \ |
ed3ef339 DE |
134 | "check breakpoint invalidated" |
135 | gdb_scm_test_silent_cmd "guile (set! del-list (breakpoints))" \ | |
136 | "get breakpoint list 5" | |
137 | gdb_test "guile (print (length del-list))" \ | |
138 | "= 2" "number of breakpoints after delete" | |
a80db015 | 139 | gdb_continue_to_breakpoint "Break at end." ".*$srcfile:$end_location.*" |
ed3ef339 DE |
140 | } |
141 | } | |
142 | ||
143 | proc test_bkpt_cond_and_cmds { } { | |
144 | global srcfile testfile hex decimal | |
145 | ||
146 | with_test_prefix test_bkpt_cond_and_cmds { | |
147 | # Start with a fresh gdb. | |
148 | clean_restart ${testfile} | |
149 | ||
150 | if ![gdb_guile_runto_main] { | |
151 | return | |
152 | } | |
153 | ||
154 | # Test conditional setting. | |
155 | set bp_location1 [gdb_get_line_number "Break at multiply."] | |
16f691fb | 156 | gdb_scm_test_silent_cmd "guile (define bp1 (make-breakpoint \"$bp_location1\"))" \ |
ed3ef339 | 157 | "create multiply breakpoint" |
16f691fb DE |
158 | gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \ |
159 | "register bp1" | |
ed3ef339 DE |
160 | gdb_continue_to_breakpoint "Break at multiply." |
161 | gdb_scm_test_silent_cmd "guile (set-breakpoint-condition! bp1 \"i == 5\")" \ | |
162 | "set condition" | |
163 | gdb_test "guile (print (breakpoint-condition bp1))" \ | |
164 | "= i == 5" "test condition has been set" | |
165 | gdb_continue_to_breakpoint "Break at multiply." | |
166 | gdb_test "print i" \ | |
167 | "5" "test conditional breakpoint stopped after five iterations" | |
168 | gdb_scm_test_silent_cmd "guile (set-breakpoint-condition! bp1 #f)" \ | |
169 | "clear condition" | |
170 | gdb_test "guile (print (breakpoint-condition bp1))" \ | |
171 | "= #f" "test condition has been removed" | |
172 | gdb_continue_to_breakpoint "Break at multiply." | |
173 | gdb_test "print i" "6" "test breakpoint stopped after six iterations" | |
174 | ||
175 | # Test commands. | |
176 | gdb_breakpoint [gdb_get_line_number "Break at add."] | |
177 | set test {commands $bpnum} | |
178 | gdb_test_multiple $test $test { -re "\r\n>$" { pass $test } } | |
179 | set test {print "Command for breakpoint has been executed."} | |
180 | gdb_test_multiple $test $test { -re "\r\n>$" { pass $test } } | |
181 | set test {print result} | |
182 | gdb_test_multiple $test $test { -re "\r\n>$" { pass $test } } | |
183 | gdb_test "end" | |
184 | ||
185 | gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \ | |
186 | "get breakpoint list 6" | |
187 | gdb_test "guile (print (breakpoint-commands (list-ref blist (- (length blist) 1))))" \ | |
188 | "print \"Command for breakpoint has been executed.\".*print result" | |
189 | } | |
190 | } | |
191 | ||
192 | proc test_bkpt_invisible { } { | |
193 | global srcfile testfile hex decimal | |
194 | ||
195 | with_test_prefix test_bkpt_invisible { | |
196 | # Start with a fresh gdb. | |
197 | clean_restart ${testfile} | |
198 | ||
199 | if ![gdb_guile_runto_main] { | |
200 | return | |
201 | } | |
202 | ||
203 | # Test invisible breakpoints. | |
204 | delete_breakpoints | |
205 | set ibp_location [gdb_get_line_number "Break at multiply."] | |
16f691fb | 206 | gdb_scm_test_silent_cmd "guile (define vbp1 (make-breakpoint \"$ibp_location\" #:internal #f))" \ |
ed3ef339 | 207 | "create visible breakpoint" |
16f691fb DE |
208 | gdb_scm_test_silent_cmd "guile (register-breakpoint! vbp1)" \ |
209 | "register vbp1" | |
ed3ef339 DE |
210 | gdb_scm_test_silent_cmd "guile (define vbp (car (breakpoints)))" \ |
211 | "get visible breakpoint" | |
212 | gdb_test "guile (print vbp)" \ | |
213 | "= #<gdb:breakpoint #2 BP_BREAKPOINT enabled noisy hit:0 ignore:0 @.*scm-breakpoint.c:$ibp_location>" \ | |
214 | "check visible bp obj exists" | |
215 | gdb_test "guile (print (breakpoint-location vbp))" \ | |
216 | "scm-breakpoint\.c:$ibp_location*" "check visible breakpoint location" | |
217 | gdb_test "guile (print (breakpoint-visible? vbp))" \ | |
218 | "= #t" "check breakpoint visibility" | |
219 | gdb_test "info breakpoints" \ | |
220 | "scm-breakpoint\.c:$ibp_location.*" \ | |
221 | "check info breakpoints shows visible breakpoints" | |
222 | delete_breakpoints | |
16f691fb | 223 | gdb_scm_test_silent_cmd "guile (define ibp (make-breakpoint \"$ibp_location\" #:internal #t))" \ |
ed3ef339 | 224 | "create invisible breakpoint" |
16f691fb DE |
225 | gdb_scm_test_silent_cmd "guile (register-breakpoint! ibp)" \ |
226 | "register ibp" | |
ed3ef339 DE |
227 | gdb_test "guile (print ibp)" \ |
228 | "= #<gdb:breakpoint #-$decimal BP_BREAKPOINT enabled noisy hit:0 ignore:0 @.*scm-breakpoint.c:$ibp_location>" \ | |
229 | "check invisible bp obj exists" | |
230 | gdb_test "guile (print (breakpoint-location ibp))" \ | |
231 | "scm-breakpoint\.c:$ibp_location*" "check invisible breakpoint location" | |
232 | gdb_test "guile (print (breakpoint-visible? ibp))" \ | |
233 | "= #f" "check breakpoint invisibility" | |
234 | gdb_test "info breakpoints" \ | |
235 | "No breakpoints or watchpoints.*" \ | |
236 | "check info breakpoints does not show invisible breakpoints" | |
237 | gdb_test "maint info breakpoints" \ | |
238 | "scm-breakpoint\.c:$ibp_location.*" \ | |
239 | "check maint info breakpoints shows invisible breakpoints" | |
240 | } | |
241 | } | |
242 | ||
243 | proc test_watchpoints { } { | |
244 | global srcfile testfile hex decimal | |
245 | ||
246 | with_test_prefix test_watchpoints { | |
247 | # Start with a fresh gdb. | |
248 | clean_restart ${testfile} | |
249 | ||
250 | # Disable hardware watchpoints if necessary. | |
251 | if [target_info exists gdb,no_hardware_watchpoints] { | |
252 | gdb_test_no_output "set can-use-hw-watchpoints 0" "" | |
253 | } | |
254 | if ![gdb_guile_runto_main] { | |
255 | return | |
256 | } | |
257 | ||
16f691fb | 258 | gdb_scm_test_silent_cmd "guile (define wp1 (make-breakpoint \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE))" \ |
ed3ef339 | 259 | "create watchpoint" |
16f691fb DE |
260 | gdb_scm_test_silent_cmd "guile (register-breakpoint! wp1)" \ |
261 | "register wp1" | |
ed3ef339 DE |
262 | gdb_test "continue" \ |
263 | ".*\[Ww\]atchpoint.*result.*Old value = 0.*New value = 25.*main.*" \ | |
264 | "test watchpoint write" | |
265 | } | |
266 | } | |
267 | ||
268 | proc test_bkpt_internal { } { | |
269 | global srcfile testfile hex decimal | |
270 | ||
271 | with_test_prefix test_bkpt_internal { | |
272 | # Start with a fresh gdb. | |
273 | clean_restart ${testfile} | |
274 | ||
275 | # Disable hardware watchpoints if necessary. | |
276 | if [target_info exists gdb,no_hardware_watchpoints] { | |
277 | gdb_test_no_output "set can-use-hw-watchpoints 0" "" | |
278 | } | |
279 | if ![gdb_guile_runto_main] { | |
280 | return | |
281 | } | |
282 | ||
283 | delete_breakpoints | |
284 | ||
16f691fb | 285 | gdb_scm_test_silent_cmd "guile (define wp1 (make-breakpoint \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE #:internal #t))" \ |
ed3ef339 | 286 | "create invisible watchpoint" |
16f691fb DE |
287 | gdb_scm_test_silent_cmd "guile (register-breakpoint! wp1)" \ |
288 | "register wp1" | |
ed3ef339 DE |
289 | gdb_test "info breakpoints" \ |
290 | "No breakpoints or watchpoints.*" \ | |
291 | "check info breakpoints does not show invisible watchpoint" | |
292 | gdb_test "maint info breakpoints" \ | |
293 | ".*watchpoint.*result.*" \ | |
294 | "check maint info breakpoints shows invisible watchpoint" | |
295 | gdb_test "continue" \ | |
296 | ".*\[Ww\]atchpoint.*result.*Old value = 0.*New value = 25.*" \ | |
297 | "test invisible watchpoint write" | |
298 | } | |
299 | } | |
300 | ||
301 | proc test_bkpt_eval_funcs { } { | |
302 | global srcfile testfile hex decimal | |
303 | ||
304 | with_test_prefix test_bkpt_eval_funcs { | |
305 | # Start with a fresh gdb. | |
306 | clean_restart ${testfile} | |
307 | ||
308 | # Disable hardware watchpoints if necessary. | |
309 | if [target_info exists gdb,no_hardware_watchpoints] { | |
310 | gdb_test_no_output "set can-use-hw-watchpoints 0" "" | |
311 | } | |
312 | if ![gdb_guile_runto_main] { | |
313 | return | |
314 | } | |
315 | ||
316 | delete_breakpoints | |
317 | ||
16f691fb DE |
318 | # Define create-breakpoint! as a convenient wrapper around |
319 | # make-breakpoint, register-breakpoint! | |
320 | gdb_test_no_output "guile (define (create-breakpoint! . args) (let ((bp (apply make-breakpoint args))) (register-breakpoint! bp) bp))" \ | |
321 | "define create-breakpoint!" | |
322 | ||
ed3ef339 DE |
323 | gdb_test_multiline "data collection breakpoint 1" \ |
324 | "guile" "" \ | |
325 | "(define (make-bp-data) (cons 0 0))" "" \ | |
326 | "(define bp-data-count car)" "" \ | |
327 | "(define set-bp-data-count! set-car!)" "" \ | |
328 | "(define bp-data-inf-i cdr)" "" \ | |
329 | "(define set-bp-data-inf-i! set-cdr!)" "" \ | |
b2715b27 AW |
330 | "(define (bp-eval-count bkpt) (bp-data-count (object-property bkpt 'bp-data)))" "" \ |
331 | "(define (bp-eval-inf-i bkpt) (bp-data-inf-i (object-property bkpt 'bp-data)))" "" \ | |
ed3ef339 DE |
332 | "(define (make-bp-eval location)" "" \ |
333 | " (let ((bp (create-breakpoint! location)))" "" \ | |
b2715b27 | 334 | " (set-object-property! bp 'bp-data (make-bp-data))" "" \ |
ed3ef339 DE |
335 | " (set-breakpoint-stop! bp" "" \ |
336 | " (lambda (bkpt)" "" \ | |
b2715b27 | 337 | " (let ((data (object-property bkpt 'bp-data))" "" \ |
ed3ef339 DE |
338 | " (inf-i (parse-and-eval \"i\")))" "" \ |
339 | " (set-bp-data-count! data (+ (bp-data-count data) 1))" "" \ | |
340 | " (set-bp-data-inf-i! data inf-i)" "" \ | |
341 | " (value=? inf-i 3))))" "" \ | |
342 | " bp))" "" \ | |
343 | "end" "" | |
344 | ||
345 | gdb_test_multiline "data collection breakpoint 2" \ | |
346 | "guile" "" \ | |
347 | "(define (make-bp-also-eval location)" "" \ | |
348 | " (let ((bp (create-breakpoint! location)))" "" \ | |
b2715b27 | 349 | " (set-object-property! bp 'bp-data (make-bp-data))" "" \ |
ed3ef339 DE |
350 | " (set-breakpoint-stop! bp" "" \ |
351 | " (lambda (bkpt)" "" \ | |
b2715b27 | 352 | " (let* ((data (object-property bkpt 'bp-data))" "" \ |
ed3ef339 DE |
353 | " (count (+ (bp-data-count data) 1)))" "" \ |
354 | " (set-bp-data-count! data count)" "" \ | |
355 | " (= count 9))))" "" \ | |
356 | " bp))" "" \ | |
357 | "end" "" | |
358 | ||
359 | gdb_test_multiline "data collection breakpoint 3" \ | |
360 | "guile" "" \ | |
361 | "(define (make-bp-basic location)" "" \ | |
362 | " (let ((bp (create-breakpoint! location)))" "" \ | |
b2715b27 | 363 | " (set-object-property! bp 'bp-data (make-bp-data))" "" \ |
ed3ef339 DE |
364 | " bp))" "" \ |
365 | "end" "" | |
366 | ||
367 | set bp_location2 [gdb_get_line_number "Break at multiply."] | |
368 | set end_location [gdb_get_line_number "Break at end."] | |
369 | gdb_scm_test_silent_cmd "guile (define eval-bp1 (make-bp-eval \"$bp_location2\"))" \ | |
370 | "create eval-bp1 breakpoint" | |
371 | gdb_scm_test_silent_cmd "guile (define also-eval-bp1 (make-bp-also-eval \"$bp_location2\"))" \ | |
372 | "create also-eval-bp1 breakpoint" | |
373 | gdb_scm_test_silent_cmd "guile (define never-eval-bp1 (make-bp-also-eval \"$end_location\"))" \ | |
374 | "create never-eval-bp1 breakpoint" | |
a80db015 | 375 | gdb_continue_to_breakpoint "Break at multiply." ".*$srcfile:$bp_location2.*" |
ed3ef339 DE |
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)" | |
a80db015 | 417 | gdb_continue_to_breakpoint "Break at multiply." ".*$srcfile:$bp_location2.*" |
ed3ef339 DE |
418 | gdb_test "guile (print (bp-eval-count check-eval))" \ |
419 | "= 1" \ | |
420 | "test that evaluate function is run when location also has normal bp" | |
421 | ||
422 | # Test watchpoints with stop-func. | |
423 | ||
424 | gdb_test_multiline "watchpoint stop func" \ | |
425 | "guile" "" \ | |
426 | "(define (make-wp-eval location)" "" \ | |
427 | " (let ((wp (create-breakpoint! location #:type BP_WATCHPOINT #:wp-class WP_WRITE)))" "" \ | |
428 | " (set-breakpoint-stop! wp" "" \ | |
429 | " (lambda (bkpt)" "" \ | |
430 | " (let ((result (parse-and-eval \"result\")))" "" \ | |
431 | " (value=? result 788))))" "" \ | |
432 | " wp))" "" \ | |
433 | "end" "" | |
434 | ||
435 | delete_breakpoints | |
436 | gdb_scm_test_silent_cmd "guile (define wp1 (make-wp-eval \"result\"))" \ | |
437 | "create watchpoint" | |
438 | gdb_test "continue" ".*\[Ww\]atchpoint.*result.*Old value =.*New value = 788.*" \ | |
439 | "test watchpoint write" | |
440 | ||
441 | # Misc final tests. | |
442 | ||
443 | gdb_test "guile (print (bp-eval-count never-eval-bp1))" \ | |
444 | "= 0" \ | |
445 | "check that this unrelated breakpoints eval function was never called" | |
446 | } | |
447 | } | |
448 | ||
16f691fb DE |
449 | proc test_bkpt_registration {} { |
450 | global srcfile testfile | |
451 | ||
452 | with_test_prefix "test_bkpt_registration" { | |
453 | # Start with a fresh gdb. | |
454 | clean_restart ${testfile} | |
455 | ||
456 | if ![gdb_guile_runto_main] { | |
457 | return | |
458 | } | |
459 | ||
460 | # Initially there should be one breakpoint: main. | |
461 | gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \ | |
462 | "get breakpoint list 1" | |
463 | gdb_test "guile (register-breakpoint! (car blist))" \ | |
464 | "ERROR: .*: not a Scheme breakpoint.*" \ | |
465 | "try to register a non-guile breakpoint" | |
466 | ||
467 | set bp_location1 [gdb_get_line_number "Break at multiply."] | |
468 | gdb_scm_test_silent_cmd "guile (define bp1 (make-breakpoint \"$bp_location1\"))" \ | |
469 | "create multiply breakpoint" | |
470 | gdb_test "guile (print (breakpoint-valid? bp1))" \ | |
471 | "= #f" "breakpoint invalid after creation" | |
472 | gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \ | |
473 | "register bp1" | |
474 | gdb_test "guile (print (breakpoint-valid? bp1))" \ | |
475 | "= #t" "breakpoint valid after registration" | |
476 | gdb_test "guile (register-breakpoint! bp1)" \ | |
477 | "ERROR: .*: breakpoint is already registered.*" \ | |
478 | "re-register already registered bp1" | |
479 | gdb_scm_test_silent_cmd "guile (delete-breakpoint! bp1)" \ | |
480 | "delete registered breakpoint" | |
481 | gdb_test "guile (print (breakpoint-valid? bp1))" \ | |
482 | "= #f" "breakpoint invalid after deletion" | |
483 | gdb_scm_test_silent_cmd "guile (register-breakpoint! bp1)" \ | |
484 | "re-register bp1" | |
485 | gdb_test "guile (print (breakpoint-valid? bp1))" \ | |
486 | "= #t" "breakpoint valid after re-registration" | |
487 | } | |
488 | } | |
489 | ||
a96e36da KS |
490 | proc test_bkpt_address {} { |
491 | global decimal srcfile | |
492 | ||
493 | # Leading whitespace is intentional! | |
494 | gdb_scm_test_silent_cmd \ | |
495 | "guile (define bp1 (make-breakpoint \" *multiply\"))" \ | |
496 | "create address breakpoint a ' *multiply'" 1 | |
497 | ||
498 | gdb_test "guile (register-breakpoint! bp1)" \ | |
499 | ".*Breakpoint ($decimal)+ at .*$srcfile, line ($decimal)+\." | |
500 | } | |
501 | ||
ed3ef339 DE |
502 | test_bkpt_basic |
503 | test_bkpt_deletion | |
504 | test_bkpt_cond_and_cmds | |
505 | test_bkpt_invisible | |
506 | test_watchpoints | |
507 | test_bkpt_internal | |
508 | test_bkpt_eval_funcs | |
16f691fb | 509 | test_bkpt_registration |
a96e36da | 510 | test_bkpt_address |