├── test ├── resources │ ├── unknown.bin │ ├── test.txt │ └── sum-types-are-cool.jpg ├── smoketest │ ├── .gitignore │ ├── project.clj │ └── src │ │ └── smoketest │ │ └── core.clj ├── common │ ├── cider │ │ ├── test_ns │ │ │ ├── third_test_ns.clj │ │ │ ├── second_test_ns.clj │ │ │ └── first_test_ns.clj │ │ └── nrepl │ │ │ ├── test_transport.clj │ │ │ └── test_session.clj │ └── cider_nrepl │ │ └── plugin_test.clj ├── java │ └── cider │ │ └── nrepl │ │ └── test │ │ ├── AnotherTestClass.java │ │ ├── YetAnotherTest.java │ │ └── TestClass.java ├── src │ └── cider │ │ └── nrepl │ │ └── middleware │ │ └── debug_integration_test │ │ └── fn.clj ├── clj │ └── cider │ │ └── nrepl │ │ ├── middleware │ │ ├── test │ │ │ └── extensions_test.clj │ │ ├── test_filter_tests.clj │ │ ├── util │ │ │ ├── meta_test.clj │ │ │ └── error_handling_test.clj │ │ ├── spec_test.clj │ │ ├── out_test.clj │ │ ├── classpath_test.clj │ │ ├── slurp_test.clj │ │ ├── version_test.clj │ │ ├── resource_test.clj │ │ ├── undef_test.clj │ │ ├── profile_test.clj │ │ ├── apropos_test.clj │ │ ├── trace_test.clj │ │ ├── complete_test.clj │ │ ├── format_test.clj │ │ ├── ns_test.clj │ │ ├── refresh_test.clj │ │ ├── test_test.clj │ │ ├── track_state_test.clj │ │ └── stacktrace_test.clj │ │ ├── main_test.clj │ │ └── print_method_test.clj ├── cljs │ └── cider │ │ └── nrepl │ │ ├── middleware │ │ ├── cljs_stacktrace_test.clj │ │ ├── cljs_info_test.clj │ │ ├── cljs_ns_test.clj │ │ ├── cljs_complete_test.clj │ │ └── cljs_macroexpand_test.clj │ │ └── piggieback_test.clj └── spec │ └── cider │ └── nrepl │ └── middleware │ ├── stacktrace_spec_test.clj │ └── info_spec_test.clj ├── doc └── intro.md ├── resources └── content-types.edn ├── src ├── data_readers.clj ├── cider │ ├── nrepl │ │ ├── middleware │ │ │ ├── classpath.clj │ │ │ ├── version.clj │ │ │ ├── undef.clj │ │ │ ├── spec.clj │ │ │ ├── util │ │ │ │ ├── meta.clj │ │ │ │ ├── nrepl.clj │ │ │ │ ├── coerce.clj │ │ │ │ ├── cljs.clj │ │ │ │ └── error_handling.clj │ │ │ ├── pprint.clj │ │ │ ├── apropos.clj │ │ │ ├── trace.clj │ │ │ ├── complete.clj │ │ │ ├── test │ │ │ │ └── extensions.clj │ │ │ ├── format.clj │ │ │ ├── resource.clj │ │ │ ├── enlighten.clj │ │ │ ├── ns.clj │ │ │ ├── inspect.clj │ │ │ ├── info.clj │ │ │ ├── slurp.clj │ │ │ ├── out.clj │ │ │ ├── profile.clj │ │ │ ├── content_type.clj │ │ │ └── refresh.clj │ │ ├── version.clj │ │ ├── pprint.clj │ │ └── print_method.clj │ └── tasks.clj └── cider_nrepl │ ├── main.clj │ └── plugin.clj ├── .dir-locals.el ├── .gitignore ├── eastwood.clj ├── .github ├── ISSUE_TEMPLATE.md ├── PULL_REQUEST_TEMPLATE.md └── CONTRIBUTING.md ├── deps.edn ├── bin └── ci_detect_timeout ├── Makefile ├── .travis.yml └── CHANGELOG.md /test/resources/unknown.bin: -------------------------------------------------------------------------------- 1 | foo -------------------------------------------------------------------------------- /test/smoketest/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | -------------------------------------------------------------------------------- /test/resources/test.txt: -------------------------------------------------------------------------------- 1 | A test resource file 2 | -------------------------------------------------------------------------------- /test/resources/sum-types-are-cool.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tatut/cider-nrepl/master/test/resources/sum-types-are-cool.jpg -------------------------------------------------------------------------------- /doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to cider-nrepl 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/great-documentation/what-to-write/) 4 | -------------------------------------------------------------------------------- /resources/content-types.edn: -------------------------------------------------------------------------------- 1 | {"text/edn" ["edn"] 2 | "text/clojure" ["clj" "cljc"] 3 | "text/clojurescript" ["cljs"] 4 | "text/yaml" ["yml" "yaml"]} 5 | -------------------------------------------------------------------------------- /src/data_readers.clj: -------------------------------------------------------------------------------- 1 | {dbg cider.nrepl.middleware.debug/debug-reader 2 | break cider.nrepl.middleware.debug/breakpoint-reader 3 | light cider.nrepl.middleware.enlighten/light-reader} 4 | -------------------------------------------------------------------------------- /test/common/cider/test_ns/third_test_ns.clj: -------------------------------------------------------------------------------- 1 | (ns cider.test-ns.third-test-ns) 2 | 3 | (defn same-name-testing-function 4 | "Multiple vars with the same name in different ns's. Used to test ns-list-vars-by-name." 5 | [] 6 | true) 7 | -------------------------------------------------------------------------------- /test/common/cider/test_ns/second_test_ns.clj: -------------------------------------------------------------------------------- 1 | (ns cider.test-ns.second-test-ns) 2 | 3 | (defn same-name-testing-function 4 | "Multiple vars with the same name in different ns's. Used to test ns-list-vars-by-name." 5 | [] 6 | true) 7 | -------------------------------------------------------------------------------- /.dir-locals.el: -------------------------------------------------------------------------------- 1 | ;;; Directory Local Variables 2 | ;;; For more information see (info "(emacs) Directory Variables") 3 | 4 | ((clojure-mode 5 | (clojure-indent-style . :always-align) 6 | (indent-tabs-mode . nil) 7 | (fill-column . 80))) 8 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | pom.xml.asc 7 | nashorn_code_cache 8 | out 9 | *.jar 10 | *.class 11 | .cljs_nashorn_repl 12 | .lein-deps-sum 13 | .lein-failures 14 | .lein-plugins 15 | .lein-repl-history 16 | .nrepl-port 17 | .source-deps 18 | -------------------------------------------------------------------------------- /test/java/cider/nrepl/test/AnotherTestClass.java: -------------------------------------------------------------------------------- 1 | package cider.nrepl.test; 2 | 3 | public class AnotherTestClass { 4 | public AnotherTestClass() { 5 | } 6 | 7 | public static int fnWithSameName(int a, String b, boolean c) { 8 | return 8; 9 | } 10 | 11 | } 12 | -------------------------------------------------------------------------------- /test/common/cider/test_ns/first_test_ns.clj: -------------------------------------------------------------------------------- 1 | (ns cider.test-ns.first-test-ns) 2 | 3 | (def some-test-var 4 | "This is a test var used to check eldoc returned for a variable." 5 | 1) 6 | 7 | (defn same-name-testing-function 8 | "Multiple vars with the same name in different ns's. Used to test ns-list-vars-by-name." 9 | [] 10 | true) 11 | -------------------------------------------------------------------------------- /test/java/cider/nrepl/test/YetAnotherTest.java: -------------------------------------------------------------------------------- 1 | package cider.nrepl.test; 2 | 3 | import java.util.List; 4 | 5 | public class YetAnotherTest { 6 | public YetAnotherTest() { 7 | } 8 | 9 | public String fnWithSameName(byte[] prim, Object[] things, List generic) { 10 | return "something"; 11 | } 12 | 13 | } 14 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/classpath.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.classpath 2 | (:require 3 | [cider.nrepl.middleware.util.error-handling :refer [with-safe-transport]] 4 | [orchard.classpath :as cp])) 5 | 6 | (defn classpath-reply [msg] 7 | {:classpath (map str (cp/classpath))}) 8 | 9 | (defn handle-classpath [handler msg] 10 | (with-safe-transport handler msg 11 | "classpath" classpath-reply)) 12 | -------------------------------------------------------------------------------- /test/java/cider/nrepl/test/TestClass.java: -------------------------------------------------------------------------------- 1 | package cider.nrepl.test; 2 | 3 | public class TestClass { 4 | public TestClass() { 5 | } 6 | 7 | public int getInt() { 8 | return 3; 9 | } 10 | 11 | public boolean fnWithSameName() { 12 | return true; 13 | } 14 | 15 | private static void doSomething(int a, int b, String c) { 16 | String x = c + a + b; 17 | } 18 | } 19 | -------------------------------------------------------------------------------- /test/common/cider/nrepl/test_transport.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.test-transport 2 | "A transport for testing" 3 | (:use 4 | [nrepl.transport :only [Transport]])) 5 | 6 | (defrecord TestTransport [msgs] 7 | Transport 8 | (recv [_] nil) 9 | (send [_ msg] (swap! msgs conj (dissoc msg :transport)))) 10 | 11 | (defn test-transport [] 12 | (TestTransport. (atom []))) 13 | 14 | (defn messages [test-transport] 15 | @(:msgs test-transport)) 16 | -------------------------------------------------------------------------------- /test/src/cider/nrepl/middleware/debug_integration_test/fn.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.debug-integration-test.fn 2 | "Function for debug integration test. 3 | 4 | NOTE: if modifying this file, modify corresponding tests in 5 | debug_integration_test.clj.") 6 | 7 | (defn as-sym 8 | [x] 9 | (cond 10 | (symbol? x) x 11 | (string? x) (if-let [[_ ns sym] (re-matches #"(.+)/(.+)" x)] 12 | (symbol ns sym) 13 | (symbol x)))) 14 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/test/extensions_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.test.extensions-test 2 | (:require 3 | [cider.nrepl.middleware.test.extensions :as extensions] 4 | [clojure.test :refer :all])) 5 | 6 | (deftest =-body-test 7 | (testing "Only evalulates expected form once" 8 | (let [x (eval 9 | `(let [~'x (atom 0)] 10 | ~(extensions/=-body "" '(swap! x inc) '(1)) 11 | (deref ~'x)))] 12 | (is (= 1 x))))) 13 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/test_filter_tests.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.test-filter-tests 2 | "empty tests for tests testing the filter feature 3 | in `cider.nrepl.middleware.test-test` namespace" 4 | (:require 5 | [clojure.test :refer :all])) 6 | 7 | (deftest ^:smoke a-puff-of-smoke-test 8 | (is true "puff")) 9 | 10 | (deftest ^:integration ^:smoke a-smokey-test 11 | (is true "puff")) 12 | 13 | (deftest yet-an-other-test 14 | (is true "yet an other")) 15 | 16 | (deftest test-with-map-as-message 17 | (is true {:key "val"})) 18 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/version.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.version 2 | "Return version info of the CIDER-nREPL middleware itself." 3 | (:require 4 | [cider.nrepl.version :as version] 5 | [nrepl.misc :refer [response-for]] 6 | [nrepl.transport :as transport])) 7 | 8 | (defn handle-version [handler msg] 9 | (if (= (:op msg) "cider-version") 10 | (->> (version/cider-version-reply msg) 11 | (merge {:status #{"done"}}) 12 | (response-for msg) 13 | (transport/send (:transport msg))) 14 | (handler msg))) 15 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/undef.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.undef 2 | "Undefine a symbol" 3 | (:require 4 | [cider.nrepl.middleware.util.error-handling :refer [with-safe-transport]] 5 | [orchard.misc :as u])) 6 | 7 | (defn undef 8 | [{:keys [ns symbol]}] 9 | (let [[ns symbol] (map u/as-sym [ns symbol])] 10 | (ns-unalias ns symbol) 11 | (ns-unmap ns symbol) 12 | symbol)) 13 | 14 | (defn undef-reply 15 | [msg] 16 | {:undef (undef msg)}) 17 | 18 | (defn handle-undef [handler msg] 19 | (with-safe-transport handler msg 20 | "undef" undef-reply)) 21 | -------------------------------------------------------------------------------- /eastwood.clj: -------------------------------------------------------------------------------- 1 | (disable-warning 2 | {:linter :unused-ret-vals 3 | :if-inside-macroexpansion-of #{'boot.core/deftask} 4 | :within-depth 7 5 | :reason "The `deftask` macro often includes calls to `boot.util/dbug*` whose purpose is solely for side-effects."}) 6 | 7 | (disable-warning 8 | {:linter :deprecations 9 | :symbol-matches #{#"^public boolean java\.lang\.reflect\.AccessibleObject\.isAccessible\(\)$"} 10 | :reason "The replacement, canAccess(Object), was added in JDK9 – but we still support JDK8."}) 11 | 12 | (disable-warning 13 | {:linter :deprecations 14 | :symbol-matches #{#"^public final void java\.lang\.Thread\.stop\(\)$"}}) 15 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | Use the template below when reporting bugs. Please, make sure that 2 | you're running the latest stable release or the latest snapshot of 3 | `cider-nrepl` and that the problem you're reporting hasn't been 4 | reported (and potentially fixed) already. 5 | 6 | ## Expected behavior 7 | 8 | ## Actual behavior 9 | 10 | ## Steps to reproduce the problem 11 | 12 | This is extremely important! Providing us with a reliable way to reproduce 13 | a problem will expedite its solution. 14 | 15 | ## Environment & Version information 16 | 17 | ### cider-nrepl version 18 | 19 | E.g. 0.11.2 20 | 21 | ### Java version 22 | 23 | E.g. 1.8 24 | 25 | ### Operating system 26 | 27 | E.g. Windows 10 28 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/spec.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.spec 2 | (:require 3 | [cider.nrepl.middleware.util.error-handling :refer [with-safe-transport]] 4 | [orchard.spec :as spec-utils])) 5 | 6 | ;; Replies 7 | 8 | (defn spec-list-reply [msg] 9 | {:spec-list (spec-utils/spec-list (:filter-regex msg))}) 10 | 11 | (defn spec-form-reply [msg] 12 | {:spec-form (spec-utils/spec-form (:spec-name msg))}) 13 | 14 | (defn spec-example-reply [msg] 15 | {:spec-example (spec-utils/spec-example (:spec-name msg))}) 16 | 17 | (defn handle-spec [handler msg] 18 | (with-safe-transport handler msg 19 | "spec-list" spec-list-reply 20 | "spec-form" spec-form-reply 21 | "spec-example" spec-example-reply)) 22 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/util/meta.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.util.meta 2 | "Utility functions for extracting and manipulating metadata." 3 | (:require 4 | [orchard.misc :as u])) 5 | 6 | (def relevant-meta-keys 7 | "Metadata keys that are useful to us. 8 | This is used so that we don't crowd the ns cache with useless or 9 | redudant information, such as :name and :ns." 10 | [:indent :deprecated :macro :arglists :test :doc :fn 11 | :cider/instrumented :style/indent :clojure.tools.trace/traced]) 12 | 13 | (defn relevant-meta 14 | "Filter the entries in map m by `relevant-meta-keys` and non-nil values." 15 | [m] 16 | (->> (select-keys m relevant-meta-keys) 17 | (filter second) 18 | (u/update-vals pr-str))) 19 | -------------------------------------------------------------------------------- /test/smoketest/project.clj: -------------------------------------------------------------------------------- 1 | (defproject smoketest "0.1.0-SNAPSHOT" 2 | :dependencies [[nrepl "0.5.3"] 3 | [cider/cider-nrepl "0.20.1-SNAPSHOT"]] 4 | :exclusions [org.clojure/clojure] 5 | :profiles {:1.7 {:dependencies [[org.clojure/clojure "1.7.0"]]} 6 | :1.8 {:dependencies [[org.clojure/clojure "1.8.0"]]} 7 | :1.9 {:dependencies [[org.clojure/clojure "1.9.0"]]} 8 | :1.10 {:dependencies [[org.clojure/clojure "1.10.0"]]} 9 | :master {:repositories [["snapshots" "https://oss.sonatype.org/content/repositories/snapshots"]] 10 | :dependencies [[org.clojure/clojure "1.11.0-master-SNAPSHOT"]]} 11 | :uberjar {:aot :all}} 12 | :main smoketest.core) 13 | -------------------------------------------------------------------------------- /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | Before submitting a PR make sure the following things have been done: 2 | 3 | - [ ] The commits are consistent with our [contribution guidelines](CONTRIBUTING.md) 4 | - [ ] You've added tests to cover your change(s) 5 | - [ ] All tests are passing 6 | - [ ] The new code is not generating reflection warnings 7 | - [ ] You've updated the README (if adding/changing middleware) 8 | 9 | Keep in mind that new cider-nrepl builds are automatically deployed to Clojars 10 | once a PR is merged, but **only** if the CI build is green. 11 | 12 | *If you're just starting out to hack on cider-nrepl you might find 13 | this [article](https://juxt.pro/blog/posts/nrepl.html) and the 14 | "Design" section of the README extremely useful.* 15 | 16 | Thanks! 17 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/util/meta_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.util.meta-test 2 | (:require 3 | [cider.nrepl.middleware.util.meta :as um] 4 | [clojure.test :refer :all])) 5 | 6 | (defn- test-fn "docstring" 7 | ([a b] nil) 8 | ([a] nil) 9 | ([])) 10 | 11 | (deftest dummy-test) 12 | 13 | (deftest relevant-meta-test 14 | (is (= (um/relevant-meta (meta #'test-fn)) 15 | {:arglists "([a b] [a] [])" 16 | :doc "\"docstring\""})) 17 | (is (= (:macro (um/relevant-meta (meta #'deftest))) 18 | "true")) 19 | (let [the-meta (meta #'dummy-test)] 20 | (is (= (um/relevant-meta (merge the-meta {:indent 1 21 | :cider-instrumented 2 22 | :something-else 3})) 23 | {:indent "1" 24 | :test (pr-str (:test the-meta))})))) 25 | -------------------------------------------------------------------------------- /test/cljs/cider/nrepl/middleware/cljs_stacktrace_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.cljs-stacktrace-test 2 | (:require 3 | [cider.nrepl.piggieback-test :refer [piggieback-fixture]] 4 | [cider.nrepl.test-session :as session] 5 | [clojure.test :refer :all])) 6 | 7 | (use-fixtures :once piggieback-fixture) 8 | 9 | (deftest cljs-stacktrace-test 10 | (testing "no last error" 11 | (let [response (session/message {:op :stacktrace})] 12 | (is (= #{"no-error" "done"} 13 | (:status response))))) 14 | (testing "last error stacktrace" 15 | (let [response (do (session/message {:op :eval 16 | :code "(ffirst 1)"}) 17 | (session/message {:op :stacktrace}))] 18 | (is (= #{"done"} 19 | (:status response))) 20 | (is (= "clojure.lang.ExceptionInfo" 21 | (:class response)))))) 22 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src" "resources"] 2 | :deps {nrepl {:mvn/version "0.4.5"} 3 | cider/orchard {:mvn/version "0.3.1"} 4 | thunknyc/profile {:mvn/version "0.5.2"} 5 | mvxcvi/puget {:mvn/version "1.0.2"} 6 | fipp {:mvn/version "0.6.14"} 7 | compliment {:mvn/version "0.3.6"} 8 | cljs-tooling {:mvn/version "0.3.0"} 9 | cljfmt {:mvn/version "0.5.7" :exclusions [org.clojure/clojurescript]}} 10 | :aliases 11 | {:cider-clj {:extra-deps {org.clojure/clojure {:mvn/version "1.9.0"}} 12 | :main-opts ["-m" "nrepl.cmdline" "--middleware" "[cider.nrepl/cider-middleware]"]} 13 | 14 | :cider-cljs {:extra-deps {org.clojure/clojure {:mvn/version "1.9.0"} 15 | org.clojure/clojurescript {:mvn/version "1.10.339"} 16 | cider/piggieback {:mvn/version "0.3.9"}} 17 | :main-opts ["-m" "nrepl.cmdline" "--middleware" 18 | "[cider.nrepl/cider-middleware,cider.piggieback/wrap-cljs-repl]"]}}} 19 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/spec_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.spec-test 2 | (:require 3 | [cider.nrepl.middleware.spec :as cider-spec] 4 | [cider.nrepl.test-session :as session] 5 | [clojure.test :refer :all])) 6 | 7 | ;; integration tests 8 | 9 | (use-fixtures :each session/session-fixture) 10 | 11 | (deftest ^{:min-clj-version "1.9.0"} spec-list-integration-test 12 | (let [filter-regex "clojure" 13 | filtered-spec-list (:spec-list (session/message {:op "spec-list" 14 | :filter-regex filter-regex}))] 15 | (testing "Filtered spec list retrieving nothing extra" 16 | (is (every? #(re-find (re-pattern (str ":?" filter-regex)) %) 17 | filtered-spec-list))) 18 | (testing "Filtering with simple words regex" 19 | (is (= (count filtered-spec-list) 20 | (count (:spec-list (session/message {:op "spec-list" 21 | :filter-regex (str filter-regex ".+")})))))))) 22 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/out_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.out-test 2 | (:require 3 | [cider.nrepl.middleware.out :as o] 4 | [clojure.test :refer :all])) 5 | 6 | (defn random-str [] 7 | (->> #(format "%x" (rand-int 15)) 8 | (repeatedly 10) 9 | (apply str))) 10 | 11 | (def the-meta {:id (random-str)}) 12 | 13 | (def msg {:op "eval" :id (random-str) 14 | :transport 90 15 | :some-other-key 10 16 | :session (atom {} :meta the-meta)}) 17 | 18 | (remove-watch o/tracked-sessions-map :update-out) 19 | 20 | (deftest maybe-register-session-test 21 | (with-redefs [o/tracked-sessions-map (atom {})] 22 | (o/subscribe-session msg) 23 | (let [{:keys [transport session id some-other-key]} (@o/tracked-sessions-map (:id the-meta))] 24 | (is (= transport (:transport msg))) 25 | (is (= session (:session msg))) 26 | (is (= id (:id msg))) 27 | (is (not some-other-key))) 28 | (o/unsubscribe-session (:id the-meta)) 29 | (is (empty? @o/tracked-sessions-map)))) 30 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/classpath_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.classpath-test 2 | (:require 3 | [cider.nrepl.test-session :as session] 4 | [cider.nrepl.middleware.classpath :refer :all] 5 | [clojure.test :refer :all])) 6 | 7 | (use-fixtures :each session/session-fixture) 8 | 9 | (deftest integration-test 10 | (let [response (session/message {:op "classpath"}) 11 | classpaths (:classpath response)] 12 | (is (= (:status response) #{"done"})) 13 | (is (> (count classpaths) 1)) 14 | (is (every? string? classpaths)) 15 | (is (some #(re-find #".*clojure-.*jar" %) classpaths)))) 16 | 17 | (deftest error-handling-test 18 | (with-redefs [classpath-reply (fn [_] (throw (Exception. "cp error")))] 19 | (let [response (session/message {:op "classpath"})] 20 | (is (= (:status response) #{"done" "classpath-error"})) 21 | (is (.startsWith (:err response) "java.lang.Exception: cp error")) 22 | (is (= (:ex response) "class java.lang.Exception")) 23 | (is (:pp-stacktrace response))))) 24 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/pprint.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.pprint 2 | (:require 3 | cider.nrepl.pprint 4 | nrepl.misc)) 5 | 6 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 | ;; DEPRECATED in favour of the built-in pprint support added in nREPL 0.5 ;; 8 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 9 | 10 | ;; TODO: Remove this middleware (or make it a no-op). 11 | 12 | (defn- resolve-pprint-fn 13 | "Resolve a namespaced symbol to a printer var. Returns the var or nil if 14 | the argument is nil or not resolvable." 15 | [var-sym] 16 | (when-let [var-sym (and var-sym (symbol var-sym))] 17 | (try 18 | (require (symbol (namespace var-sym))) 19 | (resolve var-sym) 20 | (catch Exception ex 21 | (nrepl.misc/log ex "Couldn't resolve printer function" var-sym) 22 | cider.nrepl.pprint/pprint)))) 23 | 24 | (defn handle-pprint-fn 25 | [handler msg] 26 | (let [{:keys [pprint-fn] 27 | :or {pprint-fn 'cider.nrepl.pprint/pprint}} 28 | msg] 29 | (handler (assoc msg :pprint-fn (resolve-pprint-fn pprint-fn))))) 30 | -------------------------------------------------------------------------------- /bin/ci_detect_timeout: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # A successful ClojureScript build takes 2~3 minutes, however sometimes it will 4 | # block until CI times out, and we're not sure yet why. 5 | # 6 | # To further diagnose this issue we now start a background shell which after five 7 | # minutes will print the stacktraces of all threads of all active JVMs using 8 | # jcmd/jstack. Hopefully this provides some insight in what/where the tests get 9 | # stuck. 10 | # 11 | # Additionally this kills all Java processes after five minutes so CI finishes a 12 | # little quicker. 13 | 14 | sleep 300 # 5 minutes 15 | 16 | function hr() { 17 | echo '━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━' 18 | } 19 | 20 | echo 21 | hr 22 | echo " TIMEOUT, PRINTING STACK TRACES." 23 | hr 24 | 25 | jcmd | grep -v jcmd | while read pid cmd 26 | do 27 | echo "---> " $cmd 28 | echo 29 | jstack $pid 2>&1 30 | hr 31 | echo 32 | done 33 | 34 | echo "KILLING JAVA PROCESSES" 35 | echo 36 | 37 | jcmd | grep -v jcmd | while read pid cmd 38 | do 39 | echo "kill -9 ${pid} # ${cmd}" 40 | kill -9 $pid 41 | done 42 | -------------------------------------------------------------------------------- /src/cider/nrepl/version.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.version 2 | ;; We require print-method here because `cider.nrepl.version` 3 | ;; namespace is used by every connection. 4 | (:require 5 | [cider.nrepl.print-method] 6 | [clojure.java.io :as io])) 7 | 8 | (def version-string 9 | "The current version for cider-nrepl as a string." 10 | (-> (or (io/resource "cider/cider-nrepl/project.clj") 11 | "project.clj") 12 | slurp 13 | read-string 14 | (nth 2))) 15 | 16 | (def version 17 | "Current version of CIDER nREPL as a map. 18 | Map of :major, :minor, :incremental, :qualifier, 19 | and :version-string." 20 | (assoc (->> version-string 21 | (re-find #"(\d+)\.(\d+)\.(\d+)-?(.*)") 22 | rest 23 | (map #(try (Integer/parseInt %) (catch Exception e nil))) 24 | (zipmap [:major :minor :incremental :qualifier])) 25 | :version-string version-string)) 26 | 27 | (defn cider-version-reply 28 | "Returns CIDER-nREPL's version as a map which contains `:major`, 29 | `:minor`, `:incremental`, and `:qualifier` keys, just as 30 | `*clojure-version*` does." 31 | [msg] 32 | {:cider-version version}) 33 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/util/nrepl.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.util.nrepl 2 | "Common utilities for interaction with the client." 3 | (:require 4 | [nrepl.middleware.interruptible-eval :refer [*msg*]] 5 | [nrepl.misc :refer [response-for]] 6 | [nrepl.transport :as transport])) 7 | 8 | (defn notify-client 9 | "Send user level notification to client as a response to request `msg`. 10 | If transport is not provided use (:transport msg). If msg is not provided, use 11 | current *msg* from interruptible-eval middleware. Type is a keyword or string 12 | indicating type of the message (e.g. :message, :warning, :error etc). Type 13 | defaults to :message. See `nrepl-notify` on the Emacs side." 14 | ([notification] (notify-client *msg* notification)) 15 | ([msg notification] (notify-client (:transport msg) msg notification nil)) 16 | ([msg notification type] (notify-client (:transport msg) msg notification type)) 17 | ([tr msg notification type] 18 | (transport/send tr (apply response-for msg 19 | :status :notification 20 | :msg notification 21 | (when type [:type type]))))) 22 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/apropos.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.apropos 2 | "Search symbols and docs matching a regular expression" 3 | {:author "Jeff Valk"} 4 | (:require 5 | [cider.nrepl.middleware.util.coerce :as util.coerce] 6 | [cider.nrepl.middleware.util.error-handling :refer [with-safe-transport]] 7 | [orchard.apropos :as apropos])) 8 | 9 | ;;; ## Middleware 10 | 11 | (defn apropos [msg] 12 | {:apropos-matches 13 | (apropos/find-symbols 14 | (cond-> msg 15 | ;; Compatibility for the pre-var-query API 16 | (:privates? msg) 17 | (assoc-in [:var-query :private?] true) 18 | 19 | (:query msg) 20 | (assoc-in [:var-query :search] (:query msg)) 21 | 22 | (not (:case-sensitive? msg)) 23 | (update-in [:var-query :search] #(format "(?i:%s)" %)) 24 | 25 | (:docs? msg) 26 | (assoc-in [:var-query :search-property] :doc) 27 | 28 | (:docs? msg) 29 | (assoc :full-doc? true) 30 | 31 | true 32 | (update :var-query util.coerce/var-query) 33 | 34 | (:ns msg) 35 | (update :ns (comp find-ns symbol))))}) 36 | 37 | (defn handle-apropos [handler msg] 38 | (with-safe-transport handler msg 39 | "apropos" apropos)) 40 | -------------------------------------------------------------------------------- /src/cider/nrepl/pprint.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.pprint 2 | "Pretty-print related utilities. 3 | All functions here are simple wrappers that ensure a consistent API: 4 | 5 | * has one and two params signatures - object to print and a map of print options 6 | * functions return the printed object as a string" 7 | {:added "0.20.0"} 8 | (:require 9 | [clojure.pprint :as pp])) 10 | 11 | (defn pprint 12 | "A simple wrapper around `clojure.pprint/write`. 13 | It provides an API compatible with what nREPL's 14 | pr-values middleware expects for printer functions." 15 | ([object] 16 | (pprint object {})) 17 | ([object opts] 18 | (let [opts (assoc opts :stream nil)] 19 | (apply pp/write object (vec (flatten (vec opts))))))) 20 | 21 | (def ^:private fipp-printer 22 | (delay 23 | (do 24 | (require 'fipp.edn) 25 | (resolve 'fipp.edn/pprint)))) 26 | 27 | (defn fipp-pprint 28 | ([object] 29 | (fipp-pprint object {})) 30 | ([object opts] 31 | (with-out-str 32 | (@fipp-printer object opts)))) 33 | 34 | (def ^:private puget-printer 35 | (delay 36 | (do 37 | (require 'puget.printer) 38 | (resolve 'puget.printer/pprint-str)))) 39 | 40 | (defn puget-pprint 41 | ([object] 42 | (puget-pprint object {})) 43 | ([object opts] 44 | (@puget-printer object opts))) 45 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/trace.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.trace 2 | (:require 3 | [cider.nrepl.middleware.util.error-handling :refer [with-safe-transport]] 4 | [clojure.tools.trace :as trace])) 5 | 6 | (defn toggle-trace-var 7 | [{:keys [ns sym]}] 8 | (if-let [v (ns-resolve (symbol ns) (symbol sym))] 9 | (if (trace/traceable? v) 10 | (if (trace/traced? v) 11 | (do (trace/untrace-var* v) 12 | {:var-name (str v) :var-status "untraced"}) 13 | (do (trace/trace-var* v) 14 | {:var-name (str v) :var-status "traced"})) 15 | {:var-name (str v) :var-status "not-traceable"}) 16 | {:status #{:toggle-trace-error :done} :var-status "not-found"})) 17 | 18 | (def traced-ns (atom #{})) 19 | 20 | (defn toggle-trace-ns 21 | [{:keys [ns]}] 22 | (if-let [ns (find-ns (symbol ns))] 23 | (if (contains? @traced-ns ns) 24 | (do (trace/untrace-ns ns) 25 | (swap! traced-ns disj ns) 26 | {:ns-status "untraced"}) 27 | (do (trace/trace-ns ns) 28 | (swap! traced-ns conj ns) 29 | {:ns-status "traced"})) 30 | {:ns-status "not-found"})) 31 | 32 | (defn handle-trace [handler msg] 33 | (with-safe-transport handler msg 34 | "toggle-trace-var" [toggle-trace-var :toggle-trace-error] 35 | "toggle-trace-ns" [toggle-trace-ns :toggle-trace-error])) 36 | -------------------------------------------------------------------------------- /test/cljs/cider/nrepl/middleware/cljs_info_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.cljs-info-test 2 | (:require 3 | [cider.nrepl.piggieback-test :refer [piggieback-fixture]] 4 | [cider.nrepl.test-session :as session] 5 | [clojure.test :refer :all])) 6 | 7 | (use-fixtures :once piggieback-fixture) 8 | 9 | (deftest cljs-info-test 10 | (let [response (session/message {:op "info" 11 | :ns "cljs.core" 12 | :symbol "map"})] 13 | (is (= "cljs.core" (:ns response))) 14 | (is (= "map" (:name response))) 15 | (is (string? (:arglists-str response))) 16 | (is (string? (:doc response))) 17 | (is (string? (:file response))) 18 | (is (:line response)) 19 | (is (:column response)) 20 | (is (= #{"done"} (:status response)))) 21 | 22 | (let [{:keys [status]} (session/message {:op "info" 23 | :ns "cljs.core" 24 | :symbol "non-existent-var"})] 25 | (is (= #{"no-info" "done"} status)))) 26 | 27 | (deftest cljs-eldoc-test 28 | (let [response (session/message {:op "eldoc" 29 | :ns "cljs.core" 30 | :symbol "println"})] 31 | (is (= [["&" "objs"]] (:eldoc response))) 32 | (is (= #{"done"} (:status response))))) 33 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/slurp_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.slurp-test 2 | (:require 3 | [cider.nrepl.middleware.slurp :refer [if-class slurp-url-to-content+body]] 4 | [clojure.java.io :as io] 5 | [clojure.test :as t] 6 | [clojure.string :as str])) 7 | 8 | ;; FIXME (arrdem 2018-04-11): 9 | ;; Remove these if-classes when we have jdk1.8 min 10 | (if-class java.util.Base64 11 | (t/deftest test-project-clj-is-clj 12 | (let [resp (slurp-url-to-content+body 13 | (.toString 14 | (.toURL 15 | (io/file "project.clj"))))] 16 | (t/is (= ["text/clojure" {}] (:content-type resp))) 17 | (t/is (not= "base64" (:content-transfer-encoding resp)))))) 18 | 19 | (if-class java.util.Base64 20 | (t/deftest test-sum-types-is-base64 21 | (let [resp (slurp-url-to-content+body 22 | (.toString 23 | (io/resource "sum-types-are-cool.jpg")))] 24 | (t/is (= ["image/jpeg" {}] (:content-type resp))) 25 | (t/is (= "base64" (:content-transfer-encoding resp)))))) 26 | 27 | (if-class java.util.Base64 28 | (t/deftest test-unrecognized-file 29 | (let [resp (slurp-url-to-content+body 30 | (.toString (io/resource "unknown.bin")))] 31 | (t/is (= ["application/octet-stream" {}] (:content-type resp))) 32 | (t/is (str/starts-with? (:body resp) "#binary[location=")) 33 | (t/is (str/ends-with? (:body resp) ",size=3]"))))) 34 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/version_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.version-test 2 | (:require 3 | [cider.nrepl.version :as v] 4 | [cider.nrepl.test-session :as session] 5 | [clojure.test :refer :all])) 6 | 7 | (deftest cider-version-test 8 | (let [outer-map (#'v/cider-version-reply {}) 9 | version-map (:cider-version outer-map)] 10 | (is (contains? version-map :major)) 11 | (is (contains? version-map :minor)) 12 | (is (contains? version-map :incremental)) 13 | (is (contains? version-map :version-string)))) 14 | 15 | (use-fixtures :once session/session-fixture) 16 | 17 | (deftest integration-test 18 | (testing "cider-version op" 19 | (let [response (session/message {:op "cider-version"}) 20 | version-map (:cider-version response)] 21 | (is (= #{"done"} (:status response))) 22 | (is (contains? version-map :major)) 23 | (is (contains? version-map :minor)) 24 | (is (contains? version-map :incremental)) 25 | (is (contains? version-map :version-string)))) 26 | 27 | (testing "describe op" 28 | (let [response (session/message {:op "describe"}) 29 | aux-map (:aux response) 30 | version-map (:cider-version aux-map)] 31 | (is (= #{"done"} (:status response))) 32 | (is (contains? version-map :major)) 33 | (is (contains? version-map :minor)) 34 | (is (contains? version-map :incremental)) 35 | (is (contains? version-map :version-string))))) 36 | -------------------------------------------------------------------------------- /.github/CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing 2 | 3 | If you discover issues, have ideas for improvements or new features, or 4 | want to contribute a new module, please report them to the 5 | [issue tracker][1] of the repository or submit a pull request. Please, 6 | try to follow these guidelines when you do so. 7 | 8 | ## Issue reporting 9 | 10 | * Check that the issue has not already been reported. 11 | * Check that the issue has not already been fixed in the latest code 12 | (a.k.a. `master`). 13 | * Be clear, concise and precise in your description of the problem. 14 | * Open an issue with a descriptive title and a summary in grammatically correct, 15 | complete sentences. 16 | * Include any relevant code to the issue summary. 17 | 18 | ## Pull requests 19 | 20 | * Read [how to properly contribute to open source projects on Github][2]. 21 | * Use a topic branch to easily amend a pull request later, if necessary. 22 | * Write [good commit messages][3]. 23 | * Squash related commits together. 24 | * Use the same coding conventions as the rest of the project. 25 | * Include tests for the code you've submitted. 26 | * Make sure the existing tests pass. 27 | * Open a [pull request][4] that relates to *only* one subject with a clear title 28 | and description in grammatically correct, complete sentences. 29 | 30 | [1]: https://github.com/clojure-emacs/cider-nrepl/issues 31 | [2]: http://gun.io/blog/how-to-github-fork-branch-and-pull-request 32 | [3]: http://tbaggery.com/2008/04/19/a-note-about-git-commit-messages.html 33 | [4]: https://help.github.com/articles/using-pull-requests 34 | -------------------------------------------------------------------------------- /test/cljs/cider/nrepl/middleware/cljs_ns_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.cljs-ns-test 2 | (:require 3 | [cider.nrepl.piggieback-test :refer [piggieback-fixture]] 4 | [cider.nrepl.test-session :as session] 5 | [clojure.test :refer :all])) 6 | 7 | (use-fixtures :once piggieback-fixture) 8 | 9 | (deftest cljs-ns-test 10 | (testing "ns-list op" 11 | (let [{:keys [ns-list]} (session/message {:op "ns-list"})] 12 | (is (sequential? ns-list)) 13 | (is (every? string? ns-list)))) 14 | 15 | (testing "ns-vars op" 16 | (let [{:keys [ns-vars]} (session/message {:op "ns-vars" 17 | :ns "cljs.core"})] 18 | (is (sequential? ns-vars)) 19 | (is (every? string? ns-vars)))) 20 | 21 | (testing "ns-vars-with-meta op" 22 | (let [ns-vars-with-meta (:ns-vars-with-meta 23 | (session/message {:op "ns-vars-with-meta" 24 | :ns "cljs.core"}))] 25 | (is (every? (comp map? second) ns-vars-with-meta)) 26 | (is (= (:+ ns-vars-with-meta) 27 | {:arglists "(quote ([] [x] [x y] [x y & more]))" 28 | :doc "\"Returns the sum of nums. (+) returns 0.\""})))) 29 | 30 | (testing "ns-path op" 31 | (let [{:keys [path]} (session/message {:op "ns-path" 32 | :ns "cljs.core"})] 33 | (is (.endsWith path "cljs/core.cljs"))) 34 | 35 | (let [{:keys [path]} (session/message {:op "ns-path" 36 | :ns "cljs.repl"})] 37 | (is (.endsWith path "cljs/repl.cljs"))))) 38 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/complete.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.complete 2 | (:require 3 | [cider.nrepl.middleware.util.cljs :as cljs] 4 | [cider.nrepl.middleware.util.error-handling :refer [with-safe-transport]] 5 | [cljs-tooling.complete :as cljs-complete] 6 | [compliment.core :as jvm-complete] 7 | [compliment.utils :as jvm-complete-utils] 8 | [orchard.misc :as u])) 9 | 10 | (defn complete 11 | [{:keys [ns symbol context extra-metadata] :as msg}] 12 | (let [ns (u/as-sym ns) 13 | prefix (str symbol) 14 | extra-metadata (set (map keyword extra-metadata))] 15 | (if-let [cljs-env (cljs/grab-cljs-env msg)] 16 | (cljs-complete/completions cljs-env prefix {:context-ns ns 17 | :extra-metadata extra-metadata}) 18 | (jvm-complete/completions prefix {:ns ns 19 | :context context 20 | :extra-metadata extra-metadata})))) 21 | 22 | (defn completion-doc 23 | [{:keys [ns symbol] :as msg}] 24 | (when-not (cljs/grab-cljs-env msg) 25 | (jvm-complete/documentation (str symbol) (u/as-sym ns)))) 26 | 27 | (defn complete-reply [msg] 28 | {:completions (complete msg)}) 29 | 30 | (defn doc-reply 31 | [msg] 32 | {:completion-doc (completion-doc msg)}) 33 | 34 | (defn flush-caches-reply 35 | [msg] 36 | (jvm-complete-utils/flush-caches) 37 | {}) 38 | 39 | (defn handle-complete [handler msg] 40 | (with-safe-transport handler msg 41 | "complete" complete-reply 42 | "complete-doc" doc-reply 43 | "complete-flush-caches" flush-caches-reply)) 44 | -------------------------------------------------------------------------------- /src/cider/tasks.clj: -------------------------------------------------------------------------------- 1 | (ns cider.tasks 2 | (:require 3 | [boot.core :refer [deftask]] 4 | [boot.repl :as repl] 5 | [boot.util :as util])) 6 | 7 | (deftask add-middleware 8 | "CIDER middleware injection task 9 | 10 | This task allows to inject middleware in `boot.repl/*default-middleware*`. 11 | Just pass it as -m|-middleware. The input is a name but will be converted to 12 | symbol." 13 | [m middleware MIDDLEWARE #{sym} "Name of the middleware to inject"] 14 | (if-let [default-middleware (resolve 'boot.repl/*default-middleware*)] 15 | (do (util/dbug* "Current middleware: %s\n" (vec @@default-middleware)) 16 | (swap! @default-middleware concat middleware) 17 | (util/dbug* "After cider-nrepl injection: %s\n" (vec @@default-middleware))) 18 | (util/dbug "Cannot resolve boot.repl/*default-middleware*, skipping middleware injection...\n")) 19 | identity) 20 | 21 | (deftask nrepl-server 22 | "Start a nREPL server. 23 | 24 | Optionally accepts port and host. 25 | 26 | Note that the boot.repl/*default-middleware* atom is read for the list of the 27 | middleware symbols." 28 | [b bind ADDR str "The address server listens on." 29 | p port PORT int "The port to listen on and/or connect to."] 30 | (let [default-mws @@(resolve 'boot.repl/*default-middleware*)] 31 | (util/dbug* "nREPL middleware: %s\n" (vec default-mws)) 32 | (boot.core/with-pass-thru [_] 33 | (require 'cider-nrepl.main) 34 | ((resolve 'cider-nrepl.main/start-nrepl) {:middleware default-mws 35 | :port port 36 | :bind bind})))) 37 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/util/coerce.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.util.coerce 2 | "Coercion utilities for coercing bencoded maps.") 3 | 4 | (defn- update-some 5 | [m k & args] 6 | (if (get m k) 7 | (apply update m k args) 8 | m)) 9 | 10 | (defn ns-query 11 | "Poke and prod at a bencoded ns-query until it is in the form that orchard 12 | expects." 13 | [ns-query] 14 | (-> ns-query 15 | (update-some :exactly 16 | #(seq 17 | (map (fn [ns-string] 18 | (if-let [ns (find-ns (symbol ns-string))] 19 | ns 20 | (throw (ex-info "Namespace not found" 21 | {::id :namespace-not-found 22 | :namespace-string ns-string})))) 23 | %))) 24 | (update :project? some?) 25 | (update :load-project-ns? (fn [x] 26 | (cond 27 | (= x []) false 28 | :else (some? x)))) 29 | (update :has-tests? some?) 30 | (update-some :include-regexps #(map re-pattern %)) 31 | (update-some :exclude-regexps #(map re-pattern %)))) 32 | 33 | (defn var-query 34 | [var-query] 35 | (-> var-query 36 | (update :ns-query ns-query) 37 | (update-some :exactly #(seq (keep (comp find-var symbol) %))) 38 | (update :test? some?) 39 | (update :private? some?) 40 | (update-some :include-meta-key #(map keyword %)) 41 | (update-some :exclude-meta-key #(map keyword %)) 42 | (update-some :search re-pattern) 43 | (update-some :search-property keyword) 44 | (dissoc :manipulate-vars))) 45 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/resource_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.resource-test 2 | (:require 3 | [cider.nrepl.test-session :as session] 4 | [cider.nrepl.middleware.resource :as r] 5 | [clojure.test :refer :all])) 6 | 7 | (use-fixtures :once session/session-fixture) 8 | (deftest resource-op-test 9 | (let [response (session/message {:op "resource" :name "test.txt"})] 10 | (is (= #{"done"} (:status response))) 11 | (is (.endsWith (:resource-path response) "test/resources/test.txt")))) 12 | 13 | (deftest resources-list-test 14 | (testing "Basic checks" 15 | (let [response (session/message {:op "resources-list"})] 16 | (is (= #{"done"} (:status response))) 17 | (is (not (empty? (:resources-list response)))) 18 | (is (not (empty? (filter #(re-matches #"test\.txt" (:relpath %)) 19 | (:resources-list response))))) 20 | (is (not (empty? (filter #(re-matches #".*test/resources/test\.txt" (:file %)) 21 | (:resources-list response)))))))) 22 | 23 | (deftest resource-op-error-handling-test 24 | (with-redefs [r/resource-path (fn [& _] (throw (Exception. "resource")))] 25 | (let [response (session/message {:op "resource" :name "test.txt"})] 26 | (is (= "class java.lang.Exception" (:ex response))) 27 | (is (= #{"done" "resource-error"} (:status response))) 28 | (is (:pp-stacktrace response))))) 29 | 30 | (deftest resources-list-op-error-handling-test 31 | (with-redefs [r/resources-list (fn [& _] (throw (Exception. "resources list")))] 32 | (let [response (session/message {:op "resources-list"})] 33 | (is (= "class java.lang.Exception" (:ex response))) 34 | (is (= #{"done" "resources-list-error"} (:status response))) 35 | (is (:pp-stacktrace response))))) 36 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/main_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.main-test 2 | (:require 3 | [cider.nrepl :refer [wrap-debug cider-middleware]] 4 | [cider-nrepl.main :as m] 5 | [clojure.test :refer :all] 6 | [nrepl.core :as nrepl] 7 | [nrepl.server :as nrepl.server] 8 | [nrepl.transport :as transport])) 9 | 10 | (defn start-stop-nrepl-session [opts] 11 | (with-open [server (#'m/start-nrepl opts) 12 | transport (nrepl/connect :port (:port server))] 13 | (transport/send transport {:op "clone" :id 1}) 14 | (let [session-id (:new-session (transport/recv transport 1000))] 15 | (assert session-id) 16 | (transport/send transport {:session session-id 17 | :id 2 18 | :op "clone"}) 19 | (is (= (:status (transport/recv transport 1000)) ["done"]))))) 20 | 21 | (deftest start-nrepl-test 22 | (testing "passing a specific handler should work" 23 | (let [opts {:handler nrepl.server/default-handler}] 24 | (start-stop-nrepl-session opts))) 25 | 26 | (testing "passing a sequence instead of a map shouldn't crash" 27 | (let [opts ["cider.nrepl/cider-middleware"]] 28 | (start-stop-nrepl-session opts))) 29 | 30 | (testing "passing nil shouldn't crash" 31 | (let [opts nil] 32 | (start-stop-nrepl-session opts))) 33 | 34 | (testing "passing valid middleware should work" 35 | (let [opts {:middleware ["cider.nrepl/cider-middleware"]}] 36 | (start-stop-nrepl-session opts))) 37 | 38 | (testing "passing options as given by boot task middleware should work" 39 | (let [opts {:middleware '(cider.nrepl.middleware.version/wrap-version 40 | cider.nrepl.middleware.apropos/wrap-apropos) 41 | :port nil 42 | :bind nil}] 43 | (start-stop-nrepl-session opts)))) 44 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/test/extensions.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.test.extensions 2 | "Extensions to `clojure.test` functionality. 3 | 4 | These are kept in a separate namespace because they are, by definition, 5 | opinionated." 6 | (:require 7 | [clojure.data :as data] 8 | [clojure.pprint :as pp] 9 | [clojure.test :as test :refer [assert-expr]])) 10 | 11 | ;; From pjstadig/humane-test-output 12 | ;; https://github.com/pjstadig/humane-test-output 13 | (defn =-body 14 | [msg expected more] 15 | (if (seq more) 16 | `(let [more# (list ~@more) 17 | expected# ~expected 18 | result# (apply = expected# more#)] 19 | (->> (if result# 20 | {:type :pass} 21 | {:type :fail 22 | :diffs (->> (remove #(= expected# %) more#) 23 | (map #(vector % (data/diff expected# %))))}) 24 | (merge {:message ~msg 25 | :expected expected# 26 | :actual more#}) 27 | test/do-report) 28 | result#) 29 | `(throw (Exception. "= expects more than one argument")))) 30 | 31 | (defmethod assert-expr '= [msg [_ expected & more]] 32 | (=-body msg expected more)) 33 | 34 | ;; In cases where an is form is part of a macro expansion assert-expr will get 35 | ;; called with the fully qualified name for = (clojure.core/=) 36 | ;; See: https://github.com/clojure-emacs/cider-nrepl/pull/478#pullrequestreview-90616379 37 | (defmethod assert-expr 'clojure.core/= [msg [_ expected & more]] 38 | (=-body msg expected more)) 39 | 40 | (defn diffs-result 41 | "Convert diffs data to form appropriate for transport." 42 | [diffs] 43 | (let [pprint-str #(with-out-str (pp/pprint %))] 44 | (map (fn [[a [removed added]]] 45 | [(pprint-str a) 46 | [(pprint-str removed) (pprint-str added)]]) 47 | diffs))) 48 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: test eastwood cljfmt cloverage install smoketest release deploy clean detect_timeout 2 | 3 | CLOJURE_VERSION ?= 1.9 4 | export CLOVERAGE_VERSION = 1.0.13 5 | 6 | JAVA_VERSION = $(shell lein with-profile +sysutils \ 7 | sysutils :java-version-simple | cut -d " " -f 2) 8 | 9 | .source-deps: 10 | lein source-deps 11 | touch .source-deps 12 | 13 | source-deps: .source-deps 14 | 15 | test: .source-deps 16 | lein with-profile +$(CLOJURE_VERSION),+plugin.mranderson/config test 17 | 18 | eastwood: 19 | lein with-profile +$(CLOJURE_VERSION),+eastwood eastwood 20 | 21 | cljfmt: 22 | lein with-profile +$(CLOJURE_VERSION),+cljfmt cljfmt check 23 | 24 | cloverage: 25 | lein with-profile +$(CLOJURE_VERSION),+cloverage cloverage 26 | 27 | install: .source-deps 28 | lein with-profile +$(CLOJURE_VERSION),+plugin.mranderson/config install 29 | 30 | smoketest: install 31 | cd test/smoketest && \ 32 | lein with-profile +$(CLOJURE_VERSION) uberjar && \ 33 | java -jar target/smoketest-0.1.0-SNAPSHOT-standalone.jar 34 | 35 | 36 | # Run a background process that prints all JVM stacktraces after five minutes, 37 | # then kills all JVMs, to help diagnose issues with ClojureScript tests getting 38 | # stuck. 39 | detect_timeout: 40 | (bin/ci_detect_timeout &) 41 | 42 | # When releasing, the BUMP variable controls which field in the 43 | # version string will be incremented in the *next* snapshot 44 | # version. Typically this is either "major", "minor", or "patch". 45 | 46 | BUMP ?= patch 47 | 48 | release: 49 | lein with-profile +$(CLOJURE_VERSION) release $(BUMP) 50 | 51 | # Deploying requires the caller to set environment variables as 52 | # specified in project.clj to provide a login and password to the 53 | # artifact repository. 54 | 55 | deploy: .source-deps 56 | lein with-profile +$(CLOJURE_VERSION),+plugin.mranderson/config deploy clojars 57 | 58 | clean: 59 | lein clean 60 | cd test/smoketest && lein clean 61 | rm -f .source-deps 62 | -------------------------------------------------------------------------------- /test/spec/cider/nrepl/middleware/stacktrace_spec_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.stacktrace-spec-test 2 | (:require 3 | [cider.nrepl.middleware.stacktrace :refer :all] 4 | [clojure.spec.alpha :as s] 5 | [cider.nrepl.pprint :refer [pprint]] 6 | [clojure.test :refer :all])) 7 | 8 | (s/check-asserts true) 9 | 10 | (defn causes 11 | [form] 12 | (analyze-causes 13 | (try (eval form) 14 | (catch Exception e 15 | e)) 16 | pprint 17 | {})) 18 | 19 | (defn stack-frames 20 | [form] 21 | (analyze-stacktrace 22 | (try (eval form) 23 | (catch Exception e 24 | e)))) 25 | 26 | (def email-regex #"^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,63}$") 27 | (s/def ::email-type (s/and string? #(re-matches email-regex %))) 28 | (s/def ::first-name string?) 29 | (s/def ::last-name string?) 30 | (s/def ::email ::email-type) 31 | (s/def ::person (s/keys :req [::first-name ::last-name ::email] 32 | :opt [::phone])) 33 | 34 | (deftest spec-assert-stacktrace-test 35 | 36 | (def broken-musk {::first-name "Elon" 37 | ::last-name "Musk" 38 | ::email "n/a"}) 39 | 40 | (def broken-musk-causes 41 | (causes 42 | `(s/assert ::person broken-musk))) 43 | 44 | (testing "Spec assert components" 45 | (is (= 1 (count broken-musk-causes))) 46 | (is (:stacktrace (first broken-musk-causes))) 47 | (is (:message (first broken-musk-causes))) 48 | (is (:spec (first broken-musk-causes)))) 49 | 50 | (testing "Spec assert data components" 51 | (let [spec (:spec (first broken-musk-causes))] 52 | (is (:spec spec)) 53 | (is (string? (:value spec))) 54 | (is (= 1 (count (:problems spec)))))) 55 | 56 | (testing "Spec assert problems components" 57 | (let [probs (->> broken-musk-causes first :spec :problems first)] 58 | (is (:in probs)) 59 | (is (:val probs)) 60 | (is (:predicate probs)) 61 | (is (:spec probs)) 62 | (is (:at probs))))) 63 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | dist: xenial 2 | language: clojure 3 | lein: 2.8.3 4 | cache: 5 | directories: 6 | - $HOME/.m2 7 | script: 8 | - make $TARGET 9 | env: 10 | matrix: 11 | - CLOJURE_VERSION=1.8 TARGET='test smoketest' 12 | - CLOJURE_VERSION=1.9 TARGET='test smoketest' 13 | - CLOJURE_VERSION=1.10 TARGET='test smoketest' 14 | - CLOJURE_VERSION=master TARGET='test smoketest' 15 | global: 16 | - secure: "bCp4gU7XgeqLnqKwEpJarnKPbGljHyLE2rZnub4mEHD8kcvh6LoEkG/2QCtnSETj8zrQJwyMuEDGUwPgjmzQ/aEn6UiIYmv7ka6QnLBxOxhqQTbDtG7HssfkeT5b67LgOyQX7ejK88vnmH+OeWXM7kOOvUwVy5BVgsYyr2f1cGU=" 17 | - secure: "D2Ie7dUZ9nQOIWtkRl2XWZeijSL8expUXP3GziSqQV1scJzwexxnUsRvWOkc2YU8+6IIGz9tcyt9RrEFUVF31VZgRSHh8P5rGGCzI2l99djKhYFfSErElwgoAJZFtOzougZK66/Gtb5uDo5L/wlKHkl4st3miqm+mEvfJITDjRQ=" 18 | jdk: 19 | - openjdk8 20 | - openjdk11 21 | - openjdk-ea 22 | stages: 23 | - name: check 24 | - name: test 25 | - name: deploy 26 | # Deploy only from the home repo where the credentials can be 27 | # properly decrypted. Never deploy from a pull request job. 28 | # In addition, ensure we're on the master branch (snapshots) 29 | # or a branch with semver naming (releases). 30 | if: repo = clojure-emacs/cider-nrepl 31 | AND type != pull_request 32 | AND ( branch = master OR branch =~ ^v[0-9]+\.[0-9]+\.[0-9]+.*$ ) 33 | 34 | jobs: 35 | include: 36 | - stage: check 37 | env: CLOJURE_VERSION=1.10 TARGET=eastwood 38 | jdk: openjdk11 39 | 40 | - stage: check 41 | env: CLOJURE_VERSION=1.10 TARGET=cljfmt 42 | jdk: openjdk11 43 | 44 | - stage: test 45 | env: CLOJURE_VERSION=1.10 TARGET=cloverage 46 | jdk: openjdk11 47 | after_success: bash <(curl -s https://codecov.io/bash) -f target/coverage/codecov.json 48 | 49 | - stage: deploy 50 | env: TARGET=deploy 51 | jdk: openjdk11 52 | 53 | matrix: 54 | fast_finish: true 55 | allow_failures: 56 | - jdk: openjdk-ea 57 | - env: CLOJURE_VERSION=master TARGET='test smoketest' 58 | - env: CLOJURE_VERSION=1.10 TARGET=cloverage 59 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/format.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.format 2 | "Code and EDN formatting functionality." 3 | (:refer-clojure :exclude [read-string]) 4 | (:require 5 | [cider.nrepl.middleware.util.error-handling :refer [with-safe-transport]] 6 | [cljfmt.core :as fmt] 7 | [clojure.string :as str] 8 | [clojure.tools.reader.edn :as edn] 9 | [clojure.tools.reader.reader-types :as readers] 10 | [clojure.walk :as walk])) 11 | 12 | ;;; Code formatting 13 | (defn- keyword->symbol [kw] 14 | (.sym ^clojure.lang.Keyword kw)) 15 | 16 | (defn- generate-user-indents [indents] 17 | (reduce-kv 18 | (fn [acc kw rule] 19 | (assoc acc 20 | (keyword->symbol kw) 21 | (walk/postwalk #(cond-> % (string? %) keyword) rule))) 22 | fmt/default-indents 23 | indents)) 24 | 25 | (defn format-code-reply 26 | [{:keys [code options] :as msg}] 27 | (let [opts (some-> options 28 | (select-keys [:indents :alias-map]) 29 | (update :indents generate-user-indents) 30 | (update :alias-map #(reduce-kv (fn [m k v] (assoc m (name k) v)) {} %)))] 31 | {:formatted-code (fmt/reformat-string code opts)})) 32 | 33 | ;;; EDN formatting 34 | (defn- read-edn 35 | "Returns a vector of EDN forms, read from the string s." 36 | [s] 37 | (let [reader (readers/string-push-back-reader s) 38 | sentinel (Object.)] 39 | (loop [forms []] 40 | (let [form (edn/read {:eof sentinel} reader)] 41 | (if (= sentinel form) 42 | forms 43 | (recur (conj forms form))))))) 44 | 45 | (defn- format-edn 46 | [edn pprint-fn print-options] 47 | (->> (read-edn edn) 48 | (map #(pprint-fn % print-options)) 49 | (str/join "\n") 50 | str/trim)) 51 | 52 | (defn format-edn-reply 53 | [{:keys [edn pprint-fn print-options] :as msg}] 54 | {:formatted-edn (format-edn edn pprint-fn print-options)}) 55 | 56 | ;;; Middleware op handling 57 | (defn handle-format [handler msg] 58 | (with-safe-transport handler msg 59 | "format-code" format-code-reply 60 | "format-edn" format-edn-reply)) 61 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/resource.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.resource 2 | (:require 3 | [cider.nrepl.middleware.util.error-handling :refer [with-safe-transport]] 4 | [clojure.java.io :as io] 5 | [orchard.classloader :refer [class-loader]] 6 | [orchard.classpath :as cp] 7 | [orchard.misc :as u])) 8 | 9 | (defn- trim-leading-separator 10 | [s] 11 | (if (.startsWith s java.io.File/separator) 12 | (subs s 1) 13 | s)) 14 | 15 | (defn- get-project-resources 16 | [] 17 | (mapcat 18 | (fn [directory] 19 | (->> directory 20 | (file-seq) 21 | (filter (memfn isFile)) 22 | (map (fn [file] 23 | (let [relpath (-> file 24 | (.getPath) 25 | (.replaceFirst 26 | (.getPath directory) 27 | "") 28 | (trim-leading-separator))] 29 | {:root directory 30 | :file file 31 | :relpath relpath 32 | :url (io/resource relpath)}))) 33 | (remove #(.startsWith (:relpath %) "META-INF/")) 34 | (remove #(re-matches #".*\.(clj[cs]?|java|class)" (:relpath %))))) 35 | (filter (memfn isDirectory) 36 | (cp/classpath (class-loader))))) 37 | 38 | (defn resource-path [name] 39 | (when-let [resource (io/resource name (class-loader))] 40 | (.getPath resource))) 41 | 42 | (defn resources-list 43 | "Return a list of dictionaries containing file and relpath: file is the 44 | absolute path to the resource, relpath is the path of the resource relative 45 | to the classpath." 46 | [_] 47 | (map #(select-keys % [:file :relpath]) 48 | (get-project-resources))) 49 | 50 | (defn resource-reply [{:keys [name] :as msg}] 51 | {:resource-path (resource-path name)}) 52 | 53 | (defn resources-list-reply [msg] 54 | {:resources-list (u/transform-value (resources-list msg))}) 55 | 56 | (defn handle-resource [handler msg] 57 | (with-safe-transport handler msg 58 | "resource" resource-reply 59 | "resources-list" resources-list-reply)) 60 | -------------------------------------------------------------------------------- /test/cljs/cider/nrepl/middleware/cljs_complete_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.cljs-complete-test 2 | (:require 3 | [cider.nrepl.piggieback-test :refer [piggieback-fixture]] 4 | [cider.nrepl.test-session :as session] 5 | [clojure.test :refer :all])) 6 | 7 | (use-fixtures :once piggieback-fixture) 8 | 9 | (deftest cljs-complete-test 10 | (let [response (session/message {:op "complete" 11 | :ns "cljs.user" 12 | :symbol ""})] 13 | (is (= #{"done"} (:status response))) 14 | (is (sequential? (:completions response))) 15 | (is (every? map? (:completions response)))) 16 | 17 | (let [response (session/message {:op "complete" 18 | :ns "cljs.user" 19 | :symbol "defpro"}) 20 | candidate (first (:completions response))] 21 | (is (= "defprotocol" (:candidate candidate))) 22 | (is (= "cljs.core" (:ns candidate))) 23 | (is (= "macro" (:type candidate)))) 24 | 25 | (testing "function metadata" 26 | (let [response (session/message {:op "complete" 27 | :ns "cljs.user" 28 | :symbol "assoc" 29 | :extra-metadata ["arglists" "doc"]}) 30 | candidate (first (:completions response))] 31 | (is (= '("[coll k v]" "[coll k v & kvs]") (:arglists candidate))) 32 | (is (string? (:doc candidate))))) 33 | 34 | (testing "macro metadata" 35 | (let [response (session/message {:op "complete" 36 | :ns "cljs.user" 37 | :symbol "defprot" 38 | :extra-metadata ["arglists" "doc"]}) 39 | candidate (first (:completions response))] 40 | (is (= '("[psym & doc+methods]") (:arglists candidate))) 41 | (is (string? (:doc candidate)))))) 42 | 43 | (deftest cljs-complete-doc-test 44 | (let [response (session/message {:op "complete-doc" :symbol "tru"})] 45 | (is (= (:status response) #{"done"})) 46 | (is (empty? (:completion-doc response)) 47 | "Can't handle CLJS yet."))) 48 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/print_method_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.print-method-test 2 | (:require 3 | [cider.nrepl.print-method :refer :all] 4 | [clojure.test :refer :all]) 5 | (:import 6 | java.util.regex.Pattern)) 7 | 8 | (defn dummy-fn [o]) 9 | 10 | (deftest print-atoms-test 11 | (is (re-find #"#atom\[\"\" 0x[a-z0-9]+\]" (pr-str (atom "")))) 12 | (is (re-find #"#atom\[nil 0x[a-z0-9]+\]" (pr-str (atom nil)))) 13 | (is (re-find #"#atom\[\{:foo :bar\} 0x[a-z0-9]+\]" (pr-str (atom {:foo :bar})))) 14 | (is (re-find #"#atom\[#function\[clojure.core/\+\] 0x[a-z0-9]+\]" (pr-str (atom +))))) 15 | 16 | (deftest print-idrefs-test 17 | (let [f (future (Thread/sleep 200) 1) 18 | p (promise) 19 | d (delay 1) 20 | a (agent 1)] 21 | (are [o r] (re-find r (pr-str o)) 22 | a #"#agent\[\{:status :ready, :val 1\} 0x[a-z0-9]+\]" 23 | d #"#delay\[\{:status :pending, :val nil\} 0x[a-z0-9]+\]" 24 | f #"#future\[\{:status :pending, :val nil\} 0x[a-z0-9]+\]" 25 | p #"#promise\[\{:status :pending, :val nil\} 0x[a-z0-9]+\]") 26 | (Thread/sleep 300) 27 | @d 28 | (deliver p 1) 29 | (are [o r] (re-find r (pr-str o)) 30 | f #"#future\[\{:status :ready, :val 1\} 0x[a-z0-9]+\]" 31 | d #"#delay\[\{:status :ready, :val 1\} 0x[a-z0-9]+\]" 32 | p #"#promise\[\{:status :ready, :val 1\} 0x[a-z0-9]+\]"))) 33 | 34 | (deftest print-functions-test 35 | (are [f s] (= (pr-str f) s) 36 | print-functions-test "#function[cider.nrepl.print-method-test/print-functions-test]" 37 | dummy-fn "#function[cider.nrepl.print-method-test/dummy-fn]" 38 | multifn-name "#function[cider.nrepl.print-method/multifn-name]" 39 | + "#function[clojure.core/+]" 40 | * "#function[clojure.core/*]" 41 | / "#function[clojure.core//]" 42 | fn? "#function[clojure.core/fn?]")) 43 | 44 | (deftest print-multimethods-test 45 | (require 'cider.nrepl.middleware.track-state) 46 | (let [var (resolve 'print-method)] 47 | (is (re-find (Pattern/compile (format "#multifn\\[%s 0x[a-z0-9]+\\]" 48 | (:name (meta var)))) 49 | (pr-str @var))))) 50 | 51 | (deftest print-namespaces-test 52 | (are [f s] (= (pr-str f) s) 53 | (find-ns 'clojure.core) "#namespace[clojure.core]" 54 | (find-ns 'cider.nrepl.print-method) "#namespace[cider.nrepl.print-method]" 55 | (find-ns 'clojure.test) "#namespace[clojure.test]")) 56 | -------------------------------------------------------------------------------- /test/cljs/cider/nrepl/piggieback_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.piggieback-test 2 | (:require 3 | [cider.piggieback :as piggieback] 4 | [cider.nrepl.test-session :as session] 5 | [cider.nrepl :refer [cider-middleware]] 6 | [cljs.repl.nashorn :as nashorn] 7 | [clojure.test :refer :all] 8 | [nrepl.core :as nrepl] 9 | [nrepl.server :as server])) 10 | 11 | (def repl-env 12 | (delay (nashorn/repl-env))) 13 | 14 | (def piggieback-fixture 15 | (compose-fixtures 16 | session/session-fixture 17 | (fn [f] 18 | (binding [session/*handler* (apply server/default-handler 19 | (conj (map resolve cider-middleware) 20 | #'piggieback/wrap-cljs-repl))] 21 | ;; TODO check the result of this; we shouldn't run any tests if it fails 22 | (dorun (session/message 23 | {:op :eval 24 | :code (nrepl/code (require '[cider.piggieback :as piggieback]) 25 | (piggieback/cljs-repl @cider.nrepl.piggieback-test/repl-env))})) 26 | (dorun (session/message {:op :eval 27 | :code (nrepl/code (require 'clojure.data))})) 28 | (f) 29 | (session/message {:op :eval 30 | :code (nrepl/code :cljs/quit)}))))) 31 | 32 | (use-fixtures :each piggieback-fixture) 33 | 34 | (deftest sanity-test 35 | (testing "cljs repl is active" 36 | (let [response (session/message {:op :eval 37 | :code (nrepl/code (js/Object.))})] 38 | (is (= "cljs.user" (:ns response))) 39 | (is (= ["#js {}"] (:value response))) 40 | (is (= #{"done"} (:status response))))) 41 | 42 | (testing "eval works" 43 | (let [response (session/message {:op :eval 44 | :code (nrepl/code (map even? (range 6)))})] 45 | (is (= "cljs.user" (:ns response))) 46 | (is (= ["(true false true false true false)"] (:value response))) 47 | (is (= #{"done"} (:status response))))) 48 | 49 | (testing "errors handled properly" 50 | (let [response (session/message {:op :eval 51 | :code (nrepl/code (ffirst 1))})] 52 | (is (= "class clojure.lang.ExceptionInfo" 53 | (:ex response) 54 | (:root-ex response))) 55 | (is (string? (:err response))) 56 | (is (= #{"eval-error" "done"} (:status response)))))) 57 | -------------------------------------------------------------------------------- /src/cider_nrepl/main.clj: -------------------------------------------------------------------------------- 1 | (ns cider-nrepl.main 2 | (:require 3 | [clojure.java.io :as io] 4 | nrepl.server)) 5 | 6 | (defn- require-and-resolve 7 | [thing] 8 | (require (symbol (namespace thing))) 9 | (resolve thing)) 10 | 11 | (def resolve-mw-xf 12 | (comp (map require-and-resolve) 13 | (keep identity))) 14 | 15 | (defn- handle-seq-var 16 | [var] 17 | (let [x @var] 18 | (if (sequential? x) 19 | (into [] resolve-mw-xf x) 20 | [var]))) 21 | 22 | (def mw-xf 23 | (comp (map symbol) 24 | resolve-mw-xf 25 | (mapcat handle-seq-var))) 26 | 27 | (defn- ->mw-list 28 | [middleware-var-strs] 29 | (into [] mw-xf middleware-var-strs)) 30 | 31 | (defn- build-handler 32 | [middleware] 33 | (apply nrepl.server/default-handler (->mw-list middleware))) 34 | 35 | (defn start-nrepl 36 | "Starts a socket-based nREPL server. Accepts a map with the following keys: 37 | 38 | * :port — defaults to 0, which autoselects an open port 39 | 40 | * :bind — bind address, by default \"::\" (falling back to \"localhost\" if 41 | \"::\" isn't resolved by the underlying network stack) 42 | 43 | * :handler — the nREPL message handler to use for each incoming connection; 44 | defaults to the result of `(nrepl.server/default-handler)` 45 | 46 | * :middleware - a sequence of vars or string which can be resolved to vars, 47 | representing middleware you wish to mix in to the nREPL handler. Vars can 48 | resolve to a sequence of vars, in which case they'll be flattened into the 49 | list of middleware." 50 | [{:keys [handler middleware bind port] :as opts}] 51 | (let [handler 52 | (if handler 53 | (handler) 54 | (build-handler middleware)) 55 | 56 | {:keys [server-socket port] :as server} 57 | (nrepl.server/start-server :handler handler 58 | :bind (or bind "localhost") 59 | :port (or port 0)) 60 | 61 | bind 62 | (-> server-socket (.getInetAddress) (.getHostName))] 63 | (doto (io/file ".nrepl-port") 64 | (spit port) 65 | (.deleteOnExit)) 66 | (println (format "nREPL server started on port %d on host %s - nrepl://%s:%d" port bind bind port)) 67 | server)) 68 | 69 | (defn init 70 | ([] 71 | (start-nrepl {})) 72 | ([middleware] 73 | (start-nrepl {:middleware middleware}) 74 | ;; Return nil so the value doesn't print 75 | nil)) 76 | -------------------------------------------------------------------------------- /test/common/cider_nrepl/plugin_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider-nrepl.plugin-test 2 | (:require [cider-nrepl.plugin :as plugin] 3 | [cider.nrepl :refer [cider-middleware]] 4 | [clojure.test :refer :all] 5 | [leiningen.core.main :as lein])) 6 | 7 | (defn- contains-cider-nrepl-dep? [{:keys [dependencies]}] 8 | (boolean (->> dependencies 9 | (some (fn [[id version & _]] 10 | (= 'cider/cider-nrepl id)))))) 11 | 12 | (defn- contains-cider-nrepl-middleware? [{{:keys [nrepl-middleware]} :repl-options}] 13 | (= cider-middleware nrepl-middleware)) 14 | 15 | (deftest plugin-test 16 | ;; Suppress output of leiningen.core.main/warn 17 | (binding [lein/*info* false] 18 | (with-redefs [lein/leiningen-version (constantly plugin/min-lein-version)] 19 | (testing "Valid Lein version; valid Clojure version" 20 | (let [project (plugin/middleware '{:dependencies [[org.clojure/clojure "1.8.0"]]})] 21 | (is (contains-cider-nrepl-dep? project)) 22 | (is (contains-cider-nrepl-middleware? project)))) 23 | 24 | (testing "Valid Lein version; no Clojure version specified" 25 | (let [project (plugin/middleware '{})] 26 | (is (contains-cider-nrepl-dep? project)) 27 | (is (contains-cider-nrepl-middleware? project)))) 28 | 29 | (testing "Valid Lein version; invalid Clojure version" 30 | (let [project (plugin/middleware '{:dependencies [[org.clojure/clojure "1.6.0"]]})] 31 | (is (not (contains-cider-nrepl-dep? project))) 32 | (is (not (contains-cider-nrepl-middleware? project)))))) 33 | 34 | (with-redefs [lein/leiningen-version (constantly "2.5.1")] 35 | (testing "Invalid Lein version; valid Clojure version" 36 | (let [project (plugin/middleware '{:dependencies [[org.clojure/clojure "1.8.0"]]})] 37 | (is (not (contains-cider-nrepl-dep? project))) 38 | (is (not (contains-cider-nrepl-middleware? project))))) 39 | 40 | (testing "Invalid Lein version; no Clojure version specified" 41 | (let [project (plugin/middleware '{})] 42 | (is (not (contains-cider-nrepl-dep? project))) 43 | (is (not (contains-cider-nrepl-middleware? project))))) 44 | 45 | (testing "Invalid Lein version; invalid Clojure version" 46 | (let [project (plugin/middleware '{:dependencies [[org.clojure/clojure "1.6.0"]]})] 47 | (is (not (contains-cider-nrepl-dep? project))) 48 | (is (not (contains-cider-nrepl-middleware? project)))))))) 49 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | ## master (unreleased) 4 | 5 | ## 0.20.0 (2019-01-14) 6 | 7 | ### New features 8 | 9 | * Add print functions compatible with nREPL 0.5 to `cider.nrepl.pprint` namespace. 10 | 11 | ### Changes 12 | 13 | * **(Breaking)** Drop support for nREPL 0.2.x (aka `tools.nrepl`). Now nREPL 0.4+ is required. 14 | * **(Breaking)** Drop support for Piggieback 0.2.x (aka `cemerick.piggieback`). Now Piggieback 0.3+ is required. 15 | * Deprecated `cider.nrepl.middleware.pprint` if favour of the built-in pprint support in nREPL 0.5. 16 | 17 | ## 0.19.0 (2019-01-01) 18 | 19 | ### New features 20 | 21 | * [#546](https://github.com/clojure-emacs/cider-nrepl/pull/546): Added support for matcher-combinators to the test middleware. 22 | * [#556](https://github.com/clojure-emacs/cider-nrepl/pull/556): Added configuration option for cljfmt to the format middleware. 23 | * [#558](https://github.com/clojure-emacs/cider-nrepl/pull/558): Added the `ns-aliases` op to the ns middleware. 24 | 25 | ### Changes 26 | 27 | * [#550](https://github.com/clojure-emacs/cider-nrepl/pull/550): Always return test documentation messages as strings. 28 | * [#563](https://github.com/clojure-emacs/cider-nrepl/pull/563): Add :root-ex key to error summary that contains the classname of the root cause. 29 | 30 | ### Bugs fixed 31 | 32 | * [#573](https://github.com/clojure-emacs/cider-nrepl/pull/573): Fix inspector silently doing nothing if eval errored 33 | 34 | ## 0.18.0 (2018-08-06) 35 | 36 | ### New features 37 | 38 | * [#540](https://github.com/clojure-emacs/cider-nrepl/pull/540): Added support for nREPL 0.4. 39 | * [#532](https://github.com/clojure-emacs/cider-nrepl/pull/532): Added a boot task to start the nREPL server (allows us to run nREPL 0.4 before boot upgrades to it). 40 | 41 | ### Changes 42 | 43 | * Drop "official" support for Java 7 and Clojure 1.7 (although they might still work for a while). 44 | * Extract the `info` related functionality to `orchard`. 45 | 46 | ### Bugs fixed 47 | 48 | * [#535](https://github.com/clojure-emacs/cider-nrepl/pull/535): Check for cemerick/piggieback, before checking for 49 | cider/piggieback. 50 | * [#542](https://github.com/clojure-emacs/cider-nrepl/issues/542): Qualify references to `*out*` and `*err*` in `wrap-out`. 51 | 52 | ## 0.17.0 (2018-05-07) 53 | 54 | ### New features 55 | 56 | * Extracted part of the nREPL-agnostic functionality to `orchard`. 57 | * Added a profiling middleware. 58 | * Support for orchard var-query in apropos. 59 | * Support for orchard var-query in test, introducing new test-var-query. 60 | 61 | ### Changes 62 | 63 | * Remove support for cljx. 64 | * Remove support for piggieback 0.1.x. 65 | * Add support for piggieback 0.3 or newer (aka `cider/piggieback`). 66 | * Deprecate the `test` and `test-all` ops. 67 | * Deprecated non-test-var filters in the `apropos` middleware. 68 | -------------------------------------------------------------------------------- /src/cider_nrepl/plugin.clj: -------------------------------------------------------------------------------- 1 | (ns cider-nrepl.plugin 2 | "Provides a simple way to setup the CIDER nREPL middleware in 3 | Leiningen projects." 4 | (:require 5 | [cider.nrepl.version :refer [version-string]] 6 | [clojure.java.io :as io] 7 | [leiningen.core.main :as lein])) 8 | 9 | (def min-lein-version "2.8.2") 10 | 11 | ;; Exists for the sole purpose of modifying the current project's metadata. 12 | ;; See https://github.com/technomancy/leiningen/blob/master/doc/PLUGINS.md#project-middleware 13 | (defn middleware 14 | [{:keys [dependencies exclusions] :as project}] 15 | (let [lein-version-ok? (lein/version-satisfies? (lein/leiningen-version) min-lein-version) 16 | clojure-excluded? (some #(= % 'org.clojure/clojure) exclusions) 17 | clojure-version (when-not clojure-excluded? 18 | (->> dependencies 19 | (some (fn [[id version & _]] 20 | (when (= id 'org.clojure/clojure) 21 | version))))) 22 | clojure-version-ok? (cond clojure-excluded? 23 | ;; In this case the onus is on the user. A warning will be emitted 24 | ;; later, but we assume that the user will provide an appropriate 25 | ;; implementation. 26 | true 27 | 28 | (nil? clojure-version) 29 | ;; Lein 2.8.3+ uses Clojure 1.8 by default, which would be OK. 30 | lein-version-ok? 31 | 32 | :else 33 | ;; There is a Clojure version depended on, it must check out. 34 | (lein/version-satisfies? clojure-version "1.8.0"))] 35 | 36 | (when-not lein-version-ok? 37 | (lein/warn "Warning: cider-nrepl requires Leiningen 2.8.3 or greater.")) 38 | (when-not clojure-version-ok? 39 | (lein/warn "Warning: cider-nrepl requires Clojure 1.8 or greater.")) 40 | (when clojure-excluded? 41 | (lein/warn "Warning: Clojure is excluded, assuming an appropriate fork (Clojure 1.8 or later) is provided.")) 42 | (when-not (and lein-version-ok? clojure-version-ok?) 43 | (lein/warn "Warning: cider-nrepl will not be included in your project.")) 44 | 45 | (cond-> project 46 | (and clojure-version-ok? lein-version-ok?) 47 | (-> (update-in [:dependencies] 48 | (fnil into []) 49 | [['cider/cider-nrepl version-string]]) 50 | (update-in [:repl-options :nrepl-middleware] 51 | (fnil into []) 52 | (do (require 'cider.nrepl) 53 | @(resolve 'cider.nrepl/cider-middleware))))))) 54 | -------------------------------------------------------------------------------- /test/common/cider/nrepl/test_session.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.test-session 2 | (:require 3 | [cider.nrepl :refer [cider-nrepl-handler]] 4 | [clojure.test :refer :all] 5 | [nrepl.core :as nrepl] 6 | [nrepl.server :refer [start-server]])) 7 | 8 | (def ^:dynamic *handler* cider-nrepl-handler) 9 | (def ^:dynamic *session* nil) 10 | 11 | (def ^:dynamic *server* nil) 12 | (def ^:dynamic *transport* nil) 13 | 14 | (defn repl-session! 15 | "Start an nREPL session and set *session* accordingly. 16 | 17 | Eval'ing this function in the REPL will allow you to test out messages 18 | with [[message]]. 19 | 20 | When dealing with tests that use [[session-fixture]], this can help you to be 21 | able to evaluate test forms in the REPL. Call [[close-session!]] when you're 22 | done." 23 | [] 24 | (let [server (start-server :handler *handler*) 25 | transport (nrepl/connect :port (:port server)) 26 | client (nrepl/client transport Long/MAX_VALUE)] 27 | (alter-var-root #'*server* (constantly server)) 28 | (alter-var-root #'*transport* (constantly transport)) 29 | (alter-var-root #'*session* (constantly (nrepl/client-session client))))) 30 | 31 | (defn close-session! 32 | "Stop the server/session created by [[repl-session!]], and reset the vars." 33 | [] 34 | (.close *server*) 35 | (.close *transport*) 36 | (alter-var-root #'*server* (constantly nil)) 37 | (alter-var-root #'*transport* (constantly nil)) 38 | (alter-var-root #'*session* (constantly nil))) 39 | 40 | (defn session-fixture 41 | [f] 42 | (with-open [server (start-server :handler *handler*) 43 | transport (nrepl/connect :port (:port server))] 44 | (let [client (nrepl/client transport Long/MAX_VALUE) 45 | session (nrepl/client-session client)] 46 | (binding [*server* server 47 | *transport* transport 48 | *session* session] 49 | (f))))) 50 | 51 | (defn message 52 | ([msg] (message msg true)) 53 | ([msg combine-responses?] 54 | (let [responses (nrepl/message *session* msg)] 55 | (if combine-responses? 56 | (nrepl/combine-responses responses) 57 | responses)))) 58 | 59 | (use-fixtures :each session-fixture) 60 | 61 | (deftest sanity-test 62 | (testing "eval works" 63 | (is (= ["(true false true false true false)"] 64 | (:value (message {:op :eval 65 | :code (nrepl/code (map even? (range 6)))}))))) 66 | 67 | (testing "unsupported op" 68 | (is (= #{"error" "unknown-op" "done"} 69 | (:status (message {:op "abcdefg"}))))) 70 | 71 | (testing "describe works" 72 | (let [response (message {:op :describe}) 73 | verbose-response (message {:op :describe 74 | :verbose? "true"})] 75 | (is (contains? response :ops)) 76 | (is (contains? verbose-response :ops))))) 77 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/undef_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.undef-test 2 | (:require 3 | [cider.nrepl.test-session :as session] 4 | [clojure.test :refer :all])) 5 | 6 | (use-fixtures :each session/session-fixture) 7 | 8 | (deftest undef-var-test 9 | (testing "undef undefines vars" 10 | (is (= ["#'user/x"] 11 | (:value (session/message {:op "eval" 12 | :code "(def x 1)"})))) 13 | (is (= ["#'user/x"] 14 | (:value (session/message {:op "eval" 15 | :code "(ns-resolve 'user 'x)"})))) 16 | (is (= #{"done"} 17 | (:status (session/message {:op "undef" 18 | :ns "user" 19 | :symbol "x"})))) 20 | (is (= ["nil"] 21 | (:value (session/message {:op "eval" 22 | :code "(ns-resolve 'user 'x)"})))))) 23 | 24 | (deftest undef-alias-test 25 | (testing "undef undefines aliases" 26 | (is (= ["#'clojure.walk/postwalk"] 27 | (:value (do 28 | (session/message {:op "eval" 29 | :code "(require '[clojure.walk :refer [postwalk]])"}) 30 | (session/message {:op "eval" 31 | :code "(ns-resolve 'user 'postwalk)"}))))) 32 | (is (= #{"done"} 33 | (:status (session/message {:op "undef" 34 | :ns "user" 35 | :symbol "postwalk"})))) 36 | (is (= ["nil"] 37 | (:value (session/message {:op "eval" 38 | :code "(ns-resolve 'user 'postwalk)"})))))) 39 | 40 | (deftest undef-undefined-test 41 | (testing "undef does not throw for aliases or vars that are not defined" 42 | (is (= ["nil"] 43 | (:value (session/message {:op "eval" 44 | :code "(ns-resolve 'user 'x)"})))) 45 | (is (= #{"done"} 46 | (:status (session/message {:op "undef" 47 | :ns "user" 48 | :symbol "x"})))))) 49 | 50 | (deftest undef-exceptions-test 51 | (testing "undef throws for non-existent namespaces" 52 | (is (= #{"done" "undef-error"} 53 | (:status (session/message {:op "undef" 54 | :ns "abc" 55 | :symbol "x"}))))) 56 | 57 | (testing "undef throws with missing arguments" 58 | (is (= #{"done" "undef-error"} 59 | (:status (session/message {:op "undef"})) 60 | (:status (session/message {:op "undef" :ns "user"})) 61 | (:status (session/message {:op "undef" :symbol "x"}))))) 62 | 63 | (testing "error handling" 64 | (let [response (session/message {:op "undef"})] 65 | (is (:pp-stacktrace response)) 66 | (is (:err response)) 67 | (is (:ex response))))) 68 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/profile_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.profile-test 2 | (:require 3 | [cider.nrepl.middleware.profile :refer :all] 4 | [cider.nrepl.test-transport :refer [test-transport]] 5 | [clojure.string :as str] 6 | [clojure.test :refer :all])) 7 | 8 | (defn with-clear-profile 9 | [f] 10 | (f) 11 | (clear-profile {:transport (test-transport)})) 12 | 13 | (use-fixtures :each with-clear-profile) 14 | 15 | (deftest toggle-profile-test 16 | (testing "profile toggling" 17 | (is (= [{:value "profiled" :status #{:done}}] 18 | (toggle-profile {:ns "clojure.core" :sym "zipmap" :transport (test-transport)}))) 19 | (is (= [{:value "unprofiled" :status #{:done}}] 20 | (toggle-profile {:ns "clojure.core" :sym "zipmap" :transport (test-transport)}))))) 21 | 22 | (deftest profile-var-summary-test 23 | (testing "Var profile sumary" 24 | (toggle-profile {:ns "clojure.core" :sym "zipmap" :transport (test-transport)}) 25 | (zipmap [:a :b :c] [1 2 3]) 26 | (let [[{:keys [err status]}] (profile-var-summary {:ns "clojure.core" 27 | :sym "zipmap" 28 | :transport (test-transport)})] 29 | (is (.startsWith err "#'clojure.core/zipmap")) 30 | (is (= #{:done} status))) 31 | (toggle-profile {:ns "clojure.core" :sym "zipmap" :transport (test-transport)}) 32 | (clear-profile {:transport (test-transport)})) 33 | 34 | (testing "No Var bound" 35 | (is (= [{:value "Var clojure.core/not-existent is not bound." :status #{:done}}] 36 | (profile-var-summary {:ns "clojure.core" :sym "not-existent" :transport (test-transport)}))))) 37 | 38 | (deftest toggle-profile-ns-test 39 | (testing "toggling profile ns" 40 | (is (= [{:value "profiled" :status #{:done}}] 41 | (toggle-profile-ns {:ns "clojure.string" :transport (test-transport)}))) 42 | (is (= [{:value "unprofiled" :status #{:done}}] 43 | (toggle-profile-ns {:ns "clojure.string" :transport (test-transport)})))) 44 | 45 | (testing "unbounding profile" 46 | (is (= [{:value "exception" :status #{:done}}] 47 | (toggle-profile-ns {:ns "my.ns" :transport (test-transport)}))))) 48 | 49 | (deftest is-var-profiled-test 50 | (testing "is var profiled" 51 | (toggle-profile {:ns "clojure.core" :sym "zipmap" :transport (test-transport)}) 52 | (is (= [{:value "profiled" :status #{:done}}] 53 | (is-var-profiled {:ns "clojure.core" :sym "zipmap" :transport (test-transport)}))) 54 | (toggle-profile {:ns "clojure.core" :sym "zipmap" :transport (test-transport)}) 55 | (is (= [{:value "unprofiled" :status #{:done}}] 56 | (is-var-profiled {:ns "clojure.core" :sym "zipmap" :transport (test-transport)}))))) 57 | 58 | (deftest set-max-examples-test 59 | (testing "max examples" 60 | (is (= [{:value "5000" :status #{:done}}] 61 | (set-max-samples {:max-samples 5000 :transport (test-transport)}))))) 62 | -------------------------------------------------------------------------------- /src/cider/nrepl/print_method.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.print-method 2 | "Extending `print-method` defined in clojure.core, to provide 3 | prettier versions of some objects. This applies to anything that 4 | calls `print-method`, which includes return values, `pr`, `print` 5 | and the likes." 6 | (:require 7 | [clojure.main :as main]) 8 | (:import 9 | [clojure.lang AFunction Atom MultiFn Namespace] 10 | java.io.Writer)) 11 | 12 | (def ^:dynamic *pretty-objects* 13 | "If true, cider prettifies some object descriptions. 14 | For instance, instead of printing functions as 15 | #object[clojure.core$_PLUS_ 0x4e648e99 \"clojure.core$_PLUS_@4e648e99\"] 16 | they are printed as 17 | #function[clojure.core/+] 18 | 19 | To disable this feature, do 20 | (alter-var-root #'cider.nrepl.print-method/*pretty-objects* not)" 21 | true) 22 | 23 | (defmacro def-print-method [dispatch-val arg & strings] 24 | `(defmethod print-method ~dispatch-val [~arg ~'^Writer w] 25 | (if *pretty-objects* 26 | (do ~@(map #(list '.write 'w %) strings)) 27 | (#'clojure.core/print-object ~arg ~'w)))) 28 | 29 | (defn- translate-class-name [c] 30 | (main/demunge (.getName (class c)))) 31 | 32 | ;;; Atoms 33 | ;; Ex: #atom[{:foo :bar} 0x54274a2b] 34 | (def-print-method Atom c 35 | "#atom[" 36 | (pr-str @c) 37 | (format " 0x%x]" (System/identityHashCode c))) 38 | 39 | ;;; Function objects 40 | ;; Ex: #function[cider.nrepl.print-method/multifn-name] 41 | (def-print-method AFunction c 42 | "#function[" 43 | (translate-class-name c) 44 | "]") 45 | 46 | ;;; Multimethods 47 | ;; Ex: #multifn[print-method 0x3f0cd5b4] 48 | (defn multifn-name [^MultiFn mfn] 49 | (let [field (.getDeclaredField MultiFn "name") 50 | private (not (.isAccessible field))] 51 | (when private 52 | (.setAccessible field true)) 53 | (let [name (.get field mfn)] 54 | (when private 55 | (.setAccessible field false)) 56 | name))) 57 | 58 | (def-print-method MultiFn c 59 | "#multifn[" 60 | (try (multifn-name c) 61 | (catch SecurityException _ 62 | (translate-class-name c))) 63 | ;; MultiFn names are not unique so we keep the identity HashCode to 64 | ;; make sure it's unique. 65 | (format " 0x%x]" (System/identityHashCode c))) 66 | 67 | ;;; Namespaces 68 | ;; Ex: #namespace[clojure.core] 69 | (def-print-method Namespace c 70 | "#namespace[" 71 | (format "%s" (ns-name c)) 72 | "]") 73 | 74 | ;;; Agents, futures, delays, promises, etc 75 | (defn- deref-name [c] 76 | (let [class-name (translate-class-name c)] 77 | (if-let [[_ short-name] (re-find #"^clojure\.lang\.([^.]+)" class-name)] 78 | (.toLowerCase short-name) 79 | (case (second (re-find #"^clojure\.core/(.+)/reify" class-name)) 80 | "future-call" "future" 81 | "promise" "promise" 82 | nil class-name)))) 83 | 84 | ;; `deref-as-map` is a private function, so let's be careful. 85 | (when-let [f (resolve 'clojure.core/deref-as-map)] 86 | (def-print-method clojure.lang.IDeref c 87 | "#" (deref-name c) "[" 88 | (pr-str (f c)) 89 | (format " 0x%x]" (System/identityHashCode c)))) 90 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/util/cljs.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.util.cljs) 2 | 3 | ;; there's a plan to rename the main namespace of 4 | ;; piggieback to piggieback.core and the following code 5 | ;; simply paves the way for this 6 | (def cider-piggieback? 7 | (try (require 'cider.piggieback) true 8 | (catch Throwable _ false))) 9 | 10 | (def nrepl-piggieback? 11 | (try (require 'piggieback.core) true 12 | (catch Throwable _ false))) 13 | 14 | (defn try-piggieback 15 | "If piggieback is loaded, returns `#'cider.piggieback/wrap-cljs-repl`, or 16 | false otherwise." 17 | [] 18 | (cond 19 | cider-piggieback? (resolve 'cider.piggieback/wrap-cljs-repl) 20 | nrepl-piggieback? (resolve 'piggieback.core/wrap-cljs-repl) 21 | :else false)) 22 | 23 | (defn- maybe-piggieback 24 | [descriptor descriptor-key] 25 | (if-let [piggieback (try-piggieback)] 26 | (update-in descriptor [descriptor-key] #(set (conj % piggieback))) 27 | descriptor)) 28 | 29 | (defn expects-piggieback 30 | "If piggieback is loaded, returns the descriptor with piggieback's 31 | `wrap-cljs-repl` handler assoc'd into its `:expects` set." 32 | [descriptor] 33 | (maybe-piggieback descriptor :expects)) 34 | 35 | (defn requires-piggieback 36 | "If piggieback is loaded, returns the descriptor with piggieback's 37 | `wrap-cljs-repl` handler assoc'd into its `:requires` set." 38 | [descriptor] 39 | (maybe-piggieback descriptor :requires)) 40 | 41 | (defn- cljs-env-path 42 | "Returns the path in the session map for the ClojureScript compiler 43 | environment used by piggieback." 44 | [] 45 | [(if nrepl-piggieback? 46 | (resolve 'piggieback.core/*cljs-compiler-env*) 47 | (resolve 'cider.piggieback/*cljs-compiler-env*))]) 48 | 49 | (defn- maybe-deref 50 | [x] 51 | (if (instance? clojure.lang.IDeref x) @x x)) 52 | 53 | (defn grab-cljs-env* 54 | [msg] 55 | (let [path (cljs-env-path)] 56 | (some-> msg 57 | :session 58 | maybe-deref 59 | (get-in path)))) 60 | 61 | (defn grab-cljs-env 62 | "If piggieback is active, returns the ClojureScript compiler environment for 63 | the running REPL." 64 | [msg] 65 | (maybe-deref (grab-cljs-env* msg))) 66 | 67 | (defn cljs-response-value 68 | "Returns the :value slot of an eval response from piggieback as a Clojure 69 | value." 70 | [response] 71 | (let [value (:value response)] 72 | (try 73 | (read-string value) 74 | (catch Exception _ 75 | value)))) 76 | 77 | (defn response-value 78 | "Returns the :value slot of an eval response as a Clojure value, reading the 79 | slot if necessary (piggieback 0.2.x)." 80 | [msg response] 81 | (if (grab-cljs-env msg) 82 | (cljs-response-value response) 83 | (:value response))) 84 | 85 | (defmacro with-cljs-env [msg & body] 86 | (try 87 | (require 'cljs.env) 88 | `(binding [cljs.env/*compiler* (grab-cljs-env* ~msg)] 89 | ~@body) 90 | (catch Exception _))) 91 | 92 | (defmacro with-cljs-ns [ns-sym & body] 93 | (try 94 | (require 'cljs.analyzer) 95 | `(binding [cljs.analyzer/*cljs-ns* ~ns-sym] 96 | ~@body) 97 | (catch Exception _))) 98 | -------------------------------------------------------------------------------- /test/spec/cider/nrepl/middleware/info_spec_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.info-spec-test 2 | (:require 3 | [cider.nrepl.test-session :as session] 4 | [clojure.spec.alpha :as s] 5 | [clojure.test :refer :all] 6 | [cider.test-ns.first-test-ns] 7 | [cider.test-ns.second-test-ns] 8 | [cider.test-ns.third-test-ns])) 9 | 10 | (defn ranged-rand 11 | "Returns random int in range start <= rand < end." 12 | [start end] 13 | (+ start (long (rand (- end start))))) 14 | 15 | (s/fdef ranged-rand 16 | :args (s/and (s/cat :start int? :end int?) 17 | #(< (:start %) (:end %))) 18 | :ret int? 19 | :fn (s/and #(>= (:ret %) (-> % :args :start)) 20 | #(< (:ret %) (-> % :args :end)))) 21 | 22 | (use-fixtures :each session/session-fixture) 23 | 24 | (deftest integration-test 25 | (testing "spec info on a normal function with spec" 26 | (let [response (session/message {:op "info" :symbol "ranged-rand" :ns "cider.nrepl.middleware.info-spec-test"})] 27 | (is (= (:status response) #{"done"})) 28 | (is (= (:ns response) "cider.nrepl.middleware.info-spec-test")) 29 | (is (= (:name response) "ranged-rand")) 30 | (is (= (:arglists-str response) "[start end]")) 31 | (is (nil? (:macro response))) 32 | (is (= (:doc response) "Returns random int in range start <= rand < end.")) 33 | (is (= (:spec response) ["clojure.spec.alpha/fspec" 34 | ":args" ["clojure.spec.alpha/and" 35 | ["clojure.spec.alpha/cat" ":start" "clojure.core/int?" ":end" "clojure.core/int?"] 36 | ["clojure.core/fn" ["%"] ["clojure.core/<" [":start" "%"] [":end" "%"]]]] 37 | ":ret" "clojure.core/int?" 38 | ":fn" ["clojure.spec.alpha/and" 39 | ["clojure.core/fn" ["%"] ["clojure.core/>=" [":ret" "%"] ["clojure.core/->" "%" ":args" ":start"]]] 40 | ["clojure.core/fn" ["%"] ["clojure.core/<" [":ret" "%"] ["clojure.core/->" "%" ":args" ":end"]]]]])))) 41 | (testing "same name testing function without a spec" 42 | ;; spec is not defined for this function 43 | (let [response (session/message {:op "info" :symbol "same-name-testing-function" :ns "cider.test-ns.first-test-ns"})] 44 | (is (= (:status response) #{"done"})) 45 | (is (= (:ns response) "cider.test-ns.first-test-ns")) 46 | (is (= (:name response) "same-name-testing-function")) 47 | (is (= (:arglists-str response) "[]")) 48 | (is (nil? (:macro response))) 49 | (is (= (:doc response) "Multiple vars with the same name in different ns's. Used to test ns-list-vars-by-name.")) 50 | (is (nil? (:spec response))))) 51 | 52 | (testing "spec info on clojure.core/let" 53 | (let [response (session/message {:op "info" :symbol "let" :ns "cider.nrepl.middleware.info-spec-test"})] 54 | (is (= (:status response) #{"done"})) 55 | (is (= (:ns response) "clojure.core")) 56 | (is (= (:name response) "let")) 57 | (is (= (:spec response) ["clojure.spec.alpha/fspec" 58 | ":args" ["clojure.spec.alpha/cat" 59 | ":bindings" ":clojure.core.specs.alpha/bindings" 60 | ":body" ["clojure.spec.alpha/*" "clojure.core/any?"]] 61 | ":ret" "clojure.core/any?" ":fn" ""]))))) 62 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/apropos_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.apropos-test 2 | (:require 3 | [cider.nrepl.middleware.apropos :refer [apropos]] 4 | [cider.nrepl.test-session :as session] 5 | [clojure.string :as str] 6 | [clojure.test :refer :all])) 7 | 8 | (def ^:private ^{:doc "Can't. See. Me"} my-private-var [:a :b :c]) 9 | 10 | (use-fixtures :each session/session-fixture) 11 | 12 | (deftest integration-test 13 | (testing "Apropos op, typical case" 14 | (let [response (session/message {:op "apropos" :query "handle-apropos"}) 15 | match (get-in response [:apropos-matches 0])] 16 | (is (= (:status response) #{"done"})) 17 | (is (= (:type match) "function")) 18 | (is (= (:name match) "cider.nrepl.middleware.apropos/handle-apropos")))) 19 | 20 | (testing "Apropos op, but specialized cases (invoked with prefix argument)" 21 | (testing "Fails to get a private var because private? unset" 22 | (let [response (session/message {:op "apropos" :query "my-private-var"}) 23 | match (get-in response [:apropos-matches 0])] 24 | (is (= (:status response) #{"done"})) 25 | (is (empty? match)))) 26 | 27 | (testing "Gets a private var using a case insensitive query" 28 | (let [response (session/message {:op "apropos" :query "My-Private-Var" :privates? "t"}) 29 | match (get-in response [:apropos-matches 0])] 30 | (is (= (:status response) #{"done"})) 31 | (is (= (:type match) "variable")) 32 | (is (= (:name match) "cider.nrepl.middleware.apropos-test/my-private-var")) 33 | (is (= (:doc match) "Can't.")))) 34 | 35 | (testing "Fails to get a private var due to case-mismatch in a case sensitive query" 36 | (let [response (session/message {:op "apropos" 37 | :query "My-Private-Var" 38 | :privates? "t" 39 | :case-sensitive? "t"}) 40 | match (get-in response [:apropos-matches 0])] 41 | (is (= (:status response) #{"done"})) 42 | (is (empty? match)))) 43 | 44 | (testing "Finds a public macro via a case-insensitive search through the docs" 45 | (let [doc-query "threads the expr through the forms" 46 | response (session/message {:op "apropos" :query doc-query :docs? "t"}) 47 | match (get-in response [:apropos-matches 0])] 48 | (is (= (:status response) #{"done"})) 49 | (is (= (:type match) "macro")) 50 | (is (= (:name match) "clojure.core/->")) 51 | (is (.startsWith (:doc match) (str/capitalize doc-query))))))) 52 | 53 | (deftest error-handling-test 54 | (testing "Handles a fake error done via mocked function" 55 | (with-redefs [apropos 56 | (fn [args] (throw (Exception. "boom")))] 57 | (let [response (session/message {:op "apropos" :query "doesn't matter"})] 58 | (is (= (:status response) #{"apropos-error" "done"})) 59 | (is (= (:ex response) "class java.lang.Exception")) 60 | (is (.startsWith (:err response) "java.lang.Exception: boom")) 61 | (is (:pp-stacktrace response))))) 62 | 63 | (testing "Handles a real error caused by an improper regular expression" 64 | (let [response (session/message {:op "apropos" :query "*illegal"})] 65 | (is (= (:status response) #{"apropos-error" "done"})) 66 | (is (.startsWith (:err response) "java.util.regex.PatternSyntaxException: Dangling")) 67 | (is (:pp-stacktrace response))))) 68 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/util/error_handling_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.util.error-handling-test 2 | (:require 3 | [cider.nrepl.middleware.util.error-handling :as err] 4 | [cider.nrepl.test-transport :as tt] 5 | [clojure.test :refer :all])) 6 | 7 | (deftest op-handler-test 8 | (is (= {:id 5 :status #{:test :done}} (err/op-handler :test {:id 5}))) 9 | (is (= {:id 5 :status #{:more :than :one :done}} (err/op-handler [:more :than :one] {:id 5}))) 10 | (is (= {:id 5 :anon 6 :status #{:done}} (err/op-handler (fn [m] {:anon (inc (:id m))}) {:id 5}))) 11 | (is (= {:id 5 :inline :reply :status #{:done}} (err/op-handler {:inline :reply} {:id 5})))) 12 | 13 | (deftest error-handler-test 14 | (let [e (Exception. "testing")] 15 | (is (err/error-handler :done {:id 5} e)) 16 | (is (err/error-handler [:more :than :one] {:id 5} e)) 17 | (is (err/error-handler (fn [m e] {:anon (inc (:id m))}) {:id 5} e)) 18 | (is (err/error-handler {:inline :reply} {:id 5} e)))) 19 | 20 | (deftest bencode-test 21 | (testing "shallow-bencodable?" 22 | (let [bencodable? #'err/shallow-bencodable?] 23 | (is (bencodable? nil)) 24 | (is (bencodable? 1)) 25 | (is (not (bencodable? 1.2))) 26 | (is (not (bencodable? 1/2))) 27 | (is (bencodable? (byte-array [(byte 0x43) (byte 0x6c) (byte 0x6f)]))) 28 | (is (bencodable? (boolean-array [false true false]))) 29 | (is (bencodable? "string")) 30 | (is (bencodable? :kw)) 31 | (is (bencodable? 'x)) 32 | (is (bencodable? {:a :map})) 33 | (is (bencodable? [:a :vector 1 2 3])) 34 | (is (bencodable? '(:a :list))) 35 | (is (bencodable? #{:a :set})) 36 | (is (not (bencodable? *ns*))) 37 | (is (bencodable? [*ns*]) "This should pass since the function only does a shallow test."))) 38 | 39 | (testing "deep-bencodable-or-fail" 40 | (let [deep-bencodable? #'err/deep-bencodable-or-fail] 41 | (is (deep-bencodable? nil)) 42 | (is (deep-bencodable? 1)) 43 | (is (thrown? IllegalArgumentException (deep-bencodable? 1.2))) 44 | (is (thrown? IllegalArgumentException (deep-bencodable? 1/2))) 45 | (is (deep-bencodable? (byte-array [(byte 0x43) (byte 0x6c) (byte 0x6f)]))) 46 | (is (deep-bencodable? (boolean-array [false true false]))) 47 | (is (deep-bencodable? "string")) 48 | (is (deep-bencodable? :kw)) 49 | (is (deep-bencodable? 'x)) 50 | (is (deep-bencodable? {:a :map})) 51 | (is (deep-bencodable? [:a :vector 1 2 3])) 52 | (is (deep-bencodable? [:a :vector 1 {:a :map} 2 '(:a :list) 3])) 53 | (is (deep-bencodable? '(:a :list))) 54 | (is (deep-bencodable? #{:a :set})) 55 | (is (thrown? IllegalArgumentException (deep-bencodable? *ns*))) 56 | (is (thrown? IllegalArgumentException (deep-bencodable? [*ns*]))) 57 | (is (thrown? IllegalArgumentException (deep-bencodable? [1 2 3 4 *ns*]))) 58 | (is (deep-bencodable? [:a :vector 1 {:a :map} 2 '(:a {:bad-map *ns*} :list) 3]) 59 | "Should pass since *ns* is inside a quoted list and doesn't get evaluated") 60 | (is (thrown? IllegalArgumentException (deep-bencodable? [:a :vector 1 {:a :map} 2 [:sub :vec :bad *ns*] '(:a :list) 3])))))) 61 | 62 | (deftest error-handler-root-ex 63 | (let [e (Exception. "testing" (Throwable. "root-cause")) 64 | e2 (Exception. "testing2")] 65 | (is (= "class java.lang.Throwable" 66 | (:root-ex (err/error-handler :done {:id 1} e)))) 67 | (is (= "class java.lang.Exception" 68 | (:root-ex (err/error-handler :done {:id 2} e2)))))) 69 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/trace_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.trace-test 2 | (:require 3 | [cider.nrepl.middleware.trace :refer :all] 4 | [cider.nrepl.test-session :as session] 5 | [clojure.test :refer :all] 6 | [cider.test-ns.first-test-ns])) 7 | 8 | (use-fixtures :each session/session-fixture) 9 | 10 | (deftest toggle-trace-var-test 11 | (testing "toggling" 12 | (is (= {:var-name "#'clojure.core/zipmap" :var-status "traced"} 13 | (toggle-trace-var {:ns "clojure.core" :sym "zipmap"}))) 14 | (is (= {:var-name "#'clojure.core/zipmap" :var-status "untraced"} 15 | (toggle-trace-var {:ns "clojure.core" :sym "zipmap"})))) 16 | 17 | (testing "misses" 18 | (testing "toggle-trace-var-op unresolvable, should return `not-found`" 19 | (is (= {:var-status "not-found" :status #{:toggle-trace-error :done}} 20 | (toggle-trace-var {:ns "clojure.core" :sym "mappp"})))) 21 | 22 | (testing "toggle-trace-var-op not traceable var, should return `not-traceable`" 23 | (is (= {:var-name "#'clojure.core/and" :var-status "not-traceable"} 24 | (toggle-trace-var {:ns "clojure.core" :sym "and"})))))) 25 | 26 | (deftest toggle-trace-ns-test 27 | (testing "toggling" 28 | (is (= {:ns-status "traced"} 29 | (toggle-trace-ns {:ns "clojure.core"}))) 30 | (is (= {:ns-status "untraced"} 31 | (toggle-trace-ns {:ns "clojure.core"})))) 32 | 33 | (testing "toggle-trace-ns-op missing ns should return `not-found`" 34 | (is (= {:ns-status "not-found"} 35 | (toggle-trace-ns {:ns "clojure.corex"}))))) 36 | 37 | (deftest integration-tests-var 38 | (testing "toggling" 39 | (let [on (session/message {:op "toggle-trace-var" 40 | :ns "cider.test-ns.first-test-ns" 41 | :sym "same-name-testing-function"}) 42 | off (session/message {:op "toggle-trace-var" 43 | :ns "cider.test-ns.first-test-ns" 44 | :sym "same-name-testing-function"})] 45 | (is (= (:status on) (:status off) #{"done"})) 46 | (is (= (:var-name on) (:var-name off) "#'cider.test-ns.first-test-ns/same-name-testing-function")) 47 | (is (= (:var-status on) "traced")) 48 | (is (= (:var-status off) "untraced")))) 49 | 50 | (testing "unresolvable" 51 | (let [var-err (session/message {:op "toggle-trace-var" 52 | :ns "cider.test-ns.first-test-ns" 53 | :sym "missing"}) 54 | ns-err (session/message {:op "toggle-trace-var" 55 | :ns "cider.test-ns.no-such-ns" 56 | :sym "same-name-testing-function"})] 57 | (is (= (:status var-err) (:status ns-err) #{"toggle-trace-error" "done"})) 58 | (is (:var-status var-err) "not-found")))) 59 | 60 | (deftest integration-test-ns 61 | (testing "toggling" 62 | (let [on (session/message {:op "toggle-trace-ns" 63 | :ns "cider.test-ns.first-test-ns"}) 64 | off (session/message {:op "toggle-trace-ns" 65 | :ns "cider.test-ns.first-test-ns"})] 66 | (is (= (:status on) (:status off) #{"done"})) 67 | (is (= (:ns-status on) "traced")) 68 | (is (= (:ns-status off) "untraced"))) 69 | 70 | (let [ns-err (session/message {:op "toggle-trace-ns" 71 | :ns "cider.test-ns.missing"})] 72 | (is (= (:status ns-err) #{"done"})) 73 | (is (= (:ns-status ns-err) "not-found"))))) 74 | -------------------------------------------------------------------------------- /test/smoketest/src/smoketest/core.clj: -------------------------------------------------------------------------------- 1 | (ns smoketest.core 2 | (:require 3 | [nrepl.core :as nrepl] 4 | [nrepl.server :refer [start-server]] 5 | [clojure.pprint]) 6 | (:gen-class)) 7 | 8 | ;; The cider-nrepl "smoke test" replicates a small sampling of the 9 | ;; library's unit test coverage executing in an uberjar. The point of 10 | ;; this test is to confirm the cider-nrepl artifact compiles, 11 | ;; installs, and can be used in a standalone jar. Comprehensive test 12 | ;; coverage is not a goal of this smoke test. 13 | 14 | 15 | ;; see cider-nrepl issue #447 16 | (defn nrepl-handler [] 17 | (require 'cider.nrepl) 18 | (ns-resolve 'cider.nrepl 'cider-nrepl-handler)) 19 | 20 | (defn nrepl-server-fixture 21 | "Derived from the cider-nrepl test fixture. Launch the nrepl server, 22 | establish a client session, and call the function f with the client 23 | session as its sole argument." 24 | [f] 25 | (with-open [server (start-server :bind "localhost" :handler (nrepl-handler)) 26 | ;; for now binding "localhost" circumvents the bug 27 | ;; https://dev.clojure.org/jira/browse/NREPL-87 28 | transport (nrepl/connect :port (:port server))] 29 | (let [client (nrepl/client transport Long/MAX_VALUE) 30 | session (nrepl/client-session client)] 31 | (f session)))) 32 | 33 | (defn message 34 | "Send message to session and return the combined response." 35 | [session msg] 36 | (let [responses (nrepl/message session msg)] 37 | (nrepl/combine-responses responses))) 38 | 39 | ;; Tests are lifted from the unit test coverage and rewritten to 40 | ;; execute without the clojure.test framework. This results in some 41 | ;; repetition but keeps this smoke test simple and lightweight. 42 | 43 | (defn check-version 44 | "Call version middleware and check response." 45 | [session] 46 | ;; This test generates reflection warnings in java9, but passes. 47 | (let [response (message session {:op :cider-version}) 48 | version-map (:cider-version response)] 49 | (and (= #{"done"} (:status response)) 50 | (contains? version-map :major) 51 | (contains? version-map :minor) 52 | (contains? version-map :incremental) 53 | (contains? version-map :version-string)))) 54 | 55 | (defn check-classpath 56 | "Call classpath middleware and check response." 57 | [session] 58 | (let [response (message session {:op :classpath}) 59 | classpaths (:classpath response)] 60 | (and (= (:status response) #{"done"}) 61 | (> (count classpaths) 0) 62 | (every? string? classpaths) 63 | (some? (some #(re-find #".*smoketest-.*standalone\.jar" %) classpaths))))) 64 | 65 | (defn check-ns-path 66 | "Call ns middleware and check response." 67 | [session] 68 | (let [response (message session {:op :ns-path :ns "cider.nrepl"}) 69 | ns-path (:path response)] 70 | (.endsWith ns-path "cider/nrepl.clj"))) 71 | 72 | 73 | ;; For simplistic reporting: {"test1" true, "test2" false, ... } 74 | 75 | (def testnames ["check-version" 76 | "check-classpath" 77 | "check-ns-path"]) 78 | 79 | (def tests (apply juxt (map (comp resolve symbol) testnames))) 80 | 81 | (defn -main 82 | "Execute all smoke tests and exit 0 (or 1) to signal 83 | success (or failure) to CI." 84 | [] 85 | (let [results (nrepl-server-fixture tests)] 86 | (clojure.pprint/pprint (zipmap testnames results)) 87 | (shutdown-agents) 88 | (when-not (every? identity results) 89 | (println "smoketest: FAIL") 90 | (System/exit 1))) 91 | (println "smoketest: OK")) 92 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/enlighten.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.enlighten 2 | "Instrument user code to \"light up\" when it runs. 3 | The instrumented code will report the value of local variables and 4 | report its return value. 5 | Implemented as an extension of the debugger." 6 | {:author "Artur Malabarba"} 7 | (:require 8 | [cider.nrepl.middleware.debug :as d] 9 | [cider.nrepl.middleware.util.instrument :as ins])) 10 | 11 | (defn pr-very-short [val] 12 | (binding [*print-length* 3, *print-level* 2] 13 | (pr-str val))) 14 | 15 | (defn send-if-local 16 | "If locals contains sym, send its value over the debug channel. 17 | The value is added to `extras` under :debug-value, and `extras` is 18 | sent over the debug channel with the :enlighten status." 19 | [sym extras locals] 20 | (when (contains? locals sym) 21 | ;; Enlightened values are inlined, so let's keep them short. 22 | (->> (locals sym) pr-very-short 23 | (assoc extras :status :enlighten 24 | :erase-previous :true 25 | :debug-value) 26 | d/debugger-send))) 27 | 28 | (defn wrap-function-form 29 | "Wrap a form representing a function/macro/special-form call. 30 | Return an equivalent form, instrumented to work with enlighten. 31 | 32 | Currently this only instruments forms that could run several times 33 | in a single evaluation. This is necessary so that the client can 34 | clean-up overlays from previous evaluations." 35 | [[head & args :as form] {:keys [coor] :as extras}] 36 | (let [erase `(d/debugger-send (assoc (:msg ~'STATE__) 37 | :coor ~coor 38 | :status :enlighten 39 | :erase-previous :true))] 40 | (case head 41 | ;; This is still compile-time, so return a form, not a function. 42 | fn* `#(do ~erase (apply ~form %&)) 43 | ;; `defn` expands to `(def name (fn ...))`. 44 | def (let [[name val] args] 45 | (if (and (seq? val) (= 'fn* (first val))) 46 | (list head name 47 | `#(do ~erase 48 | (let [out# (apply ~val %&)] 49 | ;; `defn` is the only non-symbol form that we enlighten. 50 | (->> (assoc (:msg ~'STATE__) 51 | :coor ~coor 52 | :status :enlighten 53 | :debug-value (pr-very-short out#)) 54 | d/debugger-send) 55 | out#))) 56 | form)) 57 | ;; Ensure that any `recur`s remain in the tail position. 58 | loop* (list* head (first args) erase (rest args)) 59 | ;; Else. 60 | form))) 61 | 62 | (defmacro light-form 63 | "Return the result of form, and maybe enlighten it." 64 | [form {:keys [coor] :as extras} original-form] 65 | (cond 66 | (symbol? original-form) `(do 67 | (send-if-local '~original-form 68 | (assoc (:msg ~'STATE__) :coor ~coor) 69 | ~(d/sanitize-env &env)) 70 | ~form) 71 | (seq? form) (wrap-function-form form extras) 72 | :else form)) 73 | 74 | (defn light-reader [form] 75 | (ins/tag-form-recursively form #'light-form)) 76 | 77 | ;;; Middleware 78 | (defn eval-with-enlighten 79 | "Like `eval`, but also enlighten code." 80 | [form] 81 | (let [form1 `(d/with-initial-debug-bindings 82 | ~(ins/instrument-tagged-code (light-reader form)))] 83 | ;; (ins/print-form form1 true) 84 | (eval form1))) 85 | 86 | (defn handle-enlighten 87 | [h {:keys [op enlighten] :as msg}] 88 | (if (and (= op "eval") enlighten) 89 | (h (assoc msg :eval "cider.nrepl.middleware.enlighten/eval-with-enlighten")) 90 | (h msg))) 91 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/ns.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.ns 2 | (:refer-clojure :exclude [ns-aliases]) 3 | (:require 4 | [cider.nrepl.middleware.util.cljs :as cljs] 5 | [cider.nrepl.middleware.util.error-handling :refer [with-safe-transport]] 6 | [cider.nrepl.middleware.util.meta :as um] 7 | [cljs-tooling.info :as cljs-info] 8 | [cljs-tooling.util.analysis :as cljs-analysis] 9 | [orchard.misc :as u] 10 | [orchard.namespace :as ns])) 11 | 12 | (defn ns-list-vars-by-name 13 | "Return a list of vars named `name` amongst all namespaces. 14 | `name` is a symbol." 15 | [name] 16 | (->> (mapcat ns-interns (all-ns)) 17 | (filter #(= (first %) name)) 18 | (map second))) 19 | 20 | (defn ns-vars-clj [ns] 21 | (->> (symbol ns) 22 | ns-publics 23 | keys 24 | (map name) 25 | sort)) 26 | 27 | (defn ns-vars-with-meta-clj [ns] 28 | (->> (symbol ns) 29 | ns-interns 30 | (u/update-vals (comp um/relevant-meta meta)) 31 | (u/update-keys name) 32 | (into (sorted-map)))) 33 | 34 | (defn ns-list-cljs [env] 35 | (->> (cljs-analysis/all-ns env) 36 | keys 37 | (map name) 38 | sort)) 39 | 40 | (defn ns-vars-cljs [env ns] 41 | (->> (symbol ns) 42 | (cljs-analysis/public-vars env) 43 | keys 44 | (map name) 45 | sort)) 46 | 47 | (defn ns-vars-with-meta-cljs [env ns] 48 | (->> (symbol ns) 49 | (cljs-analysis/public-vars env) 50 | (u/update-vals (comp um/relevant-meta :meta)) 51 | (u/update-keys name) 52 | (into (sorted-map)))) 53 | 54 | (defn ns-path-cljs [env ns] 55 | (->> (symbol ns) 56 | (cljs-info/info env) 57 | (:file))) 58 | 59 | (defn ns-list [{:keys [filter-regexps] :as msg}] 60 | (if-let [cljs-env (cljs/grab-cljs-env msg)] 61 | (ns-list-cljs cljs-env) 62 | (ns/loaded-namespaces filter-regexps))) 63 | 64 | (defn ns-vars [{:keys [ns] :as msg}] 65 | (if-let [cljs-env (cljs/grab-cljs-env msg)] 66 | (ns-vars-cljs cljs-env ns) 67 | (ns-vars-clj ns))) 68 | 69 | (defn ns-vars-with-meta [{:keys [ns] :as msg}] 70 | (if-let [cljs-env (cljs/grab-cljs-env msg)] 71 | (ns-vars-with-meta-cljs cljs-env ns) 72 | (ns-vars-with-meta-clj ns))) 73 | 74 | (defn ns-path [{:keys [ns] :as msg}] 75 | (if-let [cljs-env (cljs/grab-cljs-env msg)] 76 | (ns-path-cljs cljs-env ns) 77 | (ns/ns-path ns))) 78 | 79 | (defn ns-list-reply [msg] 80 | {:ns-list (ns-list msg)}) 81 | 82 | (defn ns-list-vars-by-name-reply [{:keys [name] :as msg}] 83 | {:var-list (pr-str (ns-list-vars-by-name (symbol name)))}) 84 | 85 | (defn ns-vars-reply 86 | [msg] 87 | {:ns-vars (ns-vars msg)}) 88 | 89 | (defn ns-vars-with-meta-reply 90 | [msg] 91 | {:ns-vars-with-meta (ns-vars-with-meta msg)}) 92 | 93 | (defn- ns-path-reply [msg] 94 | {:path (ns-path msg)}) 95 | 96 | (defn- ns-load-all-reply 97 | [msg] 98 | {:loaded-ns (ns/load-project-namespaces)}) 99 | 100 | (defn- ns-aliases-clj [ns] 101 | (->> (symbol ns) 102 | clojure.core/ns-aliases 103 | (u/update-vals ns-name) 104 | u/transform-value)) 105 | 106 | (defn- ns-aliases-cljs [env ns] 107 | (->> (cljs-analysis/ns-aliases env ns) 108 | (remove (fn [[k v]] (= k v))) 109 | (into {}) 110 | u/transform-value)) 111 | 112 | (defn ns-aliases [{:keys [ns] :as msg}] 113 | (if-let [cljs-env (cljs/grab-cljs-env msg)] 114 | (ns-aliases-cljs cljs-env ns) 115 | (ns-aliases-clj ns))) 116 | 117 | (defn- ns-aliases-reply [msg] 118 | {:ns-aliases (ns-aliases msg)}) 119 | 120 | (defn handle-ns [handler msg] 121 | (with-safe-transport handler msg 122 | "ns-list" ns-list-reply 123 | "ns-list-vars-by-name" ns-list-vars-by-name-reply 124 | "ns-vars" ns-vars-reply 125 | "ns-vars-with-meta" ns-vars-with-meta-reply 126 | "ns-path" ns-path-reply 127 | "ns-load-all" ns-load-all-reply 128 | "ns-aliases" ns-aliases-reply)) 129 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/inspect.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.inspect 2 | (:require 3 | [cider.nrepl.middleware.util.cljs :as cljs] 4 | [cider.nrepl.middleware.util.error-handling :refer [base-error-response 5 | with-safe-transport]] 6 | [nrepl.misc :refer [response-for]] 7 | [nrepl.transport :as transport] 8 | [orchard.inspect :as inspect]) 9 | (:import 10 | nrepl.transport.Transport)) 11 | 12 | (def ^:dynamic *inspector* (inspect/fresh)) 13 | 14 | (defn swap-inspector! 15 | [{:keys [session] :as msg} f & args] 16 | (-> session 17 | (swap! update-in [#'*inspector*] #(apply f % args)) 18 | (get #'*inspector*))) 19 | 20 | (defn inspect-reply 21 | [{:keys [page-size transport] :as msg} eval-response] 22 | (let [value (cljs/response-value msg eval-response) 23 | page-size (or page-size 32) 24 | inspector (swap-inspector! msg #(-> (assoc % :page-size page-size) 25 | (inspect/start value)))] 26 | (binding [*print-length* nil] 27 | ;; Remove print-length limit because it breaks the output in the middle of 28 | ;; the page when inspecting long sequences. 29 | (transport/send 30 | transport 31 | (response-for msg :value (:rendered inspector)))))) 32 | 33 | (defn inspector-transport 34 | [{:keys [^Transport transport, session] :as msg}] 35 | (reify Transport 36 | (recv [this] (.recv transport)) 37 | (recv [this timeout] (.recv transport timeout)) 38 | (send [this response] 39 | (cond (contains? response :value) 40 | (inspect-reply msg response) 41 | 42 | ;; If the eval errored, propagate the exception as error in the 43 | ;; inspector middleware, so that the client CIDER code properly 44 | ;; renders it instead of silently ignoring it. 45 | (contains? (:status response) :eval-error) 46 | (let [e (or (@session #'*e) 47 | (Exception. (or (:ex response) ""))) 48 | resp (base-error-response msg e :inspect-eval-error :done)] 49 | (.send transport resp)) 50 | 51 | :else (.send transport response)) 52 | this))) 53 | 54 | (defn eval-msg 55 | [{:keys [inspect] :as msg}] 56 | (if inspect 57 | (assoc msg :transport (inspector-transport msg)) 58 | msg)) 59 | 60 | (defn eval-reply 61 | [handler msg] 62 | (handler (eval-msg msg))) 63 | 64 | (defn- inspector-response [msg inspector] 65 | (response-for msg :value (:rendered inspector) :status :done)) 66 | 67 | (defn pop-reply [msg] 68 | (inspector-response msg (swap-inspector! msg inspect/up))) 69 | 70 | (defn push-reply [msg] 71 | (inspector-response msg (swap-inspector! msg inspect/down (:idx msg)))) 72 | 73 | (defn refresh-reply [msg] 74 | (inspector-response msg (swap-inspector! msg #(or % (inspect/fresh))))) 75 | 76 | (defn get-path-reply [{:keys [session] :as msg}] 77 | (:path (get session #'*inspector*))) 78 | 79 | (defn next-page-reply [msg] 80 | (inspector-response msg (swap-inspector! msg inspect/next-page))) 81 | 82 | (defn prev-page-reply [msg] 83 | (inspector-response msg (swap-inspector! msg inspect/prev-page))) 84 | 85 | (defn set-page-size-reply [msg] 86 | (inspector-response msg (swap-inspector! msg inspect/set-page-size (:page-size msg)))) 87 | 88 | (defn clear-reply [msg] 89 | (inspector-response msg (swap-inspector! msg (constantly (inspect/fresh))))) 90 | 91 | (defn handle-inspect [handler msg] 92 | (if (= (:op msg) "eval") 93 | (eval-reply handler msg) 94 | 95 | (with-safe-transport handler msg 96 | "inspect-pop" pop-reply 97 | "inspect-push" push-reply 98 | "inspect-refresh" refresh-reply 99 | "inspect-get-path" get-path-reply 100 | "inspect-next-page" next-page-reply 101 | "inspect-prev-page" prev-page-reply 102 | "inspect-set-page-size" set-page-size-reply 103 | "inspect-clear" clear-reply))) 104 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/complete_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.complete-test 2 | (:require 3 | [cider.nrepl.middleware.complete :as c] 4 | [cider.nrepl.test-session :as session] 5 | [clojure.test :refer :all])) 6 | 7 | (use-fixtures :each session/session-fixture) 8 | 9 | (deftest complete 10 | (testing "blank" 11 | (let [response (session/message {:op "complete" 12 | :ns "user" 13 | :symbol ""})] 14 | (is (= #{"done"} (:status response))) 15 | (is (sequential? (:completions response))) 16 | (is (every? map? (:completions response))))) 17 | 18 | (testing "basic usage" 19 | (let [response (session/message {:op "complete" 20 | :ns "user" 21 | :symbol "filt"})] 22 | (is (= #{"filter" "filterv"} (->> response 23 | :completions 24 | (map :candidate) 25 | set))) 26 | 27 | (is (= #{"clojure.core"} (->> response 28 | :completions 29 | (map :ns) 30 | set))) 31 | 32 | (is (= #{"done"} (:status response))))) 33 | 34 | (testing "function arglists" 35 | (let [response (session/message {:op "complete" 36 | :ns "user" 37 | :symbol "unchecked-a" 38 | :extra-metadata ["arglists"]})] 39 | (is (= {:arglists '("[x y]") :ns "clojure.core", :candidate "unchecked-add", :type "function"} 40 | (first (:completions response)))))) 41 | 42 | (testing "function metadata" 43 | (let [response (session/message {:op "complete" 44 | :ns "user" 45 | :symbol "assoc" 46 | :extra-metadata ["arglists" "doc"]}) 47 | candidate (first (:completions response))] 48 | (is (= '("[map key val]" "[map key val & kvs]") (:arglists candidate))) 49 | (is (string? (:doc candidate))))) 50 | 51 | (testing "macro metadata" 52 | (let [response (session/message {:op "complete" 53 | :ns "user" 54 | :symbol "defprot" 55 | :extra-metadata ["arglists" "doc"]}) 56 | candidate (first (:completions response))] 57 | (is (= '("[name & opts+sigs]") (:arglists candidate))) 58 | (is (string? (:doc candidate)))))) 59 | 60 | (deftest complete-doc-test 61 | (testing "blank" 62 | (let [response (session/message {:op "complete-doc" :symbol ""})] 63 | (is (= #{"done"} (:status response))) 64 | (is (nil? (:completions response))))) 65 | 66 | (testing "basic usage" 67 | (let [response (session/message {:op "complete-doc" :symbol "true?"})] 68 | (is (= (:status response) #{"done"})) 69 | (is (.startsWith (:completion-doc response) "clojure.core/true?\n([x"))))) 70 | 71 | (deftest complete-flush-caches-test 72 | (testing "basic usage" 73 | (let [response (session/message {:op "complete-flush-caches"})] 74 | (is (= (:status response) #{"done"}))))) 75 | 76 | (deftest error-handling-test 77 | (testing "complete op error handling" 78 | (with-redefs [c/complete (fn [& _] (throw (Exception. "complete-exc")))] 79 | (let [response (session/message {:op "complete" :ns "doesn't matter" :symbol "fake"})] 80 | (is (= (:ex response) "class java.lang.Exception")) 81 | (is (= (:status response) #{"complete-error" "done"})) 82 | (is (.startsWith (:err response) "java.lang.Exception: complete-exc")) 83 | (is (:pp-stacktrace response))))) 84 | 85 | (testing "complete-doc op error handling" 86 | (with-redefs [c/completion-doc (fn [& _] (throw (Exception. "complete-doc-exc")))] 87 | (let [response (session/message {:op "complete-doc" :symbol "doesn't matter"})] 88 | (is (= (:ex response) "class java.lang.Exception")) 89 | (is (= (:status response) #{"complete-doc-error" "done"})) 90 | (is (.startsWith (:err response) "java.lang.Exception: complete-doc-exc")) 91 | (is (:pp-stacktrace response)))))) 92 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/info.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.info 2 | (:require 3 | [cider.nrepl.middleware.util.cljs :as cljs] 4 | [cider.nrepl.middleware.util.error-handling :refer [with-safe-transport]] 5 | [cljs-tooling.info :as cljs-info] 6 | [clojure.java.io :as io] 7 | [clojure.string :as str] 8 | [orchard.eldoc :as eldoc] 9 | [orchard.info :as clj-info] 10 | [orchard.misc :as u])) 11 | 12 | (declare format-response) 13 | 14 | (defn format-nested 15 | "Apply response formatting to nested `:candidates` info for Java members." 16 | [info] 17 | (if-let [candidates (:candidates info)] 18 | (assoc info :candidates 19 | (zipmap (keys candidates) 20 | (->> (vals candidates) (map format-response)))) 21 | info)) 22 | 23 | (defn blacklist 24 | "Remove anything that might contain arbitrary EDN, metadata can hold anything" 25 | [info] 26 | (let [blacklisted #{:arglists :forms}] 27 | (apply dissoc info blacklisted))) 28 | 29 | (defn format-response 30 | [info] 31 | (letfn [(forms-join [forms] 32 | (->> (map pr-str forms) 33 | (str/join \newline)))] 34 | (when info 35 | (-> info 36 | (merge (when-let [ns (:ns info)] 37 | {:ns (str ns)}) 38 | (when-let [args (:arglists info)] 39 | {:arglists-str (forms-join args)}) 40 | (when-let [forms (:forms info)] 41 | {:forms-str (forms-join forms)}) 42 | (when-let [file (:file info)] 43 | (clj-info/file-info file)) 44 | (when-let [path (:javadoc info)] 45 | (clj-info/javadoc-info path))) 46 | format-nested 47 | blacklist 48 | u/transform-value)))) 49 | 50 | (defn info-cljs 51 | [env symbol ns] 52 | (some-> (cljs-info/info env symbol ns) 53 | (select-keys [:file :line :ns :doc :column :name :arglists]) 54 | (update 55 | :file 56 | (fn [f] 57 | (if (u/boot-project?) 58 | ;; Boot stores files in a temporary directory & ClojureScript 59 | ;; stores the :file metadata location absolutely instead of 60 | ;; relatively to the classpath. This means when doing jump to 61 | ;; source in Boot & ClojureScript, you end up at the temp file. 62 | ;; This code attempts to find the classpath-relative location 63 | ;; of the file, so that it can be opened correctly. 64 | (let [path (java.nio.file.Paths/get f (into-array String [])) 65 | path-count (.getNameCount path)] 66 | (or 67 | (first 68 | (sequence 69 | (comp (map #(.subpath path % path-count)) 70 | (map str) 71 | (filter io/resource)) 72 | (range path-count))) 73 | f)) 74 | f))))) 75 | 76 | (defn info 77 | [{:keys [ns symbol class member] :as msg}] 78 | (let [[ns symbol class member] (map u/as-sym [ns symbol class member])] 79 | (if-let [cljs-env (cljs/grab-cljs-env msg)] 80 | (info-cljs cljs-env symbol ns) 81 | (let [var-info (cond (and ns symbol) (clj-info/info ns symbol) 82 | (and class member) (clj-info/info-java class member) 83 | :else (throw (Exception. 84 | "Either \"symbol\", or (\"class\", \"member\") must be supplied"))) 85 | ;; we have to use the resolved (real) namespace and name here 86 | see-also (clj-info/see-also (:ns var-info) (:name var-info))] 87 | (if (seq see-also) 88 | (merge {:see-also see-also} var-info) 89 | var-info))))) 90 | 91 | (defn info-reply 92 | [msg] 93 | (if-let [var-info (format-response (info msg))] 94 | var-info 95 | {:status :no-info})) 96 | 97 | (defn eldoc-reply 98 | [msg] 99 | (if-let [info (info msg)] 100 | (eldoc/eldoc info) 101 | {:status :no-eldoc})) 102 | 103 | (defn eldoc-datomic-query-reply 104 | [{:keys [ns symbol] :as msg}] 105 | (try 106 | (eldoc/datomic-query ns symbol) 107 | (catch Throwable _ {:status :no-eldoc}))) 108 | 109 | (defn handle-info [handler msg] 110 | (with-safe-transport handler msg 111 | "info" info-reply 112 | "eldoc" eldoc-reply 113 | "eldoc-datomic-query" eldoc-datomic-query-reply)) 114 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/slurp.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.slurp 2 | "Rich reading & handling for CIDER. 3 | 4 | Goes with middleware.content-types, providing the capability to 5 | convert URLs to values which can be handled nicely." 6 | {:authors ["Reid 'arrdem' McKenzie "]} 7 | (:require 8 | [clojure.edn :as edn] 9 | [clojure.java.io :as io] 10 | [clojure.string :as str] 11 | [nrepl.misc :refer [response-for]] 12 | [nrepl.transport :as transport]) 13 | (:import 14 | [java.net MalformedURLException URL] 15 | java.io.ByteArrayOutputStream 16 | [java.nio.file Files Path Paths])) 17 | 18 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 19 | 20 | (defmacro if-class 21 | "Conditional compilation macro for when a given class is available. 22 | 23 | If the given class can be resolved, expands to `then-expr`, 24 | otherwise expands to `else-expr`. `else-expr` defaults to `nil`." 25 | ([classname then-expr] 26 | `(if-class ~classname ~then-expr nil)) 27 | ([classname then-expr else-expr] 28 | (if (try (eval `(import ~classname)) true 29 | (catch ClassNotFoundException e false)) 30 | then-expr else-expr))) 31 | 32 | (def known-content-types 33 | (->> (io/resource "content-types.edn") 34 | (io/reader) 35 | (java.io.PushbackReader.) 36 | (edn/read) 37 | (mapcat (fn [[content-type exts]] 38 | (for [ext exts] 39 | [ext content-type]))) 40 | (into {}))) 41 | 42 | (defn- split-last 43 | [^String to-split ^String where] 44 | (let [idx (.lastIndexOf to-split where)] 45 | (if (not= idx -1) 46 | (.substring to-split (+ (count where) idx) (count to-split)) 47 | to-split))) 48 | 49 | (def content-type-pattern 50 | #"(?[^;]+)(;(?.*?))?$") 51 | 52 | (defn normalize-content-type 53 | "nREPL's content-type headers are structured as a pair 54 | `[type {:as attrs}]`. This method normalizes RFC 55 | compliant content-types to this form." 56 | [^String content-type] 57 | (if-let [match (re-find content-type-pattern content-type)] 58 | (let [[_ type _ parameters] match] 59 | [type 60 | (into {} 61 | (when parameters 62 | (map #(str/split % #"=") 63 | (str/split parameters #";"))))]) 64 | [content-type {}])) 65 | 66 | (defn get-file-content-type [^Path p] 67 | (or (get known-content-types (split-last (.toString p) ".")) 68 | (Files/probeContentType p) 69 | "application/octet-stream")) 70 | 71 | ;; FIXME (arrdem 2018-04-11): 72 | ;; Remove this if-class when we have jdk1.8 min 73 | (defn base64-bytes 74 | [^bytes buff] 75 | (if-class java.util.Base64 76 | (.encodeToString (Base64/getEncoder) buff))) 77 | 78 | (defn slurp-reply [location content-type buff] 79 | (let [^String real-type (first content-type) 80 | binary? (= "application/octet-stream" real-type) 81 | text? (.contains real-type "text")] 82 | (cond 83 | binary? 84 | {:content-type content-type 85 | :body (str "#binary[location=" location ",size=" (count buff) "]")} 86 | 87 | text? 88 | {:content-type content-type 89 | :body (String. buff "utf-8")} 90 | 91 | :default 92 | {:content-type content-type 93 | :content-transfer-encoding "base64" 94 | :body (base64-bytes buff)}))) 95 | 96 | (defn slurp-url-to-content+body 97 | "Attempts to parse and then to slurp a URL, producing a content-typed response." 98 | [url-str] 99 | (if-let [url (try (URL. url-str) 100 | (catch MalformedURLException e nil))] 101 | (if (= (.getProtocol url) "file") ;; expected common case 102 | (let [^Path p (Paths/get (.toURI url)) 103 | content-type (normalize-content-type (get-file-content-type p)) 104 | buff (Files/readAllBytes p)] 105 | (slurp-reply p content-type buff)) 106 | 107 | ;; It's not a file, so just try to open it on up 108 | (let [conn (.openConnection url) 109 | content-type (normalize-content-type 110 | (.getContentType conn)) 111 | ;; FIXME (arrdem 2018-04-03): 112 | ;; There's gotta be a better way here 113 | is (.getInputStream conn) 114 | os (ByteArrayOutputStream.)] 115 | (loop [] 116 | (let [b (.read is)] 117 | (when (<= 0 b) 118 | (.write os b) 119 | (recur)))) 120 | (slurp-reply url content-type (.toByteArray os)))))) 121 | 122 | ;; FIXME (arrdem 2018-04-11): 123 | ;; Remove this if-class when we have jdk1.8 min 124 | (defn handle-slurp 125 | "Message handler which just responds to slurp ops. 126 | 127 | If the slurp is malformed, or fails, lets the rest of the stack keep going." 128 | [handler msg] 129 | (let [{:keys [op url transport]} msg] 130 | (if (and (= "slurp" op) url) 131 | (do (transport/send transport 132 | (response-for msg 133 | (if-class java.util.Base64 134 | (slurp-url-to-content+body url) 135 | {:error "`java.util.Base64` cannot be found, `slurp` op is disabled."}))) 136 | (transport/send transport 137 | (response-for msg {:status ["done"]}))) 138 | (handler msg)))) 139 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/out.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.out 2 | "Change *out*, *err*, System/out and System/err to print on sessions 3 | in addition to process out. 4 | 5 | Automatically changes the root binding of all output channels to 6 | print to any active sessions. An active session is one that has sent 7 | at least one \"eval\" op. 8 | 9 | We use an eval message, instead of the clone op, because there's no 10 | guarantee that the channel that sent the clone message will properly 11 | handle output replies." 12 | (:require 13 | [cider.nrepl.middleware.util.error-handling :refer [with-safe-transport]] 14 | [nrepl.middleware.interruptible-eval :as ieval]) 15 | (:import 16 | [java.io PrintWriter Writer PrintStream OutputStream] 17 | [java.util TimerTask Timer])) 18 | 19 | (declare unsubscribe-session) 20 | 21 | (def original-output 22 | "Store the values of the original output streams so we can refer to them." 23 | {:out *out* 24 | :err *err*}) 25 | 26 | (defmacro with-out-binding 27 | "Run body with v bound to the output stream of each msg in msg-seq. 28 | type is either :out or :err." 29 | [[v msg-seq type] & body] 30 | `(doseq [{:keys [~'session] :as ~'msg} ~msg-seq] 31 | (let [~(with-meta v {:tag Writer}) (get @~'session 32 | (case ~type 33 | :out #'*out* 34 | :err #'*err*))] 35 | (try (binding [ieval/*msg* ~'msg] 36 | ~@body) 37 | ;; If a channel is faulty, dissoc it. 38 | (catch Exception ~'e 39 | (unsubscribe-session ~'session)))))) 40 | 41 | (defn forking-printer 42 | "Returns a PrintWriter suitable for binding as *out* or *err*. All 43 | operations are forwarded to all output bindings in the sessions of 44 | `messages`, in addition to the server's usual PrintWriter (saved in 45 | `original-output`). 46 | 47 | `type` is either :out or :err." 48 | [messages type] 49 | (PrintWriter. (proxy [Writer] [] 50 | (close [] (.flush ^Writer this)) 51 | (write 52 | ([x] 53 | (.write (original-output type) x) 54 | (with-out-binding [printer messages type] 55 | (.write printer x))) 56 | ([x ^Integer off ^Integer len] 57 | (.write (original-output type) x off len) 58 | (with-out-binding [printer messages type] 59 | (.write printer x off len)))) 60 | (flush [] 61 | (.flush (original-output type)) 62 | (with-out-binding [printer messages type] 63 | (.flush printer)))) 64 | true)) 65 | 66 | (defn print-stream 67 | "Returns a PrintStream suitable for binding as java.lang.System/out or 68 | java.lang.System/err. All operations are forwarded to all output 69 | bindings in the sessions of messages, in addition to the server's 70 | usual PrintWriter (saved in `original-output`). 71 | 72 | `printer` is the printer var, either #'clojure.core/*out* or 73 | #'clojure.core/*err*." 74 | [printer] 75 | (let [delay 100 76 | print-timer (Timer.) 77 | print-flusher (proxy [TimerTask] [] 78 | (run [] 79 | (.flush ^Writer @printer)))] 80 | (.scheduleAtFixedRate print-timer print-flusher delay delay) 81 | (PrintStream. 82 | (proxy [OutputStream] [] 83 | (close [] 84 | (.cancel print-flusher) 85 | (.cancel print-timer) 86 | (.flush ^OutputStream this)) 87 | (write 88 | ([int-or-bytes] 89 | (if (instance? Integer int-or-bytes) 90 | (.write ^Writer @printer ^Integer int-or-bytes) 91 | (.write ^Writer @printer (String. ^"[B" int-or-bytes)))) 92 | ([^"[B" bytes ^Integer off ^Integer len] 93 | (let [byte-range (byte-array (take len (drop off bytes)))] 94 | (.write ^Writer @printer (String. byte-range))))) 95 | (flush [] 96 | (.flush ^Writer @printer)))))) 97 | 98 | ;;; Known eval sessions 99 | (def tracked-sessions-map 100 | "Map from session ids to eval `*msg*`s. 101 | Only the most recent message from each session is stored." 102 | (atom {})) 103 | 104 | (defn tracked-sessions-map-watch [_ _ _ new-state] 105 | (let [out-writer (forking-printer (vals new-state) :out) 106 | err-writer (forking-printer (vals new-state) :err)] 107 | (alter-var-root #'*out* (constantly out-writer)) 108 | (alter-var-root #'*err* (constantly err-writer)) 109 | (System/setOut (print-stream #'*out*)) 110 | (System/setErr (print-stream #'*err*)))) 111 | 112 | (add-watch tracked-sessions-map :update-out tracked-sessions-map-watch) 113 | 114 | (defn subscribe-session 115 | "Add msg to `tracked-sessions-map`." 116 | [{:keys [session] :as msg}] 117 | (when-let [session (:id (meta session))] 118 | (swap! tracked-sessions-map assoc session 119 | (select-keys msg [:transport :session :id])) 120 | {:out-subscribe session})) 121 | 122 | (defn unsubscribe-session 123 | "Remove session from `tracked-sessions-map`." 124 | [session] 125 | (let [removed (if-let [m (meta session)] (:id m) session)] 126 | (swap! tracked-sessions-map dissoc removed) 127 | {:out-unsubscribe removed})) 128 | 129 | (defn handle-out [handler msg] 130 | (with-safe-transport handler msg 131 | "out-subscribe" subscribe-session 132 | "out-unsubscribe" unsubscribe-session)) 133 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/profile.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.profile 2 | "This profiler is intended for interactive profiling applications where you do 3 | not expect a profiling tool to automatically compensate for JVM 4 | warm-up and garbage collection issues. If you are doing numeric 5 | computing or writing other purely functional code that can be 6 | executed repeatedly without unpleasant side effects, I recommend you 7 | at the very least check out Criterium. 8 | 9 | If you are primarily concerned about the influence of JVM-exogenous 10 | factors on your code—HTTP requests, SQL queries, other network- 11 | or (possibly) filesystem-accessing operations—then this package may 12 | be just what the doctor ordered. 13 | 14 | Based on older middleware (nrepl-profile) that's not actively 15 | maintained anymore." 16 | {:author "Edwin Watkeys"} 17 | (:require 18 | [nrepl.misc :refer [response-for]] 19 | [nrepl.transport :as t] 20 | [profile.core :as p])) 21 | 22 | (defn send-exception 23 | [e msg transport] 24 | (t/send transport (response-for msg :status :done :value "exception"))) 25 | 26 | (defn toggle-profile 27 | [{:keys [ns sym transport] :as msg}] 28 | (try 29 | (if-let [v (ns-resolve (symbol ns) (symbol sym))] 30 | (let [profiled? (p/toggle-profile-var* v)] 31 | (t/send transport 32 | (response-for 33 | msg 34 | :status :done 35 | :value (if profiled? "profiled" "unprofiled")))) 36 | (t/send transport 37 | (response-for 38 | msg 39 | :status #{:toggle-profile-not-such-var :done} 40 | :value "unbound"))) 41 | (catch Exception e (send-exception e msg transport)))) 42 | 43 | (defn profile-var-summary 44 | [{:keys [ns sym transport] :as msg}] 45 | (try 46 | (if-let [v (ns-resolve (symbol ns) (symbol sym))] 47 | (if-let [table (with-out-str (binding [*err* *out*] 48 | (p/print-entry-summary v)))] 49 | (t/send transport 50 | (response-for msg 51 | :status :done 52 | :err table)) 53 | (t/send transport 54 | (response-for msg 55 | :status :done 56 | :err (format "No profile data for %s." v)))) 57 | (t/send transport 58 | (response-for msg 59 | :status :done 60 | :value (format "Var %s/%s is not bound." ns sym)))) 61 | (catch Exception e (prn :e e) (send-exception e msg transport)))) 62 | 63 | (defn profile-summary 64 | [{:keys [transport] :as msg}] 65 | (try 66 | (t/send transport 67 | (response-for msg 68 | :status :done 69 | :err (with-out-str 70 | (binding [*err* *out*] (p/print-summary))))) 71 | (catch Exception e (send-exception e msg transport)))) 72 | 73 | (defn clear-profile 74 | [{:keys [transport] :as msg}] 75 | (try 76 | (p/clear-profile-data) 77 | (t/send transport 78 | (response-for msg 79 | :status :done 80 | :value "cleared")) 81 | (catch Exception e (send-exception e msg transport)))) 82 | 83 | (defn toggle-profile-ns 84 | [{:keys [ns transport] :as msg}] 85 | (try (let [profiled? (p/toggle-profile-ns (symbol ns))] 86 | (t/send transport 87 | (response-for 88 | msg 89 | :status :done 90 | :value (if profiled? "profiled" "unprofiled")))) 91 | (catch Exception e (send-exception e msg transport)))) 92 | 93 | (defn is-var-profiled 94 | [{:keys [ns sym transport] :as msg}] 95 | (try (let [var (ns-resolve (symbol ns) (symbol sym)) 96 | profiled? (p/profiled? @var)] 97 | (t/send transport 98 | (response-for 99 | msg 100 | :status :done 101 | :value (if profiled? "profiled" "unprofiled")))) 102 | (catch Exception e (send-exception e msg transport)))) 103 | 104 | (defn get-max-samples 105 | [{:keys [transport] :as msg}] 106 | (try (t/send transport 107 | (response-for 108 | msg 109 | :status :done 110 | :value (str (p/max-sample-count)))) 111 | (catch Exception e (send-exception e msg transport)))) 112 | 113 | (defn normalize-max-samples [n] 114 | (cond (and (sequential? n) (empty? n)) nil 115 | (string? n) (Long/parseLong n) 116 | :else n)) 117 | 118 | (defn set-max-samples 119 | [{:keys [max-samples transport] :as msg}] 120 | (try (let [max-samples (normalize-max-samples max-samples)] 121 | (p/set-max-sample-count max-samples) 122 | (t/send transport 123 | (response-for 124 | msg 125 | :status :done 126 | :value (str (p/max-sample-count))))) 127 | (catch Exception e (send-exception e msg transport)))) 128 | 129 | (defn handle-profile 130 | [handler msg] 131 | (let [{:keys [op]} msg] 132 | (case op 133 | "toggle-profile" (toggle-profile msg) 134 | "toggle-profile-ns" (toggle-profile-ns msg) 135 | "is-var-profiled" (is-var-profiled msg) 136 | "profile-summary" (profile-summary msg) 137 | "profile-var-summary" (profile-var-summary msg) 138 | "clear-profile" (clear-profile msg) 139 | "get-max-samples" (get-max-samples msg) 140 | "set-max-samples" (set-max-samples msg) 141 | (handler msg)))) 142 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/content_type.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.content-type 2 | "Rich content handling for CIDER. 3 | Mostly derived from the pprint middleware. 4 | 5 | --- 6 | 7 | In the long ago, @technomancy [1] talked about his vision for using 8 | nREPL to support multimedia results beyond plain text, ala DrRacket 9 | and other \"rich\" REPLs. There was an initial cut at this [2], 10 | which never became part of the mainline Emacs tooling. 11 | 12 | The goal of this module is to provide some support for recognizing 13 | multimedia objects (images and URIs thereto) as the result of 14 | evaluation, so that they can be rendered by a REPL. 15 | 16 | The design of this module is based heavily on RFC-2045 [3] which 17 | describes messages packaged with `Content-Type`, 18 | `Content-Transfer-Encoding` and of course a body in that it seeks to 19 | provide decorated responses which contain metadata which a client 20 | can use to provide a rich interpretation. 21 | 22 | There's also RFC-2017 [4] which defines the `message/external-body` 23 | MIME type for defining messages which don't contain their own 24 | bodies. 25 | 26 | The basic architecture of this changeset is that eval results are 27 | inspected, and matched against two fundamental supported cases. One 28 | is that the value is actually a binary Java image, which can be MIME 29 | encoded and transmitted back directly. The other is that the object 30 | is some variant of a URI (such as a file naming an image or other 31 | content) which cannot be directly serialized. In this second case we 32 | send an RFC-2017 response which provides the URL from which a client 33 | could request the nREPL server slurp the desired content. 34 | 35 | Hence the slurp middleware which slurps URLs and produces MIME coded 36 | data. 37 | 38 | --- 39 | 40 | [1] https://groups.google.com/forum/#!topic/clojure-tools/rkmJ-5086RY 41 | [2] https://github.com/technomancy/nrepl-discover/blob/master/src/nrepl/discover/samples.clj#L135 42 | [3] https://tools.ietf.org/html/rfc2045 43 | [4] https://tools.ietf.org/html/rfc2017" 44 | {:authors ["Reid 'arrdem' McKenzie "]} 45 | (:require 46 | [cider.nrepl.middleware.slurp :refer [slurp-reply]]) 47 | (:import 48 | java.awt.Image 49 | [java.io ByteArrayOutputStream File OutputStream] 50 | [java.net URI URL] 51 | java.nio.file.Path 52 | javax.imageio.ImageIO 53 | nrepl.transport.Transport)) 54 | 55 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 56 | 57 | (defprotocol URLCoercable 58 | (as-url [o])) 59 | 60 | (extend-protocol URLCoercable 61 | Path 62 | (as-url [^Path p] 63 | (.. p normalize toUri toURL)) 64 | 65 | File 66 | (as-url [^File f] 67 | (.. f getCanonicalFile toURI toURL)) 68 | 69 | URI 70 | (as-url [^URI u] 71 | (.. u toURL)) 72 | 73 | URL 74 | (as-url [^URL u] 75 | u)) 76 | 77 | (defn response+content-type 78 | "Consumes an nREPL response, having a `:value`. If the `:value` is 79 | recognized as an AWT Image, a File, or a File URI, rewrite the 80 | response to have a `:content-type` being a MIME type of the content, 81 | and a `:body` to re-use the RFC term for the message payload." 82 | [{:keys [session value] :as response}] 83 | (cond 84 | ;; FIXME (arrdem 2018-04-03): 85 | ;; 86 | ;; This could be more generic in terms of tolerating more 87 | ;; protocols / schemes 88 | 89 | ;; RFC-2017 external-body responses for UR[IL]s and things which are just wrappers thereof 90 | (or (and (instance? File value) 91 | (.exists ^File value)) 92 | (instance? URI value) 93 | (instance? URL value)) 94 | (assoc response 95 | :content-type ["message/external-body" 96 | {"access-type" "URL" 97 | "URL" (.toString (as-url value))}] 98 | :body "") 99 | 100 | ;; FIXME (arrdem 2018-04-03): 101 | ;; 102 | ;; This is super snowflakey in terms of only supporting base64 103 | ;; coding this one kind of object. This could definitely be 104 | ;; more generic / open to extension but hey at least it's 105 | ;; re-using machinery. 106 | 107 | (instance? java.awt.Image value) 108 | (with-open [bos (ByteArrayOutputStream.)] 109 | (merge response 110 | (when (ImageIO/write ^Image value "png" ^OutputStream bos) 111 | (slurp-reply "" ["image/png" {}] (.toByteArray bos))))) 112 | 113 | :else response)) 114 | 115 | (defn content-type-transport 116 | "Transport proxy which allows this middleware to intercept responses 117 | and inspect / alter them." 118 | [^Transport transport] 119 | (reify Transport 120 | (recv [this] 121 | (.recv transport)) 122 | (recv [this timeout] 123 | (.recv transport timeout)) 124 | (send [this response] 125 | (.send transport (response+content-type response))))) 126 | 127 | (defn handle-content-type 128 | "Handler for inspecting the results of the `eval` op, attempting to 129 | detect content types and generate richer responses when content 130 | information is available. 131 | 132 | Requires that the user opt-in by providing the `content-type` key in 133 | nREPL requests, same as the pprint middleware. 134 | 135 | Note that this middleware makes no attempt to prevent 136 | pretty-printing of the eval result, which could lead to double 137 | output in some REPL clients." 138 | [handler msg] 139 | (let [{:keys [op transport content-type]} msg] 140 | (handler (if (and (= "eval" op) content-type) 141 | (assoc msg :transport (content-type-transport transport)) 142 | msg)))) 143 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/format_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.format-test 2 | (:require 3 | [cider.nrepl.test-session :as session] 4 | [clojure.test :refer :all])) 5 | 6 | (def ugly-code-sample 7 | "( let [x 3 8 | y 4] 9 | (+ (* x x 10 | )(* y y) 11 | ))") 12 | 13 | (def formatted-code-sample 14 | "(let [x 3 15 | y 4] 16 | (+ (* x x) (* y y)))") 17 | 18 | (def ugly-edn-sample 19 | "{ :a 1 20 | :b 2 21 | :c [0 1 2 3] 22 | 23 | :d [ 24 | [0 1 2 3 25 | 26 | ] 27 | [0 28 | 1 2 3]] 29 | }") 30 | 31 | (def formatted-edn-sample 32 | "{:a 1, :b 2, :c [0 1 2 3], :d [[0 1 2 3] [0 1 2 3]]}") 33 | 34 | (def ugly-edn-forms-sample 35 | "[ 36 | 0 1 2 3] 37 | 38 | [0 1 2 3] 39 | 40 | [0 1 2 41 | 42 | 3 43 | 44 | ]") 45 | 46 | (def formatted-edn-forms-sample 47 | "[0 1 2 3] 48 | [0 1 2 3] 49 | [0 1 2 3]") 50 | 51 | (def unmatched-delimiter-edn-sample 52 | ")") 53 | 54 | (use-fixtures :once session/session-fixture) 55 | 56 | (deftest format-code-op-test 57 | (testing "format-code works" 58 | (let [{:keys [formatted-code status]} (session/message {:op "format-code" 59 | :code ugly-code-sample})] 60 | (is (= #{"done"} status)) 61 | (is (= formatted-code-sample formatted-code)))) 62 | 63 | (testing "format-code works with indents option" 64 | (let [{:keys [formatted-code status]} (session/message {:op "format-code" 65 | :code ugly-code-sample 66 | :options {"indents" {"let" [["block" 2]]}}})] 67 | (is (= #{"done"} status)) 68 | (is (= "(let [x 3 69 | y 4] 70 | (+ (* x x) (* y y)))" 71 | formatted-code)))) 72 | 73 | (testing "format-code works with alias-map option" 74 | (let [alias-sample "(foo/bar 1\n2)" 75 | default-options {"indents" {"foo.core/bar" [["inner" 0]]}} 76 | normal-reply (session/message {:op "format-code" :code alias-sample 77 | :options default-options}) 78 | alias-map-reply (session/message {:op "format-code" :code alias-sample 79 | :options (assoc default-options 80 | "alias-map" {"foo" "foo.core"})})] 81 | (is (= #{"done"} (:status normal-reply) (:status alias-map-reply))) 82 | (is (= "(foo/bar 1\n 2)" (:formatted-code normal-reply))) 83 | (is (= "(foo/bar 1\n 2)" (:formatted-code alias-map-reply))))) 84 | 85 | (testing "format-code op error handling" 86 | (let [{:keys [status err ex]} (session/message {:op "format-code" 87 | :code "*/*/*!~v"})] 88 | (is (= #{"format-code-error" "done"} status)) 89 | (is (.startsWith err "clojure.lang.ExceptionInfo: Invalid")) 90 | (is (= ex "class clojure.lang.ExceptionInfo")))) 91 | 92 | (testing "format-code returns an error if indents option is invalid" 93 | (let [{:keys [status err ex] :as reply} (session/message {:op "format-code" 94 | :code "(+ 1 2 3)" 95 | :options {"indents" "INVALID"}})] 96 | (is (= #{"format-code-error" "done"} status)) 97 | (is (.startsWith err "java.lang.IllegalArgumentException:")) 98 | (is (= ex "class java.lang.IllegalArgumentException")))) 99 | 100 | (testing "format-code returns an error if alias-map option is invalid" 101 | (let [{:keys [status err ex] :as reply} (session/message {:op "format-code" 102 | :code "(+ 1 2 3)" 103 | :options {"alias-map" "INVALID"}})] 104 | (is (= #{"format-code-error" "done"} status)) 105 | (is (.startsWith err "java.lang.IllegalArgumentException:")) 106 | (is (= ex "class java.lang.IllegalArgumentException"))))) 107 | 108 | (deftest format-edn-op-test 109 | (testing "format-edn works" 110 | (let [{:keys [formatted-edn status]} (session/message {:op "format-edn" 111 | :edn ugly-edn-sample})] 112 | (is (= formatted-edn-sample formatted-edn)) 113 | (is (= #{"done"} status)))) 114 | 115 | (testing "format-edn works for multiple forms" 116 | (let [{:keys [formatted-edn status]} (session/message {:op "format-edn" 117 | :edn ugly-edn-forms-sample})] 118 | (is (= formatted-edn-forms-sample formatted-edn)) 119 | (is (= #{"done"} status)))) 120 | 121 | (testing "format-edn returns an error if the given EDN is malformed" 122 | (let [{:keys [err status] :as response} (session/message {:op "format-edn" 123 | :edn unmatched-delimiter-edn-sample})] 124 | (is (= #{"format-edn-error" "done"} status)) 125 | (is (.startsWith err "clojure.lang.ExceptionInfo: Unmatched delimiter")) 126 | (is (:pp-stacktrace response)))) 127 | 128 | (testing "format-edn respects the :right-margin print config" 129 | (let [wide-edn-sample "[1 2 3 4 5 6 7 8 9 0]" 130 | normal-reply (session/message {:op "format-edn" :edn wide-edn-sample}) 131 | narrow-margin-reply (session/message {:op "format-edn" 132 | :edn wide-edn-sample 133 | :print-options {:right-margin 10}})] 134 | (is (= #{"done"} (:status normal-reply))) 135 | (is (= "[1 2 3 4 5 6 7 8 9 0]" (:formatted-edn normal-reply))) 136 | (is (= #{"done"} (:status narrow-margin-reply))) 137 | (is (= "[1\n 2\n 3\n 4\n 5\n 6\n 7\n 8\n 9\n 0]" (:formatted-edn narrow-margin-reply))))) 138 | 139 | (testing "format-edn respects the :pprint-fn slot" 140 | (let [{:keys [formatted-edn status]} (session/message {:op "format-edn" 141 | :edn "{:b 2 :c 3 :a 1}" 142 | :pprint-fn "cider.nrepl.pprint/puget-pprint"})] 143 | (is (= "{:a 1, :b 2, :c 3}" formatted-edn)) 144 | (is (= #{"done"} status)))) 145 | 146 | (testing "format-edn returns fallbacks to a default printer if :pprint-fn is unresolvable" 147 | (let [{:keys [formatted-edn status] :as response} (session/message {:op "format-edn" 148 | :edn "{:b 2 :c 3 :a 1}" 149 | :pprint-fn "fake.nrepl.pprint/puget-pprint"})] 150 | (is (= "{:b 2, :c 3, :a 1}" formatted-edn)) 151 | (is (= #{"done"} status))))) 152 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/ns_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.ns-test 2 | (:require 3 | [cider.nrepl.middleware.ns :refer [ns-vars-clj ns-list-vars-by-name] :as cider-ns] 4 | [cider.nrepl.test-session :as session] 5 | [cider.nrepl.test-transport :refer [messages test-transport]] 6 | [cider.test-ns first-test-ns second-test-ns third-test-ns] 7 | [clojure.test :refer :all])) 8 | 9 | (deftest toogle-ns-vars-test 10 | (let [ns "clojure.core"] 11 | (is (= (count (ns-publics (symbol ns))) (count (ns-vars-clj ns)))))) 12 | 13 | ;; integration tests 14 | 15 | (use-fixtures :each session/session-fixture) 16 | 17 | (deftest ns-list-integration-test 18 | (testing "Basic checks" 19 | (let [ns-list (:ns-list (session/message {:op "ns-list"}))] 20 | (is (sequential? ns-list)) 21 | (is (every? string? ns-list)))) 22 | 23 | (testing "Removal of namespaces created by source rewriting" 24 | (let [ns-list (:ns-list (session/message {:op "ns-list"}))] 25 | (is (not-any? #(or (.startsWith % "deps.") 26 | (.startsWith % "mranderson") 27 | (.startsWith % "eastwood.copieddeps")) 28 | ns-list)))) 29 | 30 | (testing "Removal of namespaces with `filter-regexps`" 31 | (let [ns-list (:ns-list (session/message {:op "ns-list" 32 | :filter-regexps [".*nrepl"]}))] 33 | (is (not-any? #(re-find #".*nrepl" %) ns-list))))) 34 | 35 | (deftest ns-list-vars-by-name-integration-test 36 | (let [response (session/message {:op "ns-list-vars-by-name" 37 | :name "same-name-testing-function"}) 38 | var-list (read-string (:var-list response))] 39 | (is (= (set var-list) 40 | #{'(var cider.test-ns.first-test-ns/same-name-testing-function) 41 | '(var cider.test-ns.second-test-ns/same-name-testing-function) 42 | '(var cider.test-ns.third-test-ns/same-name-testing-function)})))) 43 | 44 | (deftest ns-vars-integration-test 45 | (let [ns-vars (:ns-vars (session/message {:op "ns-vars" 46 | :ns "clojure.walk"}))] 47 | (is (sequential? ns-vars)) 48 | (is (every? string? ns-vars)))) 49 | 50 | (deftest ns-vars-with-meta-integration-test 51 | (let [ns-vars-with-meta (:ns-vars-with-meta 52 | (session/message {:op "ns-vars-with-meta" 53 | :ns "clojure.core"}))] 54 | (is (every? (comp map? second) ns-vars-with-meta)) 55 | (is (= (:+ ns-vars-with-meta) 56 | {:arglists "([] [x] [x y] [x y & more])" 57 | :doc "\"Returns the sum of nums. (+) returns 0. Does not auto-promote\\n longs, will throw on overflow. See also: +'\""})) 58 | (is (= (:doseq ns-vars-with-meta) 59 | {:arglists "([seq-exprs & body])" 60 | :macro "true" 61 | :doc "\"Repeatedly executes body (presumably for side-effects) with\\n bindings and filtering as provided by \\\"for\\\". Does not retain\\n the head of the sequence. Returns nil.\""})) 62 | (is (= (:*ns* ns-vars-with-meta) 63 | {:doc "\"A clojure.lang.Namespace object representing the current namespace.\""})))) 64 | 65 | (deftest ns-path-integration-test 66 | (let [ns-path (:path (session/message {:op "ns-path" 67 | :ns "cider.nrepl.middleware.ns"})) 68 | core-path (:path (session/message {:op "ns-path" 69 | :ns "clojure.core"}))] 70 | (is (.endsWith ns-path "cider/nrepl/middleware/ns.clj")) 71 | (is (.endsWith core-path "clojure/core.clj")))) 72 | 73 | (deftest ns-load-all-integration-test 74 | (let [loaded-ns (:loaded-ns (session/message {:op "ns-load-all"}))] 75 | (is (sequential? loaded-ns)) 76 | (is (every? string? loaded-ns)))) 77 | 78 | (deftest ns-list-vars-by-name-test 79 | (is (= (first (ns-list-vars-by-name 'ns-list-vars-by-name-test)) 80 | #'cider.nrepl.middleware.ns-test/ns-list-vars-by-name-test)) 81 | (is (= (count (ns-list-vars-by-name 'ns-list-vars-by-name-test)) 1)) 82 | (is (not (seq (ns-list-vars-by-name 'all-your-base-are-belong-to-us))))) 83 | 84 | (deftest ns-aliases-integration-test 85 | (let [aliases (:ns-aliases (session/message {:op "ns-aliases" 86 | :ns "cider.nrepl.middleware.ns-test"}))] 87 | (is (map? aliases)) 88 | (is (= (:cider-ns aliases) "cider.nrepl.middleware.ns")))) 89 | 90 | (deftest error-handling-test 91 | (testing "ns-list op error handling" 92 | (with-redefs [cider-ns/ns-list (fn [& _] (throw (Exception. "ns-list error")))] 93 | (let [response (session/message {:op "ns-list"})] 94 | (is (.startsWith (:err response) "java.lang.Exception: ns-list error")) 95 | (is (= (:ex response) "class java.lang.Exception")) 96 | (is (= (:status response) #{"ns-list-error" "done"})) 97 | (is (:pp-stacktrace response))))) 98 | 99 | (testing "ns-list-vars-by-name op error handling" 100 | (with-redefs [cider-ns/ns-list-vars-by-name (fn [& _] (throw (Exception. "ns-list-vars-by-name error")))] 101 | (let [response (session/message {:op "ns-list-vars-by-name" 102 | :name "testing-function"})] 103 | (is (.startsWith (:err response) "java.lang.Exception: ns-list-vars-by-name error")) 104 | (is (= (:ex response) "class java.lang.Exception")) 105 | (is (= (:status response) #{"ns-list-vars-by-name-error" "done"})) 106 | (is (:pp-stacktrace response))))) 107 | 108 | (testing "ns-vars op error handling" 109 | (with-redefs [cider-ns/ns-vars (fn [& _] (throw (Exception. "ns-vars error")))] 110 | (let [response (session/message {:op "ns-vars" 111 | :name "testing-function"})] 112 | (is (.startsWith (:err response) "java.lang.Exception: ns-vars error")) 113 | (is (= (:ex response) "class java.lang.Exception")) 114 | (is (= (:status response) #{"ns-vars-error" "done"})) 115 | (is (:pp-stacktrace response))))) 116 | 117 | (testing "ns-path op error handling" 118 | (with-redefs [cider-ns/ns-path (fn [& _] (throw (Exception. "ns-path error")))] 119 | (let [response (session/message {:op "ns-path" 120 | :name "testing-function"})] 121 | (is (.startsWith (:err response) "java.lang.Exception: ns-path error")) 122 | (is (= (:ex response) "class java.lang.Exception")) 123 | (is (= (:status response) #{"ns-path-error" "done"})) 124 | (is (:pp-stacktrace response))))) 125 | 126 | (testing "ns-aliases op error handling" 127 | (with-redefs [cider-ns/ns-aliases (fn [& _] (throw (Exception. "ns-aliases error")))] 128 | (let [response (session/message {:op "ns-aliases" :name "testing-function"})] 129 | (is (.startsWith (:err response) "java.lang.Exception: ns-aliases error")) 130 | (is (= (:ex response) "class java.lang.Exception")) 131 | (is (= (:status response) #{"ns-aliases-error" "done"})) 132 | (is (:pp-stacktrace response)))))) 133 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/refresh.clj: -------------------------------------------------------------------------------- 1 | (ns ^{:clojure.tools.namespace.repl/load false 2 | :clojure.tools.namespace.repl/unload false} cider.nrepl.middleware.refresh 3 | ;; The above metadata prevents reloading of this namespace - otherwise, 4 | ;; `refresh-tracker` is reset with every refresh. This only has any effect 5 | ;; when developing cider-nrepl itself, or when cider-nrepl is used as a 6 | ;; checkout dependency - tools.namespace doesn't reload source in JARs. 7 | (:require 8 | [cider.nrepl.middleware.stacktrace :refer [analyze-causes]] 9 | [clojure.main :refer [repl-caught]] 10 | [clojure.tools.namespace.dir :as dir] 11 | [clojure.tools.namespace.find :as find] 12 | [clojure.tools.namespace.reload :as reload] 13 | [clojure.tools.namespace.track :as track] 14 | [nrepl.middleware.interruptible-eval :refer [*msg*]] 15 | [nrepl.misc :refer [response-for]] 16 | [nrepl.transport :as transport] 17 | [orchard.misc :as u])) 18 | 19 | (defonce ^:private refresh-tracker (agent (track/tracker))) 20 | 21 | (defn- user-refresh-dirs 22 | "Directories to watch and reload, as configured by the user. 23 | 24 | See `clojure.tools.namespace.repl/set-refresh-dirs`. 25 | 26 | The var is resolved at runtime to get the \"real\" clojure.tools.namespace, 27 | not the mranderson-ized version bundled with CIDER. Returns `nil` if c.t.n.r 28 | isn't loaded. Returns `[]` if c.t.n.r is loaded but no custom dirs have been 29 | set." 30 | [] 31 | (some-> (symbol "clojure.tools.namespace.repl" "refresh-dirs") 32 | resolve 33 | deref)) 34 | 35 | ;; We construct the keyword at runtime here because namespaced keyword literals 36 | ;; in clojure.tools.namespace.repl itself might be rewritten by mranderson - in 37 | ;; this case, we still want to disable reloading of namespaces that a user has 38 | ;; added the (non-rewritten) metadata to. 39 | (defn- load-disabled? 40 | [sym] 41 | (false? (get (meta (find-ns sym)) 42 | (keyword "clojure.tools.namespace.repl" "load")))) 43 | 44 | ;; As documented in clojure.tools.namespace.repl/disable-reload!, 45 | ;; ^{:c.t.n.r/load false} implies ^{:c.t.n.r/unload false} 46 | (defn- unload-disabled? 47 | [sym] 48 | (or (load-disabled? sym) 49 | (false? (get (meta (find-ns sym)) 50 | (keyword "clojure.tools.namespace.repl" "unload"))))) 51 | 52 | (defn- remove-disabled 53 | [tracker] 54 | (-> tracker 55 | (update-in [::track/load] #(remove load-disabled? %)) 56 | (update-in [::track/unload] #(remove unload-disabled? %)))) 57 | 58 | (defn- zero-arity-callable? [func] 59 | (and (fn? (if (var? func) @func func)) 60 | (->> (:arglists (meta func)) 61 | (some #(or (= [] %) (= '& (first %))))))) 62 | 63 | (defn- resolve-and-invoke 64 | "Takes a string and tries to coerce a function from it. If that 65 | function is a function of possible zero arity (ie, truly a thunk or 66 | has optional parameters and can be called with zero args, it is 67 | called. Returns whether the function was resolved." 68 | [sym {:keys [session] :as msg}] 69 | (let [the-var (some-> sym u/as-sym resolve)] 70 | 71 | (when (and (var? the-var) 72 | (not (zero-arity-callable? the-var))) 73 | (throw (IllegalArgumentException. 74 | (format "%s is not a function of no arguments" sym)))) 75 | 76 | (binding [*msg* msg 77 | *out* (get @session #'*out*) 78 | *err* (get @session #'*err*)] 79 | (do 80 | (when (var? the-var) 81 | (@the-var)) 82 | (var? the-var))))) 83 | 84 | (defn- reloading-reply 85 | [{reloading ::track/load} 86 | {:keys [transport] :as msg}] 87 | (transport/send 88 | transport 89 | (response-for msg {:reloading reloading}))) 90 | 91 | (defn- error-reply 92 | [{:keys [error error-ns]} 93 | {:keys [pprint-fn print-options session transport] :as msg}] 94 | 95 | (transport/send 96 | transport 97 | (response-for msg (cond-> {:status :error} 98 | error (assoc :error (analyze-causes error pprint-fn print-options)) 99 | error-ns (assoc :error-ns error-ns)))) 100 | 101 | (binding [*msg* msg 102 | *err* (get @session #'*err*)] 103 | (repl-caught error))) 104 | 105 | (defn- result-reply 106 | [{error ::reload/error 107 | error-ns ::reload/error-ns} 108 | {:keys [transport] :as msg}] 109 | 110 | (if error 111 | (error-reply {:error error :error-ns error-ns} msg) 112 | (transport/send 113 | transport 114 | (response-for msg {:status :ok})))) 115 | 116 | (defn- before-reply 117 | [{:keys [before transport] :as msg}] 118 | (when before 119 | (transport/send 120 | transport 121 | (response-for msg {:status :invoking-before 122 | :before before})) 123 | 124 | (let [resolved? (resolve-and-invoke before msg)] 125 | 126 | (transport/send 127 | transport 128 | (response-for msg 129 | {:status (if resolved? 130 | :invoked-before 131 | :invoked-not-resolved) 132 | :before before}))))) 133 | 134 | (defn- after-reply 135 | [{error ::reload/error} 136 | {:keys [after transport] :as msg}] 137 | 138 | (when (and (not error) after) 139 | (try 140 | (transport/send 141 | transport 142 | (response-for msg {:status :invoking-after 143 | :after after})) 144 | 145 | (let [resolved? (resolve-and-invoke after msg)] 146 | 147 | (transport/send 148 | transport 149 | (response-for msg {:status (if resolved? 150 | :invoked-after 151 | :invoked-not-resolved) 152 | :after after}))) 153 | 154 | (catch Exception e 155 | (error-reply {:error e} msg))))) 156 | 157 | (defn- refresh-reply 158 | [{:keys [dirs transport] :as msg}] 159 | (send-off refresh-tracker 160 | (fn [tracker] 161 | (try 162 | (before-reply msg) 163 | 164 | (-> tracker 165 | (dir/scan-dirs (or (seq dirs) (user-refresh-dirs)) 166 | (select-keys msg [:platform :add-all?])) 167 | (remove-disabled) 168 | (doto (reloading-reply msg)) 169 | (reload/track-reload) 170 | (doto (result-reply msg)) 171 | (doto (after-reply msg))) 172 | 173 | (catch Throwable e 174 | (error-reply {:error e} msg) 175 | tracker) 176 | 177 | (finally 178 | (transport/send 179 | transport 180 | (response-for msg {:status :done}))))))) 181 | 182 | (defn- clear-reply 183 | [{:keys [transport] :as msg}] 184 | (send-off refresh-tracker (constantly (track/tracker))) 185 | (transport/send 186 | transport 187 | (response-for msg {:status :done}))) 188 | 189 | (defn handle-refresh [handler msg] 190 | (case (:op msg) 191 | "refresh" (refresh-reply (assoc msg :platform find/clj)) 192 | "refresh-all" (refresh-reply (assoc msg :platform find/clj :add-all? true)) 193 | "refresh-clear" (clear-reply msg) 194 | (handler msg))) 195 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/refresh_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.refresh-test 2 | (:require 3 | [cider.nrepl.middleware.refresh :as r] 4 | [cider.nrepl.test-session :as session] 5 | [clojure.test :refer :all])) 6 | 7 | (use-fixtures :each session/session-fixture) 8 | 9 | (def ^:private dirs-to-reload 10 | ;; Limit the scope of what we reload, because (for example) reloading the 11 | ;; cider.nrepl.middleware.test-session ns causes *session* in that ns to be 12 | ;; unloaded, which breaks session-fixture, and hence all of the below tests. 13 | ["test/clj/cider/nrepl/middleware/util"]) 14 | 15 | (defn before-fn [] 16 | (println "before-fn invoked")) 17 | 18 | (defn- after-fn [] 19 | (println "after-fn invoked")) 20 | 21 | (defn- after-fn-optional-arg [& a] 22 | (when a (throw (IllegalArgumentException. "should not have been called with arg"))) 23 | (println "after with optional argument works")) 24 | 25 | (deftest invoking-function-tests 26 | (testing "invoking named function works" 27 | (is (#'r/zero-arity-callable? 28 | (resolve (symbol "cider.nrepl.middleware.refresh-test" "before-fn")))))) 29 | 30 | (deftest refresh-op-test 31 | (testing "refresh op works" 32 | (let [response (session/message {:op "refresh" 33 | :dirs dirs-to-reload})] 34 | (is (:reloading response)) 35 | (is (= #{"done" "ok"} (:status response))))) 36 | 37 | (testing "nothing to refresh after refreshing" 38 | (let [response (session/message {:op "refresh" 39 | :dirs dirs-to-reload})] 40 | (is (= [] (:reloading response))) 41 | (is (= #{"done" "ok"} (:status response)))))) 42 | 43 | (deftest before-fn-test 44 | (testing "before fn works" 45 | (let [response (session/message {:op "refresh" 46 | :dirs dirs-to-reload 47 | :before "cider.nrepl.middleware.refresh-test/before-fn"})] 48 | (is (:reloading response)) 49 | (is (= #{"done" "invoked-before" "invoking-before" "ok"} (:status response))) 50 | (is (= "before-fn invoked\n" (:out response))))) 51 | 52 | (testing "bad before fn results in not resolved response" 53 | (let [response (session/message {:op "refresh" 54 | :dirs dirs-to-reload 55 | :before "foo"})] 56 | (is (= #{"done" "invoked-not-resolved" "ok" "invoking-before"} (:status response)))) 57 | 58 | (let [response (session/message {:op "refresh" 59 | :dirs dirs-to-reload 60 | :before "clojure.core/seq"})] 61 | (is (= #{"done" "error" "invoking-before"} (:status response))) 62 | (is (:err response)) 63 | (is (:error response))) 64 | 65 | (let [response (session/message {:op "refresh" 66 | :dirs dirs-to-reload 67 | :before "java.lang.Thread"})] 68 | (is (= #{"done" "invoked-not-resolved" "invoking-before" "ok"} 69 | (:status response)))))) 70 | 71 | (deftest after-fn-test 72 | (testing "after fn with zero arity works" 73 | (let [response (session/message {:op "refresh" 74 | :dirs dirs-to-reload 75 | :after "cider.nrepl.middleware.refresh-test/after-fn"})] 76 | (is (:reloading response)) 77 | (is (= #{"done" "invoked-after" "invoking-after" "ok"} (:status response))) 78 | (is (= "after-fn invoked\n" (:out response))))) 79 | 80 | (testing "after fn with optional arg works" 81 | (let [response (session/message {:op "refresh" 82 | :dirs dirs-to-reload 83 | :after "cider.nrepl.middleware.refresh-test/after-fn-optional-arg"})] 84 | (is (:reloading response)) 85 | (is (= #{"done" "invoked-after" "invoking-after" "ok"} (:status response))) 86 | (is (= "after with optional argument works\n" (:out response))))) 87 | 88 | (testing "bad after fn results in error" 89 | (let [response (session/message {:op "refresh" 90 | :dirs dirs-to-reload 91 | :after "foo"})] 92 | (is (= #{"done" "invoked-not-resolved" "invoking-after" "ok"} (:status response)))) 93 | 94 | (let [response (session/message {:op "refresh" 95 | :dirs dirs-to-reload 96 | :after "clojure.core/seq"})] 97 | (is (= #{"done" "error" "invoking-after" "ok"} (:status response))) 98 | (is (:error response)) 99 | (is (:err response))) 100 | 101 | (let [response (session/message {:op "refresh" 102 | :dirs dirs-to-reload 103 | :after "java.lang.Thread"})] 104 | (is (= #{"done" "invoked-not-resolved" "invoking-after" "ok"} (:status response)))))) 105 | 106 | (deftest refresh-all-op-test 107 | (testing "refresh-all op works" 108 | (let [response (session/message {:op "refresh-all" 109 | :dirs dirs-to-reload})] 110 | (is (seq (:reloading response))) 111 | (is (= #{"done" "ok"} (:status response)))))) 112 | 113 | (deftest refresh-clear-op-test 114 | (testing "refresh-clear op works" 115 | (let [_ (session/message {:op "refresh" 116 | :dirs dirs-to-reload}) 117 | response (session/message {:op "refresh-clear"})] 118 | (is (= #{"done"} (:status response))))) 119 | 120 | (testing "refresh op works after refresh clear" 121 | (let [response (session/message {:op "refresh" 122 | :dirs dirs-to-reload})] 123 | (is (seq (:reloading response))) 124 | (is (= #{"done" "ok"} (:status response)))))) 125 | 126 | (deftest user-refresh-dirs-test 127 | (testing "returns nil if clojure.tools.namespace isn't loaded" 128 | (with-redefs [resolve (constantly nil)] 129 | (is (nil? (#'r/user-refresh-dirs))))) 130 | 131 | ;; Disabling the next test. 132 | ;; Unclear how to get the "real" clojure.tools.namespace.repl in 133 | ;; this test when this project also localizes via mranderson. 134 | #_(testing "honors set-refresh-dirs" 135 | (c.t.n.r/set-refresh-dirs "foo" "bar") 136 | (is (= ["foo" "bar"] (#'r/user-refresh-dirs))))) 137 | 138 | (deftest load-disabled-test 139 | (testing "is false by default" 140 | (let [ns-name (gensym "test") 141 | ns-obj (create-ns ns-name)] 142 | (is (false? (#'r/load-disabled? ns-name))))) 143 | 144 | (testing "is true when :c.t.n.r/load false" 145 | (let [ns-name (gensym "test") 146 | ns-obj (create-ns ns-name)] 147 | (alter-meta! ns-obj assoc :clojure.tools.namespace.repl/load false) 148 | (is (true? (#'r/load-disabled? ns-name)))))) 149 | 150 | (deftest unload-disabled-test 151 | (testing "is false by default" 152 | (let [ns-name (gensym "test") 153 | ns-obj (create-ns ns-name)] 154 | (is (false? (#'r/unload-disabled? ns-name))))) 155 | 156 | (testing "is true when :c.t.n.r/unload false" 157 | (let [ns-name (gensym "test") 158 | ns-obj (create-ns ns-name)] 159 | (alter-meta! ns-obj assoc :clojure.tools.namespace.repl/unload false) 160 | (is (true? (#'r/unload-disabled? ns-name))))) 161 | 162 | (testing "is true when :c.t.n.r/load false (implied)" 163 | (let [ns-name (gensym "test") 164 | ns-obj (create-ns ns-name)] 165 | (alter-meta! ns-obj assoc :clojure.tools.namespace.repl/load false) 166 | (is (true? (#'r/unload-disabled? ns-name)))))) 167 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/test_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.test-test 2 | (:require 3 | [cider.nrepl.middleware.test :as test] 4 | ;; Ensure tested tests are loaded: 5 | cider.nrepl.middleware.test-filter-tests 6 | [cider.nrepl.test-session :as session] 7 | [clojure.test :refer :all])) 8 | 9 | (use-fixtures :each session/session-fixture) 10 | 11 | (deftest basic-sanity-test 12 | ;; Just make sure that the namespace loads properly and the macro 13 | ;; expands without errors. (See #264) 14 | (is (seq (macroexpand '(test/with-interruptible-eval {} 15 | 10)))) 16 | (is (= (class @test/default-executor) 17 | java.util.concurrent.ThreadPoolExecutor))) 18 | 19 | (deftest only-selected-tests 20 | (testing "only single test is run with test" 21 | (are [tests] (let [{:keys [results] :as test-result} 22 | (session/message 23 | {:op "test" 24 | :ns "cider.nrepl.middleware.test-filter-tests" 25 | :tests (map name tests)})] 26 | (is (= tests (keys (:cider.nrepl.middleware.test-filter-tests results))))) 27 | [:a-puff-of-smoke-test] 28 | [:a-smokey-test] 29 | [:a-puff-of-smoke-test :a-smokey-test] 30 | [:a-puff-of-smoke-test :a-smokey-test :yet-an-other-test]))) 31 | 32 | (deftest only-smoke-test-run-test-deprecated 33 | (testing "only test marked as smoke is run when test-all is used" 34 | (let [{:keys [results] :as test-result} 35 | (session/message {:op "test-all" 36 | :include ["smoke"] 37 | :exclude ["integration"]}) 38 | tests (keys (:cider.nrepl.middleware.test-filter-tests results))] 39 | (is ((set (keys results)) :cider.nrepl.middleware.test-filter-tests) 40 | "ns that contains smoke is present") 41 | (is (= 1 (count tests)) 42 | "only one test was run") 43 | (is (= :a-puff-of-smoke-test (first tests)) 44 | "only the test marked 'smoke' was run"))) 45 | 46 | (testing "only test marked as smoke is run when test-ns is used" 47 | (let [{:keys [results] :as test-result} 48 | (session/message {:op "test" 49 | :ns "cider.nrepl.middleware.test-filter-tests" 50 | :include ["smoke"] 51 | :exclude ["integration"]}) 52 | tests (keys (:cider.nrepl.middleware.test-filter-tests results))] 53 | (is ((set (keys results)) :cider.nrepl.middleware.test-filter-tests) 54 | "ns that contains smoke is present") 55 | (is (= 1 (count tests)) 56 | "only one test was run") 57 | (is (= :a-puff-of-smoke-test (first tests)) 58 | "only the test marked 'smoke' was run"))) 59 | 60 | (testing "only test not marked as integration is run when test-ns is used" 61 | (let [{:keys [results] :as test-result} 62 | (session/message {:op "test" 63 | :ns "cider.nrepl.middleware.test-filter-tests" 64 | :exclude ["integration"]}) 65 | tests (keys (:cider.nrepl.middleware.test-filter-tests results))] 66 | (is ((set (keys results)) :cider.nrepl.middleware.test-filter-tests) 67 | "ns that contains smoke is present") 68 | (is (= 3 (count tests)) 69 | "only one test was run") 70 | (is (= #{:a-puff-of-smoke-test :yet-an-other-test :test-with-map-as-message} (set tests)) 71 | "only the test marked 'smoke' was run"))) 72 | 73 | (testing "marked test is still run if filter is not used" 74 | (let [{:keys [results] :as test-result} 75 | (session/message {:op "test" 76 | :ns "cider.nrepl.middleware.test-filter-tests"}) 77 | tests (keys (:cider.nrepl.middleware.test-filter-tests results))] 78 | (is ((set (keys results)) :cider.nrepl.middleware.test-filter-tests) "ns that contains smoke is present") 79 | (is (< 1 (count tests)) "more tests were run") 80 | (is ((set tests) :a-puff-of-smoke-test) "smoke test is still present without a filter")))) 81 | 82 | (deftest only-smoke-test-run-test 83 | (testing "only test marked as smoke is run when test-var-query is used" 84 | (let [{:keys [results] :as test-result} 85 | (session/message {:op "test-var-query" 86 | :var-query {:include-meta-key ["smoke"] 87 | :exclude-meta-key ["integration"]}}) 88 | tests (keys (:cider.nrepl.middleware.test-filter-tests results))] 89 | (is ((set (keys results)) :cider.nrepl.middleware.test-filter-tests) 90 | "ns that contains smoke is present") 91 | (is (= 1 (count tests)) 92 | "only one test was run") 93 | (is (= :a-puff-of-smoke-test (first tests)) 94 | "only the test marked 'smoke' was run"))) 95 | 96 | (testing "only test marked as smoke is run when test-ns is used" 97 | (let [{:keys [results] :as test-result} 98 | (session/message {:op "test-var-query" 99 | :var-query {:ns-query {:exactly ["cider.nrepl.middleware.test-filter-tests"]} 100 | :include-meta-key ["smoke"] 101 | :exclude-meta-key ["integration"]}}) 102 | tests (keys (:cider.nrepl.middleware.test-filter-tests results))] 103 | (is ((set (keys results)) :cider.nrepl.middleware.test-filter-tests) 104 | "ns that contains smoke is present") 105 | (is (= 1 (count tests)) 106 | "only one test was run") 107 | (is (= :a-puff-of-smoke-test (first tests)) 108 | "only the test marked 'smoke' was run"))) 109 | 110 | (testing "only test not marked as integration is run when test-ns is used" 111 | (let [{:keys [results] :as test-result} 112 | (session/message {:op "test-var-query" 113 | :var-query {:ns-query {:exactly ["cider.nrepl.middleware.test-filter-tests"]} 114 | :exclude-meta-key ["integration"]}}) 115 | tests (keys (:cider.nrepl.middleware.test-filter-tests results))] 116 | (is ((set (keys results)) :cider.nrepl.middleware.test-filter-tests) 117 | "ns that contains smoke is present") 118 | (is (= 3 (count tests)) 119 | "only one test was run") 120 | (is (= #{:a-puff-of-smoke-test :yet-an-other-test :test-with-map-as-message} (set tests)) 121 | "only the test marked 'smoke' was run"))) 122 | 123 | (testing "marked test is still run if filter is not used" 124 | (let [{:keys [results] :as test-result} 125 | (session/message {:op "test-var-query" 126 | :var-query {:ns-query {:exactly ["cider.nrepl.middleware.test-filter-tests"]}}}) 127 | tests (keys (:cider.nrepl.middleware.test-filter-tests results))] 128 | (is ((set (keys results)) :cider.nrepl.middleware.test-filter-tests) 129 | "ns that contains smoke is present") 130 | (is (< 1 (count tests)) 131 | "more tests were run") 132 | (is ((set tests) :a-puff-of-smoke-test) 133 | "smoke test is still present without a filter")))) 134 | 135 | (deftest run-test-with-map-as-documentation-message 136 | (testing "documentation message map is returned as string" 137 | (let [{:keys [results] :as test-result} 138 | (session/message {:op "test" 139 | :ns "cider.nrepl.middleware.test-filter-tests" 140 | :tests ["test-with-map-as-message"]})] 141 | (is (= (str {:key "val"}) (-> results 142 | :cider.nrepl.middleware.test-filter-tests 143 | :test-with-map-as-message 144 | first 145 | :message)))))) 146 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/track_state_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.track-state-test 2 | (:require 3 | [cider.nrepl.middleware.track-state :as st] 4 | [cider.nrepl.middleware.util.cljs :as cljs] 5 | [cider.nrepl.middleware.util.meta :as um] 6 | [clojure.test :refer :all]) 7 | (:import 8 | nrepl.transport.Transport)) 9 | 10 | (def some-ns-map {'cider.nrepl.middleware.track-state-test 11 | (st/ns-as-map (find-ns 'cider.nrepl.middleware.track-state-test))}) 12 | 13 | ;;; This is to prevent the agent from flooding test reports with 14 | ;;; irrelevant exceptions. 15 | (set-error-handler! st/ns-cache (constantly nil)) 16 | (set-error-mode! st/ns-cache :continue) 17 | 18 | (def ^:const msg {:session :dummy}) 19 | 20 | (deftest make-transport-test 21 | (is (instance? Transport (st/make-transport msg))) 22 | (is (try (send (st/make-transport msg) 10) 23 | nil 24 | (catch Exception e true)))) 25 | 26 | (defn update-and-send-cache-tester 27 | "Use the other arity of st/update-and-send-cache to evaluate 28 | strictly in test mode." 29 | [old-data msg sent-value] 30 | (st/update-and-send-cache old-data msg 31 | #{} 32 | (fn [t m] (reset! sent-value m)))) 33 | 34 | (deftest update-and-send-cache-test 35 | (let [sent-value (atom nil)] 36 | (let [new-data (update-and-send-cache-tester nil msg sent-value)] 37 | (is (map? new-data)) 38 | (is (< 100 (count new-data)))) 39 | (let [{:keys [repl-type changed-namespaces]} @sent-value] 40 | (is (= :clj repl-type)) 41 | (is (map? changed-namespaces)) 42 | (is (< 100 (count changed-namespaces)))) 43 | (let [full-cache (update-and-send-cache-tester nil msg sent-value) 44 | get-sent-value (fn [old] (update-and-send-cache-tester old msg sent-value) 45 | @sent-value)] 46 | ;; Return value depends only on the current state. 47 | (is (= (update-and-send-cache-tester nil msg sent-value) 48 | (update-and-send-cache-tester (into {} (take 5 full-cache)) msg sent-value) 49 | (update-and-send-cache-tester full-cache msg sent-value))) 50 | ;; Sent message depends on the first arg. 51 | (is (= (get-sent-value full-cache) 52 | (get-sent-value full-cache))) 53 | (is (= (get-sent-value (into {} (drop 3 full-cache))) 54 | (get-sent-value (into {} (drop 3 full-cache)))))) 55 | ;; In particular, the sent message only contains the diff. 56 | 57 | (let [changed-again (:changed-namespaces @sent-value)] 58 | (is (map? changed-again)) 59 | (is (= 3 (count changed-again)))) 60 | ;; Check repl-type :cljs 61 | 62 | (with-redefs [cljs/grab-cljs-env (constantly true)] 63 | (update-and-send-cache-tester nil msg sent-value) 64 | (let [{:keys [repl-type changed-namespaces]} @sent-value] 65 | (is (= :cljs repl-type)) 66 | (is (map? changed-namespaces)))))) 67 | 68 | (def ^:private fn-test-var nil) 69 | (def ^:private fn-test-def-fn (fn [])) 70 | (defn- fn-test-defn-fn []) 71 | (defmulti fn-test-multi (fn [x])) 72 | 73 | (deftest filter-core-and-get-meta-test 74 | (is (= (st/filter-core-and-get-meta {'and #'and, 'b #'map, 'c #'deftest}) 75 | '{c {:macro "true" 76 | :arglists "([name & body])" 77 | :fn "true" 78 | :doc "\"Defines a test function with no arguments. Test functions may call\\n other tests, so tests may be composed. If you compose tests, you\\n should also define a function named test-ns-hook; run-tests will\\n call test-ns-hook instead of testing all vars.\\n\\n Note: Actually, the test body goes in the :test metadata on the var,\\n and the real function (the value of the var) calls test-var on\\n itself.\\n\\n When *load-tests* is false, deftest is ignored.\""}})) 79 | (is (= [nil "true" "true" "true"] 80 | (map (comp :fn 81 | (st/filter-core-and-get-meta 82 | {'fn-test-var #'fn-test-var 83 | 'fn-test-def-fn #'fn-test-def-fn 84 | 'fn-test-defn-fn #'fn-test-defn-fn 85 | 'fn-test-multi #'fn-test-multi})) 86 | '[fn-test-var fn-test-def-fn fn-test-defn-fn fn-test-multi]))) 87 | (is (-> (find-ns 'clojure.core) 88 | ns-map st/filter-core-and-get-meta 89 | seq not))) 90 | 91 | (defn- test-fn "docstring" 92 | ([a b] nil) 93 | ([a] nil) 94 | ([])) 95 | 96 | (deftest ns-as-map-test 97 | (is (empty? (st/ns-as-map nil))) 98 | (let [m (meta #'make-transport-test)] 99 | ;; #'make-transport refers to the deftest, and not the defn 100 | (->> (interleave um/relevant-meta-keys (range)) 101 | (apply hash-map) 102 | (alter-meta! #'make-transport-test merge)) 103 | ;; note: this test inspects the current namespace, so the 104 | ;; test conditions below may change as the namespace declaration 105 | ;; evolves. 106 | (let [{:keys [interns aliases] :as ns} 107 | (st/ns-as-map (find-ns 'cider.nrepl.middleware.track-state-test))] 108 | (is (< 5 (count interns))) 109 | (is (map? interns)) 110 | (is (interns 'ns-as-map-test)) 111 | (is (:test (interns 'ns-as-map-test))) 112 | (is (= (into #{} (keys (interns 'make-transport-test))) 113 | (into #{} um/relevant-meta-keys))) 114 | (is (= 3 (count aliases))) 115 | (is (= 'cider.nrepl.middleware.track-state (aliases 'st)))) 116 | (alter-meta! #'make-transport-test (fn [x y] y) m)) 117 | (let [{:keys [interns aliases] :as ns} 118 | (st/ns-as-map (find-ns 'cider.nrepl.middleware.track-state-test))] 119 | (is interns))) 120 | 121 | (deftest ns-as-map-cljs-test 122 | (let [cljs-ns {:use-macros {'sym-0 #'test-fn} 123 | :uses {'sym-1 #'ns-as-map-cljs-test} 124 | :defs {'sym-2 #'ns-as-map-cljs-test 125 | 'a-fn {:fn-var true} 126 | 'a-var {}} 127 | :require-macros {'sym-3 'some-namespace} 128 | :requires {'sym-4 'some-namespace}} 129 | {:keys [aliases interns]} (st/ns-as-map cljs-ns)] 130 | (is (= '{sym-3 some-namespace sym-4 some-namespace} aliases)) 131 | (is (= '{sym-0 {:arglists ([]) :macro true} 132 | sym-1 {:arglists ([])} 133 | sym-2 {} 134 | a-var {} 135 | a-fn {:fn "true"}} 136 | interns)))) 137 | 138 | (deftest calculate-used-aliases-test 139 | (is (contains? (st/merge-used-aliases some-ns-map nil ns-name) 140 | 'cider.nrepl.middleware.track-state)) 141 | (is (contains? (st/merge-used-aliases some-ns-map {'cider.nrepl.middleware.track-state nil} ns-name) 142 | 'cider.nrepl.middleware.track-state)) 143 | (is (contains? (st/merge-used-aliases (assoc some-ns-map 'cider.nrepl.middleware.track-state nil) nil ns-name) 144 | 'cider.nrepl.middleware.track-state))) 145 | 146 | (deftest ensure-clojure-core-present 147 | (testing "if clojurescript doesn't add clojure" 148 | ;; note that the {:msg :stuff} object is much more complex in 149 | ;; actual use and in fact the msg is much more complicated 150 | (is (-> (st/ensure-clojure-core-present {} 151 | {'cljs.core :present} 152 | {:msg :stuff}) 153 | keys 154 | #{st/clojure-core} 155 | not))) 156 | (testing "if core already present doesn't overwrite or add" 157 | (is (= :present 158 | (-> (st/ensure-clojure-core-present {} 159 | {st/clojure-core :present} 160 | nil) 161 | (get st/clojure-core))))) 162 | (testing "if core missing and not cljs, it adds it" 163 | (is (= st/clojure-core-map 164 | (-> (st/ensure-clojure-core-present {} {} nil) 165 | (get st/clojure-core)))))) 166 | -------------------------------------------------------------------------------- /test/cljs/cider/nrepl/middleware/cljs_macroexpand_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.cljs-macroexpand-test 2 | (:require 3 | [cider.nrepl.piggieback-test :refer [piggieback-fixture]] 4 | [cider.nrepl.test-session :as session] 5 | [clojure.test :refer :all])) 6 | 7 | (use-fixtures :once piggieback-fixture) 8 | 9 | (deftest cljs-macroexpansion-test 10 | (testing "macroexpand-1 expander works" 11 | (let [{:keys [expansion status]} (session/message {:op "macroexpand" 12 | :expander "macroexpand-1" 13 | :code "nil" 14 | :ns "cljs.core"})] 15 | (is (= "nil" expansion)) 16 | (is (= #{"done"} status))) 17 | 18 | (let [{:keys [expansion status]} (session/message {:op "macroexpand" 19 | :expander "macroexpand-1" 20 | :code "(pos? 1)" 21 | :ns "cljs.core"})] 22 | (is (= "(cljs.core/> 1 0)" expansion)) 23 | (is (= #{"done"} status))) 24 | 25 | (let [{:keys [expansion status]} (session/message {:op "macroexpand" 26 | :expander "macroexpand-1" 27 | :code "(pos? (pos? 1))" 28 | :ns "cljs.core"})] 29 | (is (= "(cljs.core/> (pos? 1) 0)" expansion)) 30 | (is (= #{"done"} status)))) 31 | 32 | (testing "macroexpand expander works" 33 | (let [{:keys [expansion status]} (session/message {:op "macroexpand" 34 | :expander "macroexpand" 35 | :code "nil" 36 | :ns "cljs.core"})] 37 | (is (= "nil" expansion)) 38 | (is (= #{"done"} status))) 39 | 40 | (let [{:keys [expansion status]} (session/message {:op "macroexpand" 41 | :expander "macroexpand" 42 | :code "(pos? 1)" 43 | :ns "cljs.core"})] 44 | (is (= "(js* \"(~{} > ~{})\" 1 0)" expansion)) 45 | (is (= #{"done"} status))) 46 | 47 | (let [{:keys [expansion status]} (session/message {:op "macroexpand" 48 | :expander "macroexpand" 49 | :code "(pos? (pos? 1))" 50 | :ns "cljs.core"})] 51 | (is (= "(js* \"(~{} > ~{})\" (pos? 1) 0)" expansion)) 52 | (is (= #{"done"} status)))) 53 | 54 | (testing "macroexpand-all expander works" 55 | (let [{:keys [expansion status]} (session/message {:op "macroexpand" 56 | :expander "macroexpand-all" 57 | :code "nil" 58 | :ns "cljs.core"})] 59 | (is (= "nil" expansion)) 60 | (is (= #{"done"} status))) 61 | 62 | (let [{:keys [expansion status]} (session/message {:op "macroexpand" 63 | :expander "macroexpand-all" 64 | :code "(pos? 1)" 65 | :ns "cljs.core"})] 66 | (is (= "(js* \"(~{} > ~{})\" 1 0)" expansion)) 67 | (is (= #{"done"} status))) 68 | 69 | (let [{:keys [expansion status]} (session/message {:op "macroexpand" 70 | :expander "macroexpand-all" 71 | :code "(pos? (pos? 1))" 72 | :ns "cljs.core"})] 73 | (is (= "(js* \"(~{} > ~{})\" (js* \"(~{} > ~{})\" 1 0) 0)" expansion)) 74 | (is (= #{"done"} status)))) 75 | 76 | (testing "invalid expander" 77 | (let [{:keys [err ex status] :as response} (session/message {:op "macroexpand" 78 | :expander "foo" 79 | :code "(pos? 1)" 80 | :ns "cljs.core"})] 81 | (is err) 82 | (is ex) 83 | (is (= #{"done" "macroexpand-error"} status)))) 84 | 85 | (testing "display-namespaces: qualified" 86 | (let [{:keys [expansion status]} (session/message {:op "macroexpand" 87 | :expander "macroexpand-1" 88 | :code "(defn x [] (clojure.set/union))" 89 | :ns "clojure.data" 90 | :display-namespaces "qualified"})] 91 | (is (= "(def x (cljs.core/fn ([] (clojure.set/union))))" expansion)) 92 | (is (= #{"done"} status)))) 93 | 94 | (testing "display-namespaces: none" 95 | (let [{:keys [expansion status]} (session/message {:op "macroexpand" 96 | :expander "macroexpand-1" 97 | :code "(defn x [] (clojure.set/union))" 98 | :ns "clojure.data" 99 | :display-namespaces "none"})] 100 | (is (= "(def x (fn ([] (union))))" expansion)) 101 | (is (= #{"done"} status))) 102 | 103 | (let [{:keys [expansion status] :as response} (session/message {:op "macroexpand" 104 | :expander "macroexpand-1" 105 | :code "(defn x [] (.log js/console 1))" 106 | :ns "clojure.data" 107 | :display-namespaces "none"})] 108 | (is (= "(def x (fn ([] (.log js/console 1))))" expansion)) 109 | (is (= #{"done"} status)))) 110 | 111 | (testing "display-namespaces: tidy" 112 | (let [{:keys [expansion status] :as response} (session/message {:op "macroexpand" 113 | :expander "macroexpand-1" 114 | :code "(defn x [] (clojure.set/union))" 115 | :ns "clojure.data" 116 | :display-namespaces "tidy"})] 117 | (is (= "(def x (fn ([] (set/union))))" expansion)) 118 | (is (= #{"done"} status)))) 119 | 120 | (testing "invalid display-namespaces" 121 | (let [{:keys [err ex status]} (session/message {:op "macroexpand" 122 | :expander "macroexpand-1" 123 | :code "(defn x [] nil)" 124 | :display-namespaces "foo"})] 125 | (is err) 126 | (is ex) 127 | (is (= #{"done" "macroexpand-error"} status)))) 128 | 129 | (testing "print-meta" 130 | (let [{:keys [expansion status]} (session/message {:op "macroexpand" 131 | :expander "macroexpand" 132 | :code "(defn- x [] nil)" 133 | :print-meta "true"})] 134 | (is (= "(def ^{:private true, :arglists (quote ([]))} x\n (clojure.core/fn ([] nil)))" 135 | expansion)) 136 | (is (= #{"done"} status))))) 137 | -------------------------------------------------------------------------------- /test/clj/cider/nrepl/middleware/stacktrace_test.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.stacktrace-test 2 | (:require 3 | [cider.nrepl.middleware.stacktrace :refer :all] 4 | [cider.nrepl.pprint :refer [pprint]] 5 | [clojure.test :refer :all])) 6 | 7 | ;; # Utils 8 | 9 | (defn causes 10 | [form] 11 | (analyze-causes 12 | (try (eval form) 13 | (catch Exception e 14 | e)) 15 | pprint 16 | {})) 17 | 18 | (defn stack-frames 19 | [form] 20 | (analyze-stacktrace 21 | (try (eval form) 22 | (catch Exception e 23 | e)))) 24 | 25 | ;; ## Test fixtures 26 | 27 | (def form1 '(throw (ex-info "oops" {:x 1} (ex-info "cause" {:y 2})))) 28 | (def form2 '(do (defn oops [] (+ 1 "2")) 29 | (oops))) 30 | (def form3 '(not-defined)) 31 | (defn divi [x y] (/ x y)) 32 | (def form4 '(divi 1 0)) 33 | 34 | (def frames1 (stack-frames form1)) 35 | (def frames2 (stack-frames form2)) 36 | (def frames4 (stack-frames form4)) 37 | (def causes1 (causes form1)) 38 | (def causes2 (causes form2)) 39 | (def causes3 (causes form3)) 40 | 41 | ;; ## Tests 42 | 43 | (deftest stacktrace-frames-test 44 | (testing "File types" 45 | ;; Should be clj and java only. 46 | (let [ts1 (group-by :type frames1) 47 | ts2 (group-by :type frames2)] 48 | (is (= #{:clj :java} (set (keys ts1)))) 49 | (is (= #{:clj :java} (set (keys ts2)))))) 50 | (testing "Full file mappings" 51 | (is (every? 52 | #(.endsWith (:file-url %) "!/clojure/core.clj") 53 | (filter #(= "clojure.core" (:ns %)) 54 | frames1))) 55 | (is (->> (filter #(some-> % :ns (.contains "cider")) frames1) 56 | (remove (comp #{"invoke" "invokeStatic"} :method)) ;; these don't have a file-url 57 | (every? 58 | #(.startsWith (:file-url %) "file:/"))))) 59 | (testing "Clojure ns, fn, and var" 60 | ;; All Clojure frames should have non-nil :ns :fn and :var attributes. 61 | (is (every? #(every? identity ((juxt :ns :fn :var) %)) 62 | (filter #(= :clj (:type %)) frames1))) 63 | (is (every? #(every? identity ((juxt :ns :fn :var) %)) 64 | (filter #(= :clj (:type %)) frames2)))) 65 | (testing "Clojure name demunging" 66 | ;; Clojure fn names should be free of munging characters. 67 | (is (not-any? #(re-find #"[_$]|(--\d+)" (:fn %)) 68 | (filter :fn frames1))) 69 | (is (not-any? #(re-find #"[_$]|(--\d+)" (:fn %)) 70 | (filter :fn frames2))))) 71 | 72 | (deftest stacktrace-frame-flags-test 73 | (testing "Flags" 74 | (testing "for file type" 75 | ;; Every frame should have its file type added as a flag. 76 | (is (every? #(contains? (:flags %) (:type %)) frames1)) 77 | (is (every? #(contains? (:flags %) (:type %)) frames2))) 78 | (testing "for tooling" 79 | ;; Tooling frames are classes named with 'clojure' or 'nrepl', 80 | ;; or are java thread runners...or calls made from these. 81 | (is (some #(re-find #"(clojure|nrepl|run)" (:name %)) 82 | (filter (comp :tooling :flags) frames1))) 83 | (is (some #(re-find #"(clojure|nrepl|run)" (:name %)) 84 | (filter (comp :tooling :flags) frames2)))) 85 | (testing "for project" 86 | (is (not-empty (filter (comp :project :flags) frames4)))) 87 | (testing "for duplicate frames" 88 | ;; Index frames. For all frames flagged as :dup, the frame above it in 89 | ;; the stack (index i - 1) should be substantially the same source info. 90 | (let [ixd1 (zipmap (iterate inc 0) frames1) 91 | ixd2 (zipmap (iterate inc 0) frames2) 92 | dup? #(or (= (:name %1) (:name %2)) 93 | (and (= (:file %1) (:file %2)) 94 | (= (:line %1) (:line %2))))] 95 | (is (every? (fn [[i v]] (dup? v (get ixd1 (dec i)))) 96 | (filter (comp :dup :flags val) ixd1))) 97 | (is (every? (fn [[i v]] (dup? v (get ixd2 (dec i)))) 98 | (filter (comp :dup :flags val) ixd2))))))) 99 | 100 | (deftest exception-causes-test 101 | (testing "Exception cause unrolling" 102 | (is (= 2 (count causes1))) 103 | (is (= 1 (count causes2)))) 104 | (testing "Exception data" 105 | ;; If ex-data is present, the cause should have a :data attribute. 106 | (is (:data (first causes1))) 107 | (is (not (:data (first causes2)))))) 108 | 109 | (deftest ex-data-filtering-test 110 | (is (= {:a :b :c :d} 111 | (filtered-ex-data (ex-info "msg" {:a :b :c :d :repl-env :e}))))) 112 | 113 | (deftest cause-data-pretty-printing-test 114 | (testing "print-length" 115 | (is (= "{:a (0 1 2 ...)}" 116 | (:data (analyze-cause (ex-info "" {:a (range)}) pprint {:length 3}))))) 117 | (testing "print-level" 118 | (is (= "{:a {#}}" 119 | (:data (analyze-cause (ex-info "" {:a {:b {:c {:d {:e nil}}}}}) pprint {:level 3}))))) 120 | (testing "compilation errors" 121 | (let [clojure-version ((juxt :major :minor) *clojure-version*)] 122 | (if (< (compare clojure-version [1 10]) 0) 123 | ;; 1.8 / 1.9 124 | (is (re-find #"Unable to resolve symbol: not-defined in this context" 125 | (:message (first causes3)))) 126 | 127 | ;; 1.10+ 128 | (is (re-find #"Syntax error compiling at \(cider/nrepl/middleware/stacktrace_test\.clj:" 129 | (:message (first causes3)))))))) 130 | 131 | (deftest compilation-errors-test 132 | (testing "extract-location" 133 | (is (= {:class "clojure.lang.Compiler$CompilerException" 134 | :message "java.lang.RuntimeException: Unable to resolve symbol: foo in this context" 135 | :file "/foo/bar/baz.clj" 136 | :file-url nil 137 | :path "/foo/bar/baz.clj" 138 | :line 1 139 | :column 42} 140 | (extract-location {:class "clojure.lang.Compiler$CompilerException" 141 | :message "java.lang.RuntimeException: Unable to resolve symbol: foo in this context, compiling:(/foo/bar/baz.clj:1:42)"}))) 142 | 143 | (is (= {:class "clojure.lang.Compiler$CompilerException" 144 | :message "java.lang.NegativeArraySizeException" 145 | :file "/foo/bar/baz.clj" 146 | :file-url nil 147 | :path "/foo/bar/baz.clj" 148 | :line 1 149 | :column 42} 150 | (extract-location {:class "clojure.lang.Compiler$CompilerException" 151 | :message "java.lang.NegativeArraySizeException, compiling:(/foo/bar/baz.clj:1:42)"})))) 152 | (testing "extract-location with location-data already present" 153 | (= {:class "clojure.lang.Compiler$CompilerException" 154 | :message "Syntax error macroexpanding clojure.core/let at (1:1)." 155 | :file nil 156 | :file-url nil 157 | :path "/foo/bar/baz.clj" 158 | :line 1 159 | :column 42} 160 | (extract-location {:class "clojure.lang.Compiler$CompilerException" 161 | :location {:clojure.error/line 1 162 | :clojure.error/column 42 163 | :clojure.error/source "/foo/bar/baz.clj" 164 | :clojure.error/phase :macroexpand 165 | :clojure.error/symbol 'clojure.core/let} 166 | :message "Syntax error macroexpanding clojure.core/let at (1:1)."})))) 167 | 168 | (deftest analyze-cause-test 169 | (testing "check that location-data is returned" 170 | (let [e (ex-info "wat?" {:clojure.error/line 1 171 | :clojure.error/column 42 172 | :clojure.error/source "/foo/bar/baz.clj" 173 | :clojure.error/phase :macroexpand 174 | :clojure.error/symbol 'clojure.core/let}) 175 | cause (analyze-cause e identity {})] 176 | (is (= {:clojure.error/line 1 177 | :clojure.error/column 42 178 | :clojure.error/source "/foo/bar/baz.clj" 179 | :clojure.error/phase :macroexpand 180 | :clojure.error/symbol 'clojure.core/let} 181 | (:location cause)))))) 182 | -------------------------------------------------------------------------------- /src/cider/nrepl/middleware/util/error_handling.clj: -------------------------------------------------------------------------------- 1 | (ns cider.nrepl.middleware.util.error-handling 2 | "Utilities to safely reply to op requests and help deal with the 3 | errors/exceptions that might arise from doing so." 4 | (:refer-clojure :exclude [error-handler]) 5 | (:require 6 | [clojure.set :as set] 7 | [clojure.walk :as walk] 8 | [nrepl.misc :refer [response-for]] 9 | [nrepl.transport :as transport]) 10 | (:import 11 | java.io.InputStream 12 | clojure.lang.RT)) 13 | 14 | (def ^:private print-cause-trace 15 | (delay 16 | (do 17 | (require 'clojure.stacktrace) 18 | (resolve 'clojure.stacktrace/print-cause-trace)))) 19 | 20 | (def ^:private analyze-causes 21 | (delay 22 | (do 23 | (require 'cider.nrepl.middleware.stacktrace) 24 | (resolve 'cider.nrepl.middleware.stacktrace/analyze-causes)))) 25 | 26 | ;;; UTILITY FUNCTIONS 27 | 28 | (defn error-summary 29 | "Takes a `java.lang.Exception` as `ex` and returns a map summarizing 30 | the exception. If present, the varargs are converted to a set and 31 | used as the value for the :status key." 32 | [ex & statuses] 33 | (merge {:ex (str (class ex)) 34 | :err (with-out-str (@print-cause-trace ex)) 35 | :root-ex (-> (#'clojure.main/root-cause ex) class str)} 36 | (when statuses {:status (set statuses)}))) 37 | 38 | (defn pp-stacktrace 39 | "Takes a `java.lang.Exception` as `ex` and a pretty-print function 40 | as `pprint-fn`, then returns a pretty-printed version of the 41 | exception that can be rendered by CIDER's stacktrace viewer." 42 | [ex pprint-fn print-options] 43 | {:pp-stacktrace (@analyze-causes ex pprint-fn print-options)}) 44 | 45 | (defn base-error-response 46 | "Takes a CIDER-nREPL message as `msg`, an Exception `ex`, and a 47 | non-collection vararg of `statuses`. This will return the standard 48 | response for CIDER-nREPL sync-op errors that can be rendered by 49 | CIDER's stacktrace viewer. N.B., statuses such as `:done` and 50 | `:-error` are NOT automatically added" 51 | [msg ex & statuses] 52 | (response-for msg (merge (apply error-summary ex statuses) 53 | (pp-stacktrace ex (:pprint-fn msg) (:print-options msg))))) 54 | 55 | (defn- normalize-status 56 | "Accepts various representations of an nREPL reply message's status 57 | and normalizes them to a set. Accepts and normalizes as follows: 58 | 59 | - nil => empty set 60 | - set => returns the set 61 | - coll => set representation of coll's items 62 | - single item (kw, string, int, etc.) => set containing single item" 63 | [status] 64 | (cond (nil? status) #{} 65 | (set? status) status 66 | (coll? status) (set status) 67 | :else (set [status]))) 68 | 69 | (defn- selector 70 | "Selector used for dispatch on both the `op` and `error` handler 71 | multimethods. The handlers expect one of the following: 72 | 73 | - map => A map that will form the basis of the nREPL reply 74 | message. 75 | - fn (NOT ifn's) => A fn with arity 1 for ops and 2 for errors, must 76 | return a map that will form the basis of the nREPL reply message. 77 | - coll => The coll will be turned into a set which is used as the 78 | reply message's status. 79 | - kw => Wrapped in a set and used as the reply message's status. 80 | - ::default => used as the default error handler, which simply adds 81 | a reasonably named keyword (ie, `:-error`) to the status." 82 | [input & _] 83 | (cond (= ::default input) :default 84 | (fn? input) :function 85 | (map? input) :inline-reply 86 | (coll? input) :status-coll 87 | (keyword? input) :status-item)) 88 | 89 | (defn- shallow-bencodable? 90 | "Returns false if `item`'s type can't be bencoded as defined by the 91 | algorithm in `nrepl.bencode/write-bencode`. Does not 92 | examine the elements of a collection to ensure that the enclosed 93 | elements are also bencodable, and so you probably actually want to 94 | use `deep-bencodable-or-fail` or write something similar." 95 | [item] 96 | (cond 97 | (instance? (RT/classForName "[B") item) :bytes 98 | (instance? InputStream item) :input-stream 99 | (integer? item) :integer 100 | (string? item) :string 101 | (symbol? item) :named 102 | (keyword? item) :named 103 | (map? item) :map 104 | (or (nil? item) (coll? item) (.isArray (class item))) :list 105 | :else false)) 106 | 107 | (defn- deep-bencodable-or-fail 108 | "Walks through the data structure provided by `item` and returns 109 | true if it -- and all nested elements -- are bencodable as defined 110 | by the algorithm in `nrepl.bencode/write-bencode`. If 111 | any part of `input` is not bencodable, will throw an 112 | `IllegalArgumentException`. See `cider-nrepl` bug #332 at 113 | https://github.com/clojure-emacs/cider-nrepl/issues/332 for further 114 | details." 115 | [item] 116 | (walk/prewalk 117 | #(if (shallow-bencodable? %) 118 | % 119 | (throw (IllegalArgumentException. (format "Can't bencode %s: %s" (.getName (class %)) %)))) 120 | item) 121 | true) ;; Need to actually return truthy since `nil` is bencodable 122 | 123 | ;;; ERROR HANDLER - see selector docstring 124 | 125 | (defmulti error-handler selector) 126 | 127 | (defmethod error-handler :inline-reply [answer msg e] 128 | (let [reply (base-error-response msg e) 129 | terminal-status (set/union #{:done} (normalize-status (:status answer)))] 130 | (response-for msg (assoc reply :status terminal-status)))) 131 | 132 | (defmethod error-handler :function [f msg e] 133 | (error-handler (f msg e) msg e)) 134 | 135 | (defmethod error-handler :status-coll [statuses msg e] 136 | (error-handler {:status (set statuses)} msg e)) 137 | 138 | (defmethod error-handler :status-item [status msg e] 139 | (error-handler {:status (set [status])} msg e)) 140 | 141 | (defmethod error-handler :default [_ msg e] 142 | (error-handler (keyword (str (:op msg) "-error")) msg e)) 143 | 144 | ;;; OP HANDLER - see selector docstring 145 | 146 | (defmulti op-handler selector) 147 | 148 | (defmethod op-handler :inline-reply 149 | [answer msg] 150 | (let [terminal-status (set/union #{:done} (normalize-status (:status answer)))] 151 | ;; Check the bencodability of `answer` (the current transport can 152 | ;; only send non-bencodable data if stored under the `:value` 153 | ;; key). If non-bencodable elements exist, throw an exception. 154 | (deep-bencodable-or-fail (dissoc answer :value)) 155 | ;; If bencodable, create a terminated reply message. 156 | (response-for msg (assoc answer :status terminal-status)))) 157 | 158 | (defmethod op-handler :function [f msg] 159 | (op-handler (f msg) msg)) 160 | 161 | (defmethod op-handler :status-coll [statuses msg] 162 | (op-handler {:status (set statuses)} msg)) 163 | 164 | (defmethod op-handler :status-item [status msg] 165 | (op-handler {:status (set [status])} msg)) 166 | 167 | ;;; SAFE TRANSPORT WRAPPER 168 | 169 | (defmacro with-safe-transport 170 | "This will safely handle all the transport calls mapped out in the 171 | `handle-` functions. All checked exceptions will be caught, 172 | analyzed by the `cider.nrepl.middleware.stacktrace` middleware, and an error 173 | message will be returned to the client with a stacktrace renderable by the 174 | default CIDER stacktrace viewer. Takes the default pass-through `handler` 175 | current `msg` and a list of pairings between op names and actions used to 176 | process the ops as varargs. Actions can either be expressed as a 2-item vector 177 | with the head being the op-action and the tail being the error-action, or if 178 | the default error handler is sufficient, then the op name can be paired 179 | directly to the op-action. 180 | 181 | Actions can be functions, maps, non-associate collections, and single items 182 | such as kw's, strings, numbers, etc. The utilization of each type is discussed 183 | above in the `selector` method." 184 | {:style/indent 2} 185 | [handler msg & pairings] 186 | `(let [{op# :op transport# :transport :as msg#} ~msg] 187 | (if-let [action# (get (hash-map ~@pairings) op#)] 188 | (let [[op-action# err-action#] (if (vector? action#) action# [action# ::default])] 189 | (try (transport/send transport# (op-handler op-action# msg#)) 190 | (catch Exception e# (transport/send transport# (error-handler err-action# msg# e#))))) 191 | (~handler msg#)))) 192 | --------------------------------------------------------------------------------