Implement debugger session and fix continuation

vspinu · bbatsov · commit c2ef5413ddb7 · 2018-10-17T00:13:11.000+02:00
Fix #460, fix clojure-emacs/cider#1869, fix clojure-emacs/cider#2253 fix clojure-emacs/cider#1054
diff --git a/src/cider/nrepl/middleware/debug.clj b/src/cider/nrepl/middleware/debug.clj
@@ -67,9 +67,9 @@
 ;;; Variables and functions used for navigating between breakpoints.
 (def ^:dynamic *skip-breaks*
   "Map used to determine whether to skip a breakpoint.
-  Don't set or examine this directly, it is bound in the session
-  binding map, use `skip-breaks!` and `skip-breaks?` instead.
-  Its value is discarded at the end each eval session."
+  Don't set or examine this directly, it is bound in the session binding map,
+  use `skip-breaks!` and `skip-breaks?` instead. Its value is reset at the
+  beginning each eval session."
   (atom nil))
 
 (defn- random-uuid-str
@@ -90,7 +90,9 @@
   "True if the breakpoint at coordinates should be skipped.
 
   The `*skip-breaks*` map stores a `mode`, `coordinates`, the `code` that it
-  applies to, and a `force?` flag. Behaviour depends on the `mode`:
+  applies to, and a `force?` flag.
+
+  Behaviour depends on the `mode`:
    - :all - return true, skipping all breaks
    - :trace - return false, skip nothing
    - :deeper - return true if the given coordinates are deeper than the
@@ -101,29 +103,30 @@
   For :deeper and :before, if we are not in the same code (i.e. we have stepped
   into another instrumented function and code argument doesn't match old code in
   *skip-breaks*), then return the value of `force?`."
-  [coordinates code]
-  (if (seq coordinates)
-    (when-let [{mode :mode skip-coords :coor
-                code-to-skip :code force? :force?} @*skip-breaks*]
-      (let [same-defn? (identical? code-to-skip code)]
-        (case mode
-          ;; From :continue, skip everything.
-          :all    true
-          ;; From :trace, never skip.
-          :trace  false
-          ;; From :out, skip some breaks.
-          :deeper (if same-defn?
-                    (let [parent (take (count skip-coords) coordinates)]
-                      (and (seq= skip-coords parent)
-                           (> (count coordinates) (count parent))))
-                    force?)
-          ;; From :here, skip some breaks.
-          :before (if same-defn?
-                    (ins/coord< coordinates skip-coords)
-                    force?))))
-    ;; We don't breakpoint top-level sexps, because their return value
-    ;; is already displayed anyway.
-    true))
+  [coor STATE__]
+  (or (and STATE__ @(:skip STATE__))
+      (if (seq coor)
+        (when-let [{mode :mode skip-coords :coor
+                    code-to-skip :code force? :force?} @*skip-breaks*]
+          (let [same-defn? (identical? code-to-skip (get-in STATE__ [:msg :code]))]
+            (case mode
+              ;; From :continue, skip everything.
+              :all    true
+              ;; From :trace, never skip.
+              :trace  false
+              ;; From :out, skip some breaks.
+              :deeper (if same-defn?
+                        (let [parent (take (count skip-coords) coor)]
+                          (and (seq= skip-coords parent)
+                               (> (count coor) (count parent))))
+                        force?)
+              ;; From :here, skip some breaks.
+              :before (if same-defn?
+                        (ins/coord< coor skip-coords)
+                        force?))))
+        ;; We don't breakpoint top-level sexps, because their return value
+        ;; is already displayed anyway.
+        true)))
 
 (defn skip-breaks!
   "Set the value of *skip-breaks* for the top-level breakpoint.
@@ -281,8 +284,6 @@ this map (identified by a key), and will `dissoc` it afterwards."}
    (eval-with-locals (or code (read-debug-input dbg-state :expression prompt))
                      dbg-state)))
 
