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)))))
40 (defun test-step-into ()
42 (expected '(("(< X 2)" :unknown)
52 ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown)
56 ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown)))
57 (*stepper-hook* (lambda (condition)
60 (push (list (step-condition-form condition)
61 (step-condition-args condition))
63 (invoke-restart 'step-into))))))
65 (assert (equal expected (reverse results)))))
67 (defun test-step-next ()
69 (expected '(("(< X 2)" :unknown)
77 ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown)
80 ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown)))
82 (*stepper-hook* (lambda (condition)
85 (push (list (step-condition-form condition)
86 (step-condition-args condition))
88 (if (< (incf count) 4)
89 (invoke-restart 'step-into)
90 (invoke-restart 'step-next)))))))
92 (assert (equal expected (reverse results)))))
94 (defun test-step-out ()
96 (expected '(("(< X 2)" :unknown)
101 ("(FIB (- X 2))" (1))
103 ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown)))
105 (*stepper-hook* (lambda (condition)
108 (push (list (step-condition-form condition)
109 (step-condition-args condition))
111 (if (= (incf count) 4)
112 (invoke-restart 'step-out)
113 (invoke-restart 'step-into)))))))
115 (assert (equal expected (reverse results)))))
117 (defun test-step-start-from-break ()
119 (expected '(("(- X 2)" :unknown)
120 ("(FIB-BREAK (- X 2))" (0))
122 ("(+ (FIB-BREAK (1- X)) (FIB-BREAK (- X 2)))" :unknown)
124 ("(FIB-BREAK (- X 2))" (1))
126 ("(+ (FIB-BREAK (1- X)) (FIB-BREAK (- X 2)))" :unknown)))
128 (*stepper-hook* (lambda (condition)
131 (push (list (step-condition-form condition)
132 (step-condition-args condition))
134 (invoke-restart 'step-into))))))
135 (setf *cerror-called* nil)
136 (handler-bind ((error
138 (sb-impl::enable-stepping)
139 (invoke-restart 'continue))))
141 (assert (equal expected (reverse results)))))
143 (defun test-step-frame ()
145 (*stepper-hook* (lambda (condition)
148 (let* ((frame (sb-di::find-stepped-frame))
149 (dfun (sb-di::frame-debug-fun frame))
150 (name (sb-di::debug-fun-name dfun)))
151 (assert (equal name 'fib))
153 (invoke-restart 'step-next)))))))
155 (assert (= count 6))))
157 (defun test-step-backtrace ()
158 (let* ((*stepper-hook* (lambda (condition)
161 (let ((*debug-io* (make-broadcast-stream)))
165 (with-test (:name :step-into)
166 (handler-bind ((step-condition (lambda (c)
167 (funcall *stepper-hook* c))))
170 (with-test (:name :step-next)
171 (handler-bind ((step-condition (lambda (c)
172 (funcall *stepper-hook* c))))
175 (with-test (:name :step-out)
176 (handler-bind ((step-condition (lambda (c)
177 (funcall *stepper-hook* c))))
180 (with-test (:name :step-start-from-break)
181 (handler-bind ((step-condition (lambda (c)
182 (funcall *stepper-hook* c))))
183 (test-step-start-from-break)))
185 (with-test (:name :step-frame)
186 (handler-bind ((step-condition (lambda (c)
187 (funcall *stepper-hook* c))))
190 (with-test (:name :step-backtrace)
191 (handler-bind ((step-condition (lambda (c)
192 (funcall *stepper-hook* c))))
193 (test-step-backtrace)))