1 ;;;; This file is for testing the single-stepper.
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
16 ;; No stepper support on some platforms.
18 (sb-ext:quit :unix-status 104)
21 (declare (optimize debug))
27 (defvar *cerror-called* nil)
30 (declare (optimize debug))
33 (unless *cerror-called*
35 (setf *cerror-called* t))
38 (fib-break (- x 2)))))
41 (declare (optimize debug))
48 (declare (optimize debug))
51 (defun test-step-into ()
53 (expected '(("(< X 2)" :unknown)
63 ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown)
67 ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown)))
68 (*stepper-hook* (lambda (condition)
71 (push (list (step-condition-form condition)
72 (step-condition-args condition))
74 (invoke-restart 'step-into))))))
76 (assert (equal expected (reverse results)))))
78 (defun test-step-next ()
80 (expected '(("(< X 2)" :unknown)
88 ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown)
91 ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown)))
93 (*stepper-hook* (lambda (condition)
96 (push (list (step-condition-form condition)
97 (step-condition-args condition))
99 (if (< (incf count) 4)
100 (invoke-restart 'step-into)
101 (invoke-restart 'step-next)))))))
103 (assert (equal expected (reverse results)))))
105 (defun test-step-out ()
107 (expected '(("(< X 2)" :unknown)
112 ("(FIB (- X 2))" (1))
114 ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown)))
116 (*stepper-hook* (lambda (condition)
119 (push (list (step-condition-form condition)
120 (step-condition-args condition))
122 (if (= (incf count) 4)
123 (invoke-restart 'step-out)
124 (invoke-restart 'step-into)))))))
126 (assert (equal expected (reverse results)))))
128 (defun test-step-start-from-break ()
130 (expected '(("(- X 2)" :unknown)
131 ("(FIB-BREAK (- X 2))" (0))
133 ("(+ (FIB-BREAK (1- X)) (FIB-BREAK (- X 2)))" :unknown)
135 ("(FIB-BREAK (- X 2))" (1))
137 ("(+ (FIB-BREAK (1- X)) (FIB-BREAK (- X 2)))" :unknown)))
139 (*stepper-hook* (lambda (condition)
142 (push (list (step-condition-form condition)
143 (step-condition-args condition))
145 (invoke-restart 'step-into))))))
146 (setf *cerror-called* nil)
147 (handler-bind ((error
149 (sb-impl::enable-stepping)
150 (invoke-restart 'continue))))
152 (assert (equal expected (reverse results)))))
154 (defun test-step-frame ()
156 (*stepper-hook* (lambda (condition)
159 (let* ((frame (sb-di::find-stepped-frame))
160 (dfun (sb-di::frame-debug-fun frame))
161 (name (sb-di::debug-fun-name dfun)))
162 (assert (equal name 'fib))
164 (invoke-restart 'step-next)))))))
166 (assert (= count 6))))
168 (defun test-step-backtrace ()
169 (let* ((*stepper-hook* (lambda (condition)
172 (let ((*debug-io* (make-broadcast-stream)))
176 (defun test-step-next/2 ()
178 (expected '(("(IN)" ())
184 (*stepper-hook* (lambda (condition)
187 (push (list (step-condition-form condition)
188 (step-condition-args condition))
190 (if (>= (incf count) 3)
191 (invoke-restart 'step-into)
192 (invoke-restart 'step-into)))))))
194 (assert (equal expected (reverse results)))))
196 (defun test-step-out/2 ()
198 (expected '(("(IN)" ())
202 (*stepper-hook* (lambda (condition)
205 (push (list (step-condition-form condition)
206 (step-condition-args condition))
208 (if (>= (incf count) 3)
209 (invoke-restart 'step-out)
210 (invoke-restart 'step-into)))))))
212 (assert (equal expected (reverse results)))))
214 (with-test (:name :step-into)
215 (handler-bind ((step-condition #'sb-impl::invoke-stepper))
218 (with-test (:name :step-next)
219 (handler-bind ((step-condition #'sb-impl::invoke-stepper))
222 (with-test (:name :step-out)
223 (handler-bind ((step-condition #'sb-impl::invoke-stepper))
226 (with-test (:name :step-start-from-break)
227 (handler-bind ((step-condition #'sb-impl::invoke-stepper))
228 (test-step-start-from-break)))
230 (with-test (:name :step-frame)
231 (handler-bind ((step-condition #'sb-impl::invoke-stepper))
234 (with-test (:name :step-backtrace)
235 (handler-bind ((step-condition #'sb-impl::invoke-stepper))
236 (test-step-backtrace)))
238 (with-test (:name :step-next/2)
239 (handler-bind ((step-condition #'sb-impl::invoke-stepper))
242 (with-test (:name :step-out/2)
243 (handler-bind ((step-condition #'sb-impl::invoke-stepper))