-(declare read-debug-command)
-
 (defn- debug-inspect
   "Inspect `inspect-value`."
   [page-size inspect-value]
@@ -305,6 +306,7 @@ this map (identified by a key), and will `dissoc` it afterwards."}
 
 (def debug-commands
   {"c" :continue
+   "C" :Continue
    "e" :eval
    "h" :here
    "i" :in
@@ -336,51 +338,58 @@ this map (identified by a key), and will `dissoc` it afterwards."}
   provide additional parameters. For instance, if this map has a :code entry,
   its value is used for operations such as :eval, which would otherwise
   interactively prompt for an expression."
-  [value dbg-state]
-  (let [commands     (cond-> debug-commands
-                       (not (map? *msg*))         (dissoc "q")
-                       (nil? (:locals dbg-state))    (dissoc "e" "j" "l" "p")
-                       (cljs/grab-cljs-env *msg*) identity)
-        response-raw (read-debug-input dbg-state commands nil)
-        dbg-state       (dissoc dbg-state :inspect)
-
-        {:keys [code coord response page-size force?]
-         :or {page-size 32}} (if (map? response-raw)
-                               response-raw
-                               {:response response-raw})]
-    (reset! step-in-to-next? false)
-    (case response
-      :next       value
-      :in         (do (reset! step-in-to-next? true)
-                      value)
-      :continue   (do (skip-breaks! :all)
-                      value)
-      :out        (do (skip-breaks! :deeper (butlast (:coor dbg-state)) (:code dbg-state) force?)
-                      value)
-      :here       (do (skip-breaks! :before coord (:code dbg-state) force?)
-                      value)
-      :stacktrace (do (debug-stacktrace)
-                      (recur value dbg-state))
-      :trace      (do (skip-breaks! :trace)
-                      value)
-      :locals     (->> (debug-inspect page-size (:locals dbg-state))
-                       (assoc dbg-state :inspect)
-                       (recur value))
-      :inspect    (try-if-let [val (read-eval-expression "Inspect value: " dbg-state code)]
-                    (->> (debug-inspect page-size val)
+  [coor value locals STATE__]
+  (loop [value     value
+         dbg-state (assoc (:msg STATE__)
+                          :debug-value (pr-short value)
+                          :coor coor
+                          :locals locals)]
+    (let [commands     (cond-> debug-commands
+                         (not (map? *msg*))         (dissoc "q")
+                         (nil? (:locals dbg-state)) (dissoc "e" "j" "l" "p")
+                         (cljs/grab-cljs-env *msg*) identity)
+          response-raw (read-debug-input dbg-state commands nil)
+          dbg-state    (dissoc dbg-state :inspect)
+
+          {:keys [code coord response page-size force?]
+           :or   {page-size 32}} (if (map? response-raw)
+                                   response-raw
+                                   {:response response-raw})]
+      (reset! step-in-to-next? false)
+      (case response
+        :next       value
+        :in         (do (reset! step-in-to-next? true)
+                        value)
+        :continue   (do (reset! (:skip STATE__) true)
+                        value)
+        :Continue   (do (skip-breaks! :all)
+                        value)
+        :out        (do (skip-breaks! :deeper (butlast (:coor dbg-state)) (:code dbg-state) force?)
+                        value)
+        :here       (do (skip-breaks! :before coord (:code dbg-state) force?)
+                        value)
+        :stacktrace (do (debug-stacktrace)
+                        (recur value dbg-state))
+        :trace      (do (skip-breaks! :trace)
+                        value)
+        :locals     (->> (debug-inspect page-size (:locals dbg-state))
                          (assoc dbg-state :inspect)
                          (recur value))
-                    (recur value dbg-state))
-      :inject     (try-if-let [val (read-eval-expression "Expression to inject: " dbg-state code)]
-                    val
-                    (recur value dbg-state))
-      :eval       (try-if-let [val (read-eval-expression "Expression to evaluate: " dbg-state code)]
-                    (recur value (assoc dbg-state :debug-value (pr-short val)))
-                    (recur value dbg-state))
-      :quit       (abort!)
-      (do (abort!)
-          (throw (ex-info "Invalid input from `read-debug-input`."
-                          {:response-raw response-raw}))))))
+        :inspect    (try-if-let [val (read-eval-expression "Inspect value: " dbg-state code)]
+                      (->> (debug-inspect page-size val)
+                           (assoc dbg-state :inspect)
+                           (recur value))
+                      (recur value dbg-state))
+        :inject     (try-if-let [val (read-eval-expression "Expression to inject: " dbg-state code)]
+                      val
+                      (recur value dbg-state))
+        :eval       (try-if-let [val (read-eval-expression "Expression to evaluate: " dbg-state code)]
+                      (recur value (assoc dbg-state :debug-value (pr-short val)))
+                      (recur value dbg-state))
+        :quit       (abort!)
+        (do (abort!)
+            (throw (ex-info "Invalid input from `read-debug-input`."
+                            {:response-raw response-raw})))))))
 
 (defn print-step-indented [depth form value]
   (print (apply str (repeat (dec depth) "| ")))
@@ -473,6 +482,9 @@ this map (identified by a key), and will `dissoc` it afterwards."}
                                 ;; top-level sexp, a (= col 1) is much more likely to be
                                 ;; wrong than right.
                                 (update :column #(if (= % 1) 0 %))))
+                    ;; the coor of first form is used as the debugger session id
+                    :session-id (atom nil)
+                    :skip (atom false)
                     :forms @*tmp-forms*}]
      ~@body))
 
