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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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"