Store exceptions so sync ops can get stacktraces

The u/err-info function will now automatically store exceptions in
simple map-based, single-use, FIFO-expiring data store. This will allow
the stacktrace middleware to act on Exceptions that were not bound
to *e. See bug 1420 in CIDER:
clojure-emacs/cider#1420.

See also CIDER PR 1617: clojure-emacs/cider#1617

src/cider/nrepl/middleware/stacktrace.clj

@@ -3,6 +3,7 @@
   {:author "Jeff Valk"}
   (:require [cider.nrepl.middleware.pprint :as pprint]
             [cider.nrepl.middleware.util.cljs :as cljs]
+            [cider.nrepl.middleware.util.storage :as c-store]
             [clojure.repl :as repl]
             [clojure.string :as str]
             [clojure.tools.nrepl.middleware :refer [set-descriptor!]]
@@ -156,22 +157,25 @@
 ;;; ## Middleware
 
 (defn wrap-stacktrace-reply
-  [{:keys [session transport pprint-fn] :as msg}]
+  [{:keys [session transport pprint-fn storage-key] :as msg}]
   ;; no stacktrace support for cljs currently - they are printed by piggieback anyway
-  (if-let [e (and (not (cljs/grab-cljs-env msg))
-                  (@session #'*e))]
-    (doseq [cause (analyze-causes e pprint-fn)]
-      (t/send transport (response-for msg cause)))
-    (t/send transport (response-for msg :status :no-error)))
+  (letfn [(get-ex [] (if storage-key
+                       (c-store/query! storage-key)
+                       (@session #'*e)))]
+    (if-let [e (and (not (cljs/grab-cljs-env msg))
+                    (get-ex))]
+      (doseq [cause (analyze-causes e pprint-fn)]
+        (t/send transport (response-for msg cause)))
+      (t/send transport (response-for msg :status :no-error))))
   (t/send transport (response-for msg :status :done)))
 
 (defn wrap-stacktrace
   "Middleware that handles stacktrace requests, sending cause and stack frame
   info for the most recent exception."
   [handler]
   (fn [{:keys [op] :as msg}]
-    (if (= "stacktrace" op)
-      (wrap-stacktrace-reply msg)
+    (case op
+      "stacktrace" (wrap-stacktrace-reply msg)
       (handler msg))))
 
 ;; nREPL middleware descriptor info
@@ -183,5 +187,6 @@
    :handles {"stacktrace"
              {:doc (str "Return messages describing each cause and stack frame "
                         "of the most recent exception.")
-              :optional pprint/wrap-pprint-fn-optional-arguments
-              :returns {"status" "\"done\", or \"no-error\" if `*e` is nil"}}}}))
+              :optional (merge pprint/wrap-pprint-fn-optional-arguments
+                               {"storage-key" "The hash key for the Exception you're looking for if not looking for `*e`"})
+              :returns {"status" "\"done\", or \"no-error\" if no Exception in `*e` or the storage map."}}}}))

src/cider/nrepl/middleware/util/misc.clj

@@ -1,6 +1,7 @@
 (ns cider.nrepl.middleware.util.misc
   (:require [clojure.string :as str]
-            [clojure.stacktrace :as stacktrace]))
+            [clojure.stacktrace :as stacktrace]
+            [cider.nrepl.middleware.util.storage :as c-store]))
 
 (def java-api-version
   (try (-> (System/getProperty "java.version") (str/split #"\.") second)
@@ -60,7 +61,10 @@
 (prefer-method transform-value clojure.lang.Sequential clojure.lang.Associative)
 
 (defn err-info
-  [ex status]
-  {:ex (str (class ex))
-   :err (with-out-str (stacktrace/print-cause-trace ex))
-   :status #{status :done}})
+  [ex & statuses]
+  (let [ex-key (.hashCode ex)]
+    (c-store/add! ex-key ex)
+    {:ex (str (class ex))
+     :err (with-out-str (stacktrace/print-cause-trace ex))
+     :status (set (conj statuses :done))
+     :storage-key ex-key}))

src/cider/nrepl/middleware/util/storage.clj

@@ -0,0 +1,42 @@
+(ns cider.nrepl.middleware.util.storage)
+
+(def ^:private store (ref {}))
+(def ^:private exp-index (ref '()))
+(def ^:private capacity 10)
+
+(defn add!
+  "Adds the provided kv pair to a single-retrieval store that also has
+  queue-capacity expiring behavior; i.e. not only is kv removed from
+  the store when sucessfully queried, bual also if addition of the
+  supplied item causes store size to increase over the default
+  capacity of 10 items, then the oldest kv pair in the store is
+  expired (removed). Returns the value added to the store."
+  [k v]
+  (dosync
+   (let [untrimmed-exp   (conj @exp-index k)
+         untrimmed-store (assoc @store k v)
+         trimmable       (drop capacity untrimmed-exp)
+         trimmed-exp     (remove (set trimmable) untrimmed-exp)
+         trimmed-store   (apply dissoc untrimmed-store trimmable)]
+     (ref-set store trimmed-store)
+     (ref-set exp-index trimmed-exp)
+     v)))
+
+(defn query!
+  "Queries the single-retrieval store. Finds value associated with the
+  supplied key `k` and then removes the kv pair from storage. If `k`
+  not present, returns nil and no changes are made."
+  [k]
+  (dosync
+   (let [reply (get @store k)]
+     (ref-set store (dissoc @store k))
+     (ref-set exp-index (remove #(= k %) @exp-index))
+     reply)))
+
+(defn refresh!
+  "Refreshes the single-retrieval, queue-capacity store. Removes all kv
+  pairs from the store."
+  []
+  (dosync
+   (ref-set store {})
+   (ref-set exp-index '())))

test/clj/cider/nrepl/middleware/format_test.clj

@@ -80,10 +80,11 @@
       (is (= #{"done"} status))))
 
   (testing "format-edn returns an error if the given EDN is malformed"
-    (let [{:keys [err status]} (session/message {:op "format-edn"
-                                                 :edn unmatched-delimiter-edn-sample})]
+    (let [{:keys [err status] :as response} (session/message {:op "format-edn"
+                                                              :edn unmatched-delimiter-edn-sample})]
       (is (= #{"edn-read-error" "done"} status))
-      (is (.startsWith err "clojure.lang.ExceptionInfo: Unmatched delimiter"))))
+      (is (.startsWith err "clojure.lang.ExceptionInfo: Unmatched delimiter"))
+      (is (:storage-key response))))
 
   (testing "format-edn respects the :print-right-margin slot"
     (let [wide-edn-sample     "[1 2 3 4 5 6       7 8     9    0]"
@@ -104,9 +105,22 @@
       (is (= #{"done"} status))))
 
   (testing "format-edn returns an error if the :pprint-fn is unresolvable"
-    (let [{:keys [err ex status]} (session/message {:op "format-edn"
-                                                    :edn "{:b 2 :c 3 :a 1}"
-                                                    :pprint-fn "fake.nrepl.middleware.pprint/puget-pprint"})]
+    (let [{:keys [err ex status] :as response} (session/message {:op "format-edn"
+                                                                 :edn "{:b 2 :c 3 :a 1}"
+                                                                 :pprint-fn "fake.nrepl.middleware.pprint/puget-pprint"})]
       (is (.startsWith err "java.lang.IllegalArgumentException: No such namespace: fa"))
       (is (= "class java.lang.IllegalArgumentException" ex))
-      (is (= #{"done" "edn-read-error"} status)))))
+      (is (= #{"done" "edn-read-error"} status))
+      (is (:storage-key response)))))
+
+(deftest test-format-edn-stacktrace-processing
+  (testing "Simulates storage of an Exception so that we can analyze the stacktraces of sync'ed calls"
+    (let [format-resp      (session/message {:op "format-edn" :edn "{1 2 3"})
+          ex-key           (:storage-key format-resp)
+          stacktr-resp     (session/message {:op "stacktrace" :storage-key ex-key})
+          empty-store-resp (session/message {:op "stacktrace" :storage-key ex-key})]
+      (is (= "clojure.lang.ExceptionInfo" (:class stacktr-resp)))
+      (is (= "EOF while reading" (:message stacktr-resp)))
+      (is (:stacktrace stacktr-resp))
+      (is (= #{"done"} (:status stacktr-resp)))
+      (is (= #{"no-error" "done"} (:status empty-store-resp))))))

test/clj/cider/nrepl/middleware/util/storage_test.clj

@@ -0,0 +1,57 @@
+(ns cider.nrepl.middleware.util.storage-test
+  (:require [cider.nrepl.middleware.util.storage :as c-store]
+            [clojure.test :refer :all]))
+
+(use-fixtures :each (fn [f] (c-store/refresh!) (f)))
+
+(deftest test-single-add
+  (is (= 1 (c-store/add! :a 1))))
+
+(deftest multiple-add
+  (is (= 1 (c-store/add! :a 1)))
+  (is (= 2 (c-store/add! :b 2)))
+  (is (= 3 (c-store/add! :c 3))))
+
+(deftest test-empty-query
+  (is (nil? (c-store/query! :a))))
+
+(deftest test-miss-query
+  (c-store/add! :b 2)
+  (is (nil? (c-store/query! :a))))
+
+(deftest test-hit-query
+  (c-store/add! :a 1)
+  (is (= 1 (c-store/query! :a)))
+  (is (nil? (c-store/query! :a))))
+
+(deftest test-over-capacity
+  (c-store/add! :a 1)
+  (c-store/add! :b 2)
+  (c-store/add! :c 3)
+  (c-store/add! :d 4)
+  (c-store/add! :e 5)
+  (c-store/add! :f 6)
+  (c-store/add! :g 7)
+  (c-store/add! :h 8)
+  (c-store/add! :i 9)
+  (c-store/add! :j 10)
+  (c-store/add! :k 11)
+  (is (nil? (c-store/query! :a)))
+  (is (= 11 (c-store/query! :k))))
+
+(deftest test-refresh
+  (c-store/add! :a 1)
+  (c-store/add! :b 2)
+  (c-store/add! :c 3)
+  (c-store/add! :d 4)
+  (c-store/add! :e 5)
+  (c-store/add! :f 6)
+  (c-store/add! :g 7)
+  (c-store/add! :h 8)
+  (c-store/add! :i 9)
+  (c-store/add! :j 10)
+  (c-store/add! :k 11)
+  (c-store/refresh!)
+  (is (nil? (c-store/query! :a)))
+  (is (nil? (c-store/query! :e)))
+  (is (nil? (c-store/query! :k))))