@@ -481,31 +493,32 @@ this map (identified by a key), and will `dissoc` it afterwards."}
   [form dbg-state original-form]
   `(with-initial-debug-bindings
      (breakpoint-if-interesting
-       ~form ~dbg-state ~original-form)))
+      ~form ~dbg-state ~original-form)))
 
 (defn break
   "Breakpoint function.
   Send the result of form and its coordinates to the client and wait for
   response with `read-debug-command`'."
   [coor val locals STATE__]
+  (if-let [first-coor @(:session-id STATE__)]
+    (when (= first-coor coor)
+      (reset! (:skip STATE__) false))
+    (reset! (:session-id STATE__) coor))
   (cond
-    (skip-breaks? coor (get-in STATE__ [:msg :code])) val
+    (skip-breaks? coor STATE__) val
     ;; The length of `coor` is a good indicator of current code
     ;; depth.
     (= (:mode @*skip-breaks*) :trace)
     (do (print-step-indented (count coor) (get-in STATE__ [:forms coor]) val)
         val)
     ;; Most common case - ask for input.
     :else
-    (read-debug-command val (assoc (:msg STATE__)
-                                   :debug-value (pr-short val)
-                                   :coor coor
-                                   :locals locals))))
+    (read-debug-command coor val locals STATE__)))
 
 (defn apply-instrumented-maybe
   "Apply var-fn or its instrumented version to args."
   [var-fn args coor STATE__]
-  (let [stepin (step-in? var-fn coor (get-in STATE__ [:msg :code]))]
+  (let [stepin (step-in? var-fn coor STATE__)]
     (apply (if stepin
              (::instrumented (meta var-fn))
              var-fn)
diff --git a/test/clj/cider/nrepl/middleware/debug_integration_test.clj b/test/clj/cider/nrepl/middleware/debug_integration_test.clj
@@ -97,6 +97,7 @@
 
 (def-debug-op :next)
 (def-debug-op :continue)
+(def-debug-op :Continue)
 (def-debug-op :in)
 
 (defmethod debugger-send :out [_ & [force?]]
@@ -216,6 +217,28 @@
     (<-- {:value "8"})
     (<-- {:status ["done"]})))
 
+(deftest continue-non-stop
+
+  (--> :eval "(ns user.test.debug)")
+  (<-- {:ns "user.test.debug"})
+  (<-- {:status ["done"]})
+
+  (--> :eval "(do (defn foo [a] #dbg (* a 2))
+                  (defn boo [] (dotimes [n 5] (foo n)) :fin))")
+  (<-- {:value "#'user.test.debug/boo"})
+  (<-- {:status ["done"]})
+
+  (testing "continue-non-stop"
+    (--> :eval "(boo)")
+    (<-- {:debug-value "0" :coor [1 3 1]}) ; a in foo
+    (--> :continue)
+    (<-- {:debug-value "1" :coor [1 3 1]}) ; a in foo
+    (--> :continue)
+    (<-- {:debug-value "2" :coor [1 3 1]}) ; a in foo
+    (--> :Continue)
+    (<-- {:value ":fin"})
+    (<-- {:status ["done"]})))
+
 (deftest call-instrumented-fn-when-stepping-out-test
   ;; When we step out of a form, instrumented functions that are
   ;; called should still be debugged.
@@ -566,6 +589,6 @@
     (.startsWith file "jar:file:")
     (.endsWith file "/nrepl/server.clj"))
 
-  (--> :continue)
+  (--> :Continue)
   (<-- {:value "{:transport 23}"})
   (<-- {:status ["done"]}))
diff --git a/test/clj/cider/nrepl/middleware/debug_test.clj b/test/clj/cider/nrepl/middleware/debug_test.clj

-Original file line number
+Diff line change
 (def ^:const bfkey :cider.nrepl.middleware.util.instrument/breakfunction)
 +;; dummy STATE__
 +(defn STATE []
 +  {:msg {:original-ns "user"}
 +   :session-id (atom nil)
 +   :skip (atom false)})
++
 (deftest irrelevant-return-value-test
   (are [x] (let [exp (clojure.walk/macroexpand-all x)]
              (= exp (clojure.walk/macroexpand-all `(d/breakpoint-if-interesting ~exp [] nil))))
     (is (not (#'d/skip-breaks? [1 2] nil)))
     (is (not (#'d/skip-breaks? [2 2 1] nil)))
 -    (let [code "(foo (bar blah x))"]
 +    (let [code "(foo (bar blah x))"
 +          state (assoc-in (STATE) [:msg :code] code)]
       (#'d/skip-breaks! :deeper [1 2] code nil)
 -      (is (d/skip-breaks? [] code))
 -      (is (not (#'d/skip-breaks? [1 2] code)))
 -      (is (not (#'d/skip-breaks? [2 2 1] code)))
 -      (is (#'d/skip-breaks? [1 2 3] code)))))
 +      (is (d/skip-breaks? [] state))
 +      (is (not (#'d/skip-breaks? [1 2] state)))
 +      (is (not (#'d/skip-breaks? [2 2 1] state)))
 +      (is (#'d/skip-breaks? [1 2 3] state)))))
 (defn- send-override
   [value]
   ;; Check functionality
   (with-redefs [d/abort! (constantly :aborted)
                 t/send   (send-override :quit)]
 -    (is (= :aborted (#'d/read-debug-command 'value (add-locals {})))))
 +    (is (= :aborted (#'d/read-debug-command nil 'value (locals) (STATE)))))
   (with-redefs [t/send (send-override :next)]
 -    (is (= 'value (#'d/read-debug-command 'value (add-locals {})))))
 +    (is (= 'value (#'d/read-debug-command nil 'value (locals) (STATE)))))
   (binding [*msg* {:session (atom {})}
             d/*skip-breaks* (atom {:mode :all})]
     (with-redefs [t/send (send-override :continue)]
 -      (is (= 'value (#'d/read-debug-command 'value (add-locals {}))))
 -      (is (#'d/skip-breaks? nil nil))))
 +      (is (= 'value (#'d/read-debug-command nil 'value (locals) (STATE))))
 +      (is (#'d/skip-breaks? nil (STATE)))))
   (binding [*msg* {:session (atom {})}
             d/*skip-breaks* (atom {:mode :all})]
     (with-redefs [t/send (send-override :out)]
 -      (is (= 'value (#'d/read-debug-command 'value (add-locals {:coor [1 2 3]}))))
 -      (is (#'d/skip-breaks? [1 2 3] nil))
 -      (is (#'d/skip-breaks? [1 2 4] nil))
 -      (is (not (#'d/skip-breaks? [1 2] nil)))))
 +      (is (= 'value (#'d/read-debug-command [1 2 3] 'value (locals) (STATE))))
 +      (is (#'d/skip-breaks? [1 2 3] (STATE)))
 +      (is (#'d/skip-breaks? [1 2 4] (STATE)))
 +      (is (not (#'d/skip-breaks? [1 2] (STATE))))))
   (with-redefs [t/send (send-override :inject)]
 -    (is (= :inject (#'d/read-debug-command 'value (add-locals {}))))))
 +    (is (= :inject (#'d/read-debug-command nil 'value (locals) (STATE))))))
 (deftest read-debug-command-eval-test
   (let [replies (atom [:eval 100 :next])]
     (with-redefs [t/send (fn [trans {:keys [key]}]
                            (deliver (@d/promises key) (str (first @replies)))
                            (swap! replies rest))]
 -      (is (= 'value (#'d/read-debug-command 'value (add-locals {})))))))
 +      (is (= 'value (#'d/read-debug-command nil 'value (locals) (STATE)))))))
 (deftest read-eval-expression-test
   (reset! d/debugger-message {})
 (deftest breakpoint
   ;; Map merging
 -  (with-redefs [d/read-debug-command (fn [v e] (assoc e :value v))
 +  (with-redefs [d/read-debug-command (fn [_ v _ s] (assoc (:msg s) :value v))
                 d/debugger-message   (atom [:fake])
                 d/*skip-breaks*      (atom nil)]
     (binding [*msg* {:session (atom {})
                      :file    :file
                      :line    :line
                      :column  :column}]
 -      (let [m (eval `(d/with-initial-debug-bindings
 -                         (d/breakpoint-if-interesting (inc 10) {:coor [6]} ~'(inc 10))))]
 +      (let [form `(d/with-initial-debug-bindings
 +                    (d/breakpoint-if-interesting (inc 10) {:coor [6]} ~'(inc 10)))
 +            m (eval form)]
         (are [k v] (= (k m) v)
           :value       11
 -          :debug-value "11"
 -          :coor        [6]
           :file        :file
           :line        :line
           :column      :column
       (reset! d/debugger-message [:fake])
       ;; Locals capturing
       (is (= (:value (eval `(d/with-initial-debug-bindings
 -                                (let [~'x 10] (d/breakpoint-if-interesting
 -                                               (locals)
 -                                               {:coor [1]} nil)))))
 +                              (let [~'x 10]
 +                                (d/breakpoint-if-interesting
 +                                 (locals)
 +                                 {:coor [1]} nil)))))
              '{x 10}))
       ;; Top-level sexps are not debugged, just returned.
       (is (= (eval `(d/with-initial-debug-bindings
 -                        (let [~'x 10] (d/breakpoint-if-interesting
 -                                       (locals)
 -                                       {:coor []}
 -                                       nil))))
 +                      (let [~'x 10]
 +                        (d/breakpoint-if-interesting
 +                         (locals)
 +                         {:coor []}
 +                         nil))))
              '{x 10})))))