From: Juho Snellman Date: Mon, 2 Oct 2006 14:43:16 +0000 (+0000) Subject: 0.9.17.7: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;ds=sidebyside;h=1a3143cca7d6678c094b6bacc485e8531808ea59;p=sbcl.git 0.9.17.7: Implementation of STEP-OUT was completely bogus. * Only do the *STEP-OUT* binding / handling only around the STEP-INTO branch in the step-around wrapper, not around the STEP-NEXT / CONTINUE / OUT branch. * Detect attempts to STEP-OUT when there is no matching STEP-IN also in STEP-FORM, not just in the debugger repl * Test --- diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 6a7692a..3145358 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -3320,7 +3320,7 @@ register." (let ((context (sb!alien:sap-alien context-sap (* os-context-t)))) ;; The following calls must get tail-call eliminated for - ;; *STEP-FRAME* to get set correctly. + ;; *STEP-FRAME* to get set correctly on non-x86. (if (= kind single-step-before-trap) (handle-single-step-before-trap context) (handle-single-step-around-trap context callee-register-offset)))) @@ -3375,29 +3375,33 @@ register." (fdefn (fdefn-fun callee)) (function callee)) args))) - (let ((sb!impl::*step-out* :maybe)) - (unwind-protect - ;; Signal a step condition - (let* ((step-in - (let ((*step-frame* (frame-down (top-frame)))) - (sb!impl::step-form step-info args)))) - ;; And proceed based on its return value. - (if step-in - ;; If STEP-INTO was selected we pass - ;; the return values to STEP-VALUES which - ;; will show the return value. + ;; Signal a step condition + (let* ((step-in + (let ((*step-frame* (frame-down (top-frame)))) + (sb!impl::step-form step-info args)))) + ;; And proceed based on its return value. + (if step-in + ;; STEP-INTO was selected. Use *STEP-OUT* to + ;; let the stepper know that selecting the + ;; STEP-OUT restart is valid inside this + (let ((sb!impl::*step-out* :maybe)) + ;; Pass the return values of the call to + ;; STEP-VALUES, which will signal a + ;; condition with them in the VALUES slot. + (unwind-protect (multiple-value-call #'sb!impl::step-values step-info (call)) - ;; If STEP-NEXT or STEP-CONTINUE was - ;; selected we disable the stepper for - ;; the duration of the call. - (sb!impl::with-stepping-disabled - (call)))) - ;; If the use selected the STEP-OUT restart - ;; somewhere during the call, resume stepping - (when (eq sb!impl::*step-out* t) - (sb!impl::enable-stepping))))))) + ;; If the user selected the STEP-OUT + ;; restart during the call, resume + ;; stepping + (when (eq sb!impl::*step-out* t) + (sb!impl::enable-stepping)))) + ;; STEP-NEXT / CONTINUE / OUT selected: + ;; Disable the stepper for the duration of + ;; the call. + (sb!impl::with-stepping-disabled + (call))))))) (new-callee (etypecase callee (fdefn (let ((fdefn (make-fdefn (gensym)))) diff --git a/src/code/step.lisp b/src/code/step.lisp index 8d1affe..9d63d34 100644 --- a/src/code/step.lisp +++ b/src/code/step.lisp @@ -26,8 +26,12 @@ (setf *step-out* nil)) (step-out () :report "Resume stepping after returning from this function" - (disable-stepping) - (setf *step-out* t) + (ecase *step-out* + ((nil) + (error "Can't STEP-OUT: No STEP-IN on the call-stack")) + ((t :maybe) + (disable-stepping) + (setf *step-out* t))) nil) (step-next () :report "Step over call" @@ -107,6 +111,7 @@ to be at least partially steppable." `(locally (declare (optimize debug (sb-c:insert-step-conditions 0))) (format t "Single stepping. Type ? for help.~%") + ;; Allow stepping out of the STEP form. (let ((*step-out* :maybe)) (unwind-protect (with-stepping-enabled diff --git a/tests/step.impure.lisp b/tests/step.impure.lisp index 652ad2a..afa3281 100644 --- a/tests/step.impure.lisp +++ b/tests/step.impure.lisp @@ -37,6 +37,17 @@ (+ (fib-break (1- x)) (fib-break (- x 2))))) +(defun in () + (declare (optimize debug)) + (print 1) + (print 2) + (print 3) + (print 4)) + +(defun out () + (declare (optimize debug)) + (in)) + (defun test-step-into () (let* ((results nil) (expected '(("(< X 2)" :unknown) @@ -162,32 +173,73 @@ (backtrace))))))) (step (fib 3)))) +(defun test-step-next/2 () + (let* ((results nil) + (expected '(("(IN)" ()) + ("(PRINT 1)" (1)) + ("(PRINT 2)" (2)) + ("(PRINT 3)" (3)) + ("(PRINT 4)" (4)))) + (count 0) + (*stepper-hook* (lambda (condition) + (typecase condition + (step-form-condition + (push (list (step-condition-form condition) + (step-condition-args condition)) + results) + (if (>= (incf count) 3) + (invoke-restart 'step-into) + (invoke-restart 'step-into))))))) + (step (out)) + (assert (equal expected (reverse results))))) + +(defun test-step-out/2 () + (let* ((results nil) + (expected '(("(IN)" ()) + ("(PRINT 1)" (1)) + ("(PRINT 2)" (2)))) + (count 0) + (*stepper-hook* (lambda (condition) + (typecase condition + (step-form-condition + (push (list (step-condition-form condition) + (step-condition-args condition)) + results) + (if (>= (incf count) 3) + (invoke-restart 'step-out) + (invoke-restart 'step-into))))))) + (step (out)) + (assert (equal expected (reverse results))))) + (with-test (:name :step-into) - (handler-bind ((step-condition (lambda (c) - (funcall *stepper-hook* c)))) + (handler-bind ((step-condition #'sb-impl::invoke-stepper)) (test-step-into))) (with-test (:name :step-next) - (handler-bind ((step-condition (lambda (c) - (funcall *stepper-hook* c)))) + (handler-bind ((step-condition #'sb-impl::invoke-stepper)) (test-step-next))) (with-test (:name :step-out) - (handler-bind ((step-condition (lambda (c) - (funcall *stepper-hook* c)))) + (handler-bind ((step-condition #'sb-impl::invoke-stepper)) (test-step-out))) (with-test (:name :step-start-from-break) - (handler-bind ((step-condition (lambda (c) - (funcall *stepper-hook* c)))) + (handler-bind ((step-condition #'sb-impl::invoke-stepper)) (test-step-start-from-break))) (with-test (:name :step-frame) - (handler-bind ((step-condition (lambda (c) - (funcall *stepper-hook* c)))) + (handler-bind ((step-condition #'sb-impl::invoke-stepper)) (test-step-frame))) (with-test (:name :step-backtrace) - (handler-bind ((step-condition (lambda (c) - (funcall *stepper-hook* c)))) + (handler-bind ((step-condition #'sb-impl::invoke-stepper)) (test-step-backtrace))) + +(with-test (:name :step-next/2) + (handler-bind ((step-condition #'sb-impl::invoke-stepper)) + (test-step-next/2))) + +(with-test (:name :step-out/2) + (handler-bind ((step-condition #'sb-impl::invoke-stepper)) + (test-step-out/2))) + diff --git a/version.lisp-expr b/version.lisp-expr index 5d740d2..bea0f7c 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.17.6" +"0.9.17.7"