Skip to content

Commit

Permalink
Implement a Trace command in the debugger
Browse files Browse the repository at this point in the history 
This command skips all further breakpoints (like :continue), but prints
their values via println.

Also fix and sanitize some tests for debug.clj
  • Loading branch information
@Malabarba
Malabarba committed Jan 30, 2016
1 parent 1349a89 commit 78c4584
Show file tree
Hide file tree
Showing 4 changed files with 68 additions and 45 deletions.
21 changes: 16 additions & 5 deletions src/cider/nrepl/middleware/debug.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -83,15 +83,18 @@
"True if the breakpoint at coordinates should be skipped.
If the first element of `*skip-breaks*` is :all, return true.
Otherwise, the first element should be :deeper or :before.
Otherwise, the first element should be :deeper, :before, or :trace.
If :deeper, return true if the given coordinates are deeper than the
rest of `*skip-breaks*`. If :before, return true if they represent a
place before the rest."
rest of `*skip-breaks*`.
If :before, return true if they represent a place before the rest.
If :trace, return false."
[coordinates]
(when-let [[mode & skip-coords] @*skip-breaks*]
(case mode
;; From :continue, skip everything.
:all true
;; From :trace, never skip.
:trace false
;; From :out, skip some breaks.
:deeper (let [parent (take (count skip-coords) coordinates)]
(and (= skip-coords parent)
Expand Down Expand Up @@ -272,7 +275,7 @@
a :code entry, its value is used for operations such as :eval, which
would otherwise interactively prompt for an expression."
[value extras]
(let [commands (cond->> [:next :continue :out :here :inspect :locals :inject :eval :stacktrace :quit]
(let [commands (cond->> [:next :continue :out :here :inspect :locals :inject :eval :stacktrace :trace :quit]
(not (map? *msg*)) (remove #{:quit})
(cljs/grab-cljs-env *msg*) identity)
response-raw (read-debug extras commands nil)
Expand All @@ -295,13 +298,14 @@
:eval (let [return (read-debug-eval-expression "Expression to evaluate: " extras code)]
(read-debug-command value (assoc extras :debug-value (pr-short return))))
:stacktrace (stack-then-read-command value extras)
:trace (do (skip-breaks! :trace) value)
:quit (abort!))))

;;; ## High-level functions
(defmacro breakpoint
"Send the result of form and its coordinates to the client.
Sends a response to the message stored in debugger-message."
[form coor]
[form coor original-form]
`(binding [*skip-breaks* (or *skip-breaks* (atom nil))
*locals* ~(sanitize-env &env)
*pprint-fn* (:pprint-fn *msg*)]
Expand All @@ -311,6 +315,13 @@
(not (seq @debugger-message)) (do (println "Debugger not initialized")
(skip-breaks! :all)
val#)
;; The length of `coor` is a good indicator of current code
;; depth.
(= (first @*skip-breaks*) :trace) (do (println ~@(repeat (dec (count coor)) "|")
(pr-short '~original-form)
"=>"
(pr-short val#))
val#)
:else (read-debug-command
val#
;; This *msg* is evaluated at compile-time, so it's
Expand Down
13 changes: 9 additions & 4 deletions src/cider/nrepl/middleware/util/instrument.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -135,23 +135,25 @@
(with-break (m/merge-meta (function form) (meta form))))
([form]
(let [{coor ::coor,
orig ::original-form,
bf ::breakfunction} (meta form)]
(when verbose-debug
(println "[DBG]" (not (not bf)) coor form))
(println "[DBG]" (not (not bf)) coor (or orig form)))
(cond
(and bf (seq coor))
(list bf form coor)
(list bf form coor orig)
;; If the form is a list and has no metadata, maybe it was
;; destroyed by a macro. Try guessing the coor by looking at
;; the first element. This fixes `->`, for instance.
(listy? form)
(let [{coor ::coor,
orig ::original-form,
bf ::breakfunction} (meta (first form))
coor (if (= (last coor) 0)
(pop coor)
coor)]
(if (and bf (seq coor))
(list bf form coor)
(list bf form coor orig)
form))
:else form))))

Expand Down Expand Up @@ -269,7 +271,10 @@
;; Fill the form with metadata. This will later tell us which
;; of the final (post-expansion) forms correspond to user
;; code (and where it came from).
(walk-indexed (fn [i f] (m/merge-meta f {::coor i})))
(walk-indexed (fn [i f]
(m/merge-meta f
{::original-form (m/strip-meta f)
::coor i})))
;; Expand so we don't have to deal with macros.
(m/macroexpand-all)
;; Go through everything again, and instrument any form with
Expand Down
44 changes: 22 additions & 22 deletions test/clj/cider/nrepl/middleware/debug_test.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -127,16 +127,16 @@
(is (= "HI" (:message (last (:causes @resp)))))))))

(deftest initialize
(reset! d/debugger-message nil)
(let [resp (atom nil)]
(with-redefs [t/send (fn [_ response] (reset! resp response))]
(#'d/initialize {:hi true}))
(is (= @d/debugger-message {:hi true}))
(is (not (:status @resp))))
(let [resp (atom nil)]
(with-redefs [t/send (fn [_ response] (reset! resp response))]
(#'d/initialize {:hi true}))
(is (:status @resp))))
(with-redefs [d/debugger-message (atom nil)]
(let [resp (atom nil)]
(with-redefs [t/send (fn [_ response] (reset! resp response))]
(#'d/initialize {:hi true}))
(is (= @d/debugger-message {:hi true}))
(is (not (:status @resp))))
(let [resp (atom nil)]
(with-redefs [t/send (fn [_ response] (reset! resp response))]
(#'d/initialize {:hi true}))
(is (:status @resp)))))

(deftest locals-for-message
(let [x 1
Expand Down Expand Up @@ -200,20 +200,20 @@
(deftest breakpoint
;; Map merging
(with-redefs [d/read-debug-command (fn [v e] (assoc e :value v))
d/debugger-message (atom [:fake])]
(binding [*msg* {:session (atom {}) :code :code, :id :id,
:file :file, :line :line, :column :column}]
(let [m (eval '(cider.nrepl.middleware.debug/breakpoint (inc 10) [6]))]
d/debugger-message (atom [:fake])
d/*skip-breaks* (atom nil)]
(binding [*msg* {:session (atom {}) :code :code, :id :id,
:file :file, :line :line, :column :column}]
(let [m (eval `(d/breakpoint (inc 10) [6] ~'(inc 10)))]
(are [k v] (= (k m) v)
:value 11
:value 11
:debug-value "11"
:coor [6]
:file :file
:line :line
:column :column
:code :code
:coor [6]
:file :file
:line :line
:column :column
:code :code
:original-id :id))
;; Locals capturing
(reset! @#'d/debugger-message nil)
(is (= (eval '(let [x 10] (cider.nrepl.middleware.debug/breakpoint cider.nrepl.middleware.debug/*locals* [])))
(is (= (:value (eval `(let [~'x 10] (d/breakpoint d/*locals* [] nil))))
'{x 10})))))
35 changes: 21 additions & 14 deletions test/clj/cider/nrepl/middleware/util/instrument_test.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -77,28 +77,28 @@
(= x 1) true
false never
:else final)
'#{[final [6]] [x [1 1]] [never [4]] [(= (bp x [1 1]) 1) [1]]}))
'#{[final [6]] [x [1 1]] [never [4]] [(= (bp x [1 1] x) 1) [1]]}))

(deftest instrument-recur
(is (= (breakpoint-tester '(loop [x '(1 2)]
(if (seq x)
(recur (rest x))
x)))
'#{[(rest (bp x [2 2 1 1])) [2 2 1]]
'#{[(rest (bp x [2 2 1 1] x)) [2 2 1]]
[x [2 2 1 1]]
[x [2 1 1]]
[x [2 3]]
[(seq (bp x [2 1 1])) [2 1]]}))
[(seq (bp x [2 1 1] x)) [2 1]]}))

(is (= (breakpoint-tester '(fn [x]
(if (seq x)
(recur (rest x))
x)))
'#{[(rest (bp x [2 2 1 1])) [2 2 1]]
'#{[(rest (bp x [2 2 1 1] x)) [2 2 1]]
[x [2 2 1 1]]
[x [2 1 1]]
[x [2 3]]
[(seq (bp x [2 1 1])) [2 1]]})))
[(seq (bp x [2 1 1] x)) [2 1]]})))

(deftest instrument-reify
(is (= (breakpoint-tester '(reify Transport
Expand All @@ -108,21 +108,21 @@
(inspect-reply msg response)
(.send transport response))
this)))
'#{[(. (bp transport [3 2 3 1]) send (bp response [3 2 3 2])) [3 2 3]]
'#{[(. (bp transport [3 2 3 1] transport) send (bp response [3 2 3 2] response)) [3 2 3]]
[response [3 2 1 1]]
[(if (bp (contains? (bp response [3 2 1 1]) :value) [3 2 1])
(bp (inspect-reply (bp msg [3 2 2 1]) (bp response [3 2 2 2])) [3 2 2])
(bp (. (bp transport [3 2 3 1]) send (bp response [3 2 3 2])) [3 2 3]))
[(if (bp (contains? (bp response [3 2 1 1] response) :value) [3 2 1] (contains? response :value))
(bp (inspect-reply (bp msg [3 2 2 1] msg) (bp response [3 2 2 2] response)) [3 2 2] (inspect-reply msg response))
(bp (. (bp transport [3 2 3 1] transport) send (bp response [3 2 3 2] response)) [3 2 3] (. transport send response)))
[3 2]]
[response [3 2 2 2]]
[response [3 2 3 2]]
[transport [2 2 1]]
[(inspect-reply (bp msg [3 2 2 1]) (bp response [3 2 2 2])) [3 2 2]]
[(inspect-reply (bp msg [3 2 2 1] msg) (bp response [3 2 2 2] response)) [3 2 2]]
[transport [3 2 3 1]]
[this [3 3]]
[msg [3 2 2 1]]
[(contains? (bp response [3 2 1 1]) :value) [3 2 1]]
[(. (bp transport [2 2 1]) recv) [2 2]]})))
[(contains? (bp response [3 2 1 1] response) :value) [3 2 1]]
[(. (bp transport [2 2 1] transport) recv) [2 2]]})))

(deftest instrument-function-call
(is (empty? (breakpoint-tester '(System/currentTimeMillis))))
Expand All @@ -131,8 +131,15 @@
(let [start-time (System/currentTimeMillis)]
(Thread/sleep 1000)
(- (System/currentTimeMillis) start-time))))
'#{[(let* [start-time (bp (. System currentTimeMillis) [3 1 1])] (bp (. Thread sleep 1000) [3 2]) (bp (- (bp (. System currentTimeMillis) [3 3 1]) (bp start-time [3 3 2])) [3 3])) [3]]
[(- (bp (. System currentTimeMillis) [3 3 1]) (bp start-time [3 3 2])) [3 3]]
'#{[(- (bp (. System currentTimeMillis) [3 3 1] (. System currentTimeMillis))
(bp start-time [3 3 2] start-time))
[3 3]]
[(let* [start-time (bp (. System currentTimeMillis) [3 1 1] (. System currentTimeMillis))]
(bp (. Thread sleep 1000) [3 2] (. Thread sleep 1000))
(bp (- (bp (. System currentTimeMillis) [3 3 1] (. System currentTimeMillis))
(bp start-time [3 3 2] start-time))
[3 3] (- (. System currentTimeMillis) start-time)))
[3]]
[(. System currentTimeMillis) [3 1 1]]
[(. Thread sleep 1000) [3 2]]
[start-time [3 3 2]]
Expand Down

0 comments on commit 78c4584

Please sign in to comment.