Commit 1a3143cc authored by Juho Snellman's avatar Juho Snellman
Browse files

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
parent 9f81202c

src/code/debug-int.lisp

+25 −21
Original line number Diff line number Diff line
@@ -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.

                          ;; 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

                              ;; If the user selected the STEP-OUT

                              ;; restart during the call, resume

                              ;; stepping

                              (when (eq sb!impl::*step-out* t)

                          (sb!impl::enable-stepping)))))))

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

src/code/step.lisp

+7 −2
Original line number Diff line number Diff line
@@ -26,8 +26,12 @@ 
      (setf *step-out* nil))

    (step-out ()

      :report "Resume stepping after returning from this function"

      (ecase *step-out*

        ((nil)

         (error "Can't STEP-OUT: No STEP-IN on the call-stack"))

        ((t :maybe)

         (disable-stepping)

      (setf *step-out* t)

         (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

tests/step.impure.lisp

+64 −12
Original line number Diff line number Diff line
@@ -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)))

version.lisp-expr

+1 −1
Original line number Diff line number Diff line
@@ -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"