Skip to content

nrepl #99

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 5 commits into from
Oct 27, 2012
Merged

nrepl #99

Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
1053ecb
interim commit while changing machines
Oct 25, 2012
7736b3d
Working with nrepl.
Oct 25, 2012
023dd07
Load buffer before running tests to ensure namespace exists.
Oct 25, 2012
41102f5
Move load buffer to test clear and remove uneeded load-file call
Oct 25, 2012
a7ae012
Fix random character and nrepl require
Oct 25, 2012
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
136 changes: 67 additions & 69 deletions clojure-test-mode.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,7 @@

;;; Usage:

;; Once you have a SLIME session active, you can run the tests in the
;; Once you have an nrepl session active, you can run the tests in the
;; current buffer with C-c C-,. Failing tests and errors will be
;; highlighted using overlays. To clear the overlays, use C-c k.

Expand Down Expand Up @@ -123,16 +123,12 @@
(require 'cl)
(require 'clojure-mode)
(require 'which-func)
(require 'nrepl nil t)
(require 'slime nil t)
(require 'nrepl)

(declare-function nrepl-repl-buffer "nrepl.el")
(declare-function nrepl-make-response-handler "nrepl.el")
(declare-function nrepl-send-string "nrepl.el")
(declare-function nrepl-current-ns "nrepl.el")
(declare-function slime-eval-async "slime.el")
(declare-function slime-connection-name "slime.el")
(declare-function slime-connected-p "slime.el")

;; Faces

Expand Down Expand Up @@ -176,26 +172,29 @@

;; Support Functions

(defun clojure-test-make-handler (value-handler)
(let ((out-handler (lambda (_ out)
(with-current-buffer (nrepl-repl-buffer)
(insert out)))))
(nrepl-make-response-handler (current-buffer)
(defun clojure-test-nrepl-connected-p ()
(get-buffer "*nrepl-connection*"))

(defun clojure-test-make-handler (callback)
(lexical-let ((buffer (current-buffer))
(callback callback))
(nrepl-make-response-handler buffer
(lambda (buffer value)
(funcall callback buffer value))
(lambda (buffer value)
(funcall value-handler value))
out-handler out-handler nil)))
(nrepl-emit-interactive-output value))
(lambda (buffer err)
(nrepl-emit-interactive-output err))
'())))

(defun clojure-test-eval (string &optional handler)
(if (get-buffer "*nrepl-connection*")
(nrepl-send-string string (or (nrepl-current-ns) "user")
(clojure-test-make-handler (or handler #'identity)))
(slime-eval-async `(swank:eval-and-grab-output ,string)
(or handler #'identity))))
(nrepl-send-string string
(clojure-test-make-handler (or handler #'identity))
(or (nrepl-current-ns) "user")))

(defun clojure-test-load-reporting ()
"Redefine the test-is report function to store results in metadata."
(when (or (get-buffer "*nrepl-connection*")
(eq (compare-strings "clojure" 0 7 (slime-connection-name) 0 7) t))
(when (clojure-test-nrepl-connected-p)
(clojure-test-eval
"(ns clojure.test.mode
(:use [clojure.test :only [file-position *testing-vars* *test-out*
Expand Down Expand Up @@ -241,30 +240,19 @@
(do-report {:type :end-test-ns, :ns ns-obj}))
(do-report (assoc @*report-counters* :type :summary))))")))

(defun clojure-test-get-results (result)
(clojure-test-eval
(concat "(map #(cons (str (:name (meta %)))
(defun clojure-test-get-results (buffer result)
(with-current-buffer buffer
(clojure-test-eval
(concat "(map #(cons (str (:name (meta %)))
(:status (meta %))) (vals (ns-interns '"
(clojure-find-ns) ")))")
#'clojure-test-extract-results))

(defun clojure-test-echo-results ()
(message
(propertize
(format "Ran %s tests. %s failures, %s errors."
clojure-test-count clojure-test-failure-count
clojure-test-error-count)
'face
(cond ((not (= clojure-test-error-count 0)) 'clojure-test-error-face)
((not (= clojure-test-failure-count 0)) 'clojure-test-failure-face)
(t 'clojure-test-success-face)))))
(clojure-find-ns) ")))")
#'clojure-test-extract-results)))

(defun clojure-test-extract-results (results)
(let ((result-vars (read (cadr results))))
;; slime-eval-async hands us a cons with a useless car
(mapc #'clojure-test-extract-result result-vars)
;; (slime-repl-emit (concat "\n" (make-string (1- (window-width)) ?=) "\n"))
(clojure-test-echo-results)))
(defun clojure-test-extract-results (buffer results)
(with-current-buffer buffer
(let ((result-vars (read results)))
(mapc #'clojure-test-extract-result result-vars)
(clojure-test-echo-results))))

(defun clojure-test-extract-result (result)
"Parse the result from a single test. May contain multiple is blocks."
Expand All @@ -280,6 +268,16 @@
(incf clojure-test-error-count)
(clojure-test-highlight-problem line event actual)))))))

(defun clojure-test-echo-results ()
(message
(propertize
(format "Ran %s tests. %s failures, %s errors."
clojure-test-count clojure-test-failure-count
clojure-test-error-count)
'face
(cond ((not (= clojure-test-error-count 0)) 'clojure-test-error-face)
((not (= clojure-test-failure-count 0)) 'clojure-test-failure-face)
(t 'clojure-test-success-face)))))

(defun clojure-test-highlight-problem (line event message)
(save-excursion
Expand Down Expand Up @@ -333,7 +331,7 @@ Retuns the problem overlay if such a position is found, otherwise nil."
clojure-test-ns-segment-position))
(before (subseq segments 0 clojure-test-ns-segment-position))
(after (subseq segments clojure-test-ns-segment-position))
(newfile (replace-regexp-in-string "_test$" "" (car after)))
(newfile (replace-regexp-in-string "_test$" "" (car after)))
(impl-segments (append before (list newfile))))
(mapconcat 'identity impl-segments "/")))

Expand All @@ -348,35 +346,35 @@ Retuns the problem overlay if such a position is found, otherwise nil."
(if (not (clojure-in-tests-p))
(clojure-jump-to-test))
(clojure-test-clear
(lambda (&rest args)
;; clojure-test-eval will wrap in with-out-str
(clojure-test-eval (format "(clojure.core/load-file \"%s\")"
(expand-file-name (buffer-file-name)))
(lambda (&rest args)
(clojure-test-eval "(binding [clojure.test/report
clojure.test.mode/report]
(clojure.test/run-tests))"
#'clojure-test-get-results)))))))
(lambda (buffer value)
(with-current-buffer buffer
(nrepl-load-current-buffer)
(clojure-test-eval "(binding [clojure.test/report clojure.test.mode/report]
(clojure.test/run-tests))"
#'clojure-test-get-results))))))

(defun clojure-test-run-test ()
"Run the test at point."
(interactive)
(save-some-buffers nil (lambda () (equal major-mode 'clojure-mode)))
(clojure-test-clear
(lambda (&rest args)
(let* ((f (which-function))
(test-name (if (listp f) (first f) f)))
(clojure-test-eval
(format "(binding [clojure.test/report clojure.test.mode/report]
(load-file \"%s\")
(clojure.test.mode/clojure-test-mode-test-one-in-ns '%s '%s)
(cons (:name (meta (var %s))) (:status (meta (var %s)))))"
(buffer-file-name) (clojure-find-ns)
test-name test-name test-name)
(lambda (result-str)
(let ((result (read result-str)))
(if (cdr result)
(clojure-test-extract-result result)
(message "Not in a test.")))))))))
(lambda (buffer value)
(with-current-buffer buffer
(nrepl-load-current-buffer)
(let* ((f (which-function))
(test-name (if (listp f) (first f) f)))
(clojure-test-eval
(format "(binding [clojure.test/report clojure.test.mode/report]
(clojure.test.mode/clojure-test-mode-test-one-in-ns '%s '%s)
(cons (:name (meta (var %s))) (:status (meta (var %s)))))"
(clojure-find-ns)
test-name test-name test-name)
(lambda (buffer result-str)
(with-current-buffer buffer
(let ((result (read result-str)))
(if (cdr result)
(clojure-test-extract-result result)
(message "Not in a test.")))))))))))

(defun clojure-test-show-result ()
"Show the result of the test under point."
Expand All @@ -394,6 +392,7 @@ Retuns the problem overlay if such a position is found, otherwise nil."
(setq clojure-test-count 0
clojure-test-failure-count 0
clojure-test-error-count 0)
(nrepl-load-current-buffer)
(clojure-test-eval
"(doseq [t (vals (ns-interns *ns*))]
(alter-meta! t assoc :status [])
Expand Down Expand Up @@ -445,11 +444,10 @@ Retuns the problem overlay if such a position is found, otherwise nil."
(define-minor-mode clojure-test-mode
"A minor mode for running Clojure tests."
nil " Test" clojure-test-mode-map
(when (or (get-buffer "*nrepl-connection*") (slime-connected-p))
(when (clojure-test-nrepl-connected-p)
(clojure-test-load-reporting)))

(add-hook 'nrepl-connected-hook 'clojure-test-load-reporting)
(add-hook 'slime-connected-hook 'clojure-test-load-reporting)

;;;###autoload
(progn
Expand Down