Skip to content
This repository
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 281 lines (228 sloc) 10.11 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280
;;; clojure-test-mode.el --- Minor mode for Clojure tests

;; Copyright (C) 2009 Phil Hagelberg

;; Author: Phil Hagelberg <technomancy@gmail.com>
;; URL: http://emacswiki.org/cgi-bin/wiki/ClojureTestMode
;; Version: 1.2
;; Keywords: languages, lisp
;; Package-Requires: ((clojure-mode "1.1"))

;; This file is not part of GNU Emacs.

;;; Commentary:

;; This file provides support for running Clojure tests (using the
;; test-is framework) via SLIME and seeing feedback in the test buffer
;; about which tests failed or errored.

;;; Installation:

;; If you use ELPA, you can install via the M-x package-list-packages
;; interface. This is preferrable as you will have access to updates
;; automatically.

;; If you need to install by hand for some reason:

;; (0) Add this file to your load-path, usually the ~/.emacs.d directory.
;; (1) Either:
;; Add these lines to your .emacs:
;; (autoload 'clojure-test-mode "clojure-test-mode" "Clojure test mode" t)
;; (autoload 'clojure-test-maybe-enable "clojure-test-mode" "" t)
;; (add-hook 'clojure-mode-hook 'clojure-test-maybe-enable)
;;
;; Or generate autoloads with the `update-directory-autoloads' function.

;; This depends on swank-clojure to work properly. Unfortunately since
;; SLIME is a complex dependency, it hasn't been packaged in ELPA
;; yet. To get it configured and installed, use M-x clojure-install
;; from clojure-mode.

;; If you get an error about the wrong number of arguments getting
;; passed to report, you are probably using an older version of
;; Clojure contrib's test-is library. Either upgrade your test-is or
;; downgrade clojure-test-mode to version 1.0.

;;; Usage:

;; Once you have a SLIME 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.

;; You can jump between implementation and test files with C-c t if
;; your project is laid out in a way that clojure-test-mode
;; expects. Your project root should have a src/ directory containing
;; files that correspond to their namespace. It should also have a
;; test/ directory containing files that correspond to their
;; namespace, and the test namespaces should mirror the implementation
;; namespaces with the addition of "test" as the second-to-last
;; segment of the namespace.

;; So my.project.frob would be found in src/my/project/frob.clj and
;; its tests would be in test/my/project/test/frob.clj in the
;; my.project.test.frob namespace.

;;; History:

;; 1.0: 2009-03-12
;; * Initial Release

;; 1.1: 2009-04-28
;; * Fix to work with latest version of test-is. (circa Clojure 1.0)

;; 1.2: 2009-05-19
;; * Add clojure-test-jump-to-(test|implementation).

;;; TODO:

;; * Implement next-problem command
;; * Errors *loading* the tests are not reported
;; * Error messages need line number.
;; * Currently show-message needs point to be on the line with the
;; "is" invocation; this could be cleaned up.

;;; Code:

(require 'clojure-mode)
(require 'cl)
(require 'slime)
(require 'swank-clojure)

;; Faces

(defface clojure-test-failure-face
  '((((class color) (background light))
     :background "orange red") ;; TODO: Hard to read strings over this.
    (((class color) (background dark))
     :background "firebrick"))
  "Face for failures in Clojure tests."
  :group 'clojure-test-mode)

(defface clojure-test-error-face
  '((((class color) (background light))
     :background "orange1")
    (((class color) (background dark))
     :background "orange4"))
  "Face for errors in Clojure tests."
  :group 'clojure-test-mode)

;; Counts

(defvar clojure-test-count 0)
(defvar clojure-test-failure-count 0)
(defvar clojure-test-error-count 0)

;; Consts

(defconst clojure-test-ignore-results
  '(:end-test-ns :begin-test-var :end-test-var)
  "Results from test-is that we don't use")

;; Support Functions

(defun clojure-test-eval (string &optional handler)
  (slime-eval-async `(swank:eval-and-grab-output ,string)
                    (or handler #'identity)))

(defun clojure-test-load-reporting ()
  "Redefine the test-is report function to store results in metadata."
  (clojure-test-eval
   "(require 'clojure.contrib.test-is)
(ns clojure.contrib.test-is)
(defonce old-report report)
(defn report [event]
(if-let [current-test (last *testing-vars*)]
(alter-meta! current-test
assoc :status (conj (:status ^current-test)
[(:type event) (:message event)
(str (:expected event)) (str (:actual event))
((file-position 2) 1)])))
(old-report event))"))

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

(defun clojure-test-extract-results (results)
  (let ((result-vars (read (cadr results))))
    (setq the-result result-vars)
    ;; slime-eval-async hands us a cons with a useless car
    (mapcar #'clojure-test-extract-result result-vars)
    (message "Ran %s tests. %s failures, %s errors."
             clojure-test-count
             clojure-test-failure-count clojure-test-error-count)))

(defun clojure-test-extract-result (result)
  "Parse the result from a single test. May contain multiple is blocks."
  (dolist (is-result (rest result))
    (unless (member (aref is-result 0) clojure-test-ignore-results)
      (incf clojure-test-count)
      (destructuring-bind (event msg expected actual line) (coerce is-result 'list)
      (if (equal :fail event)
          (progn (incf clojure-test-failure-count)
                 (clojure-test-highlight-problem
                  line event (format "Expected %s, got %s" expected actual)))
        (when (equal :error event)
          (incf clojure-test-error-count)
          (clojure-test-highlight-problem line event actual)))))))

(defun clojure-test-highlight-problem (line event message)
  ;; (add-to-list 'the-results (list line event message))
  (save-excursion
    (goto-line line)
    (set-mark-command nil)
    (end-of-line)
    (let ((overlay (make-overlay (mark) (point))))
      (overlay-put overlay 'face (if (equal event :fail)
                                     'clojure-test-failure-face
                                   'clojure-test-error-face))
      (overlay-put overlay 'message message))))

(defun clojure-test-implementation-for (namespace)
  (let* ((segments (split-string namespace "\\."))
         (common-segments (butlast segments 2))
         (impl-segments (append common-segments (last segments))))
    (mapconcat 'identity impl-segments "/")))

(defun clojure-test-test-for (namespace)
  (let* ((segments (split-string namespace "\\."))
         (common-segments (butlast segments))
         (test-segments (append common-segments '("test")))
         (test-segments (append test-segments (last segments))))
    (mapconcat 'identity test-segments "/")))

;; Commands

(defun clojure-test-run-tests ()
  "Run all the tests in the current namespace."
  (interactive)
  (save-some-buffers nil (lambda () (equal major-mode 'clojure-mode)))
  (clojure-test-clear
   (lambda (&rest args)
     (clojure-test-eval (format "(load-file \"%s\")"
                                (buffer-file-name))
                        (lambda (&rest args)
                          (clojure-test-eval "(clojure.contrib.test-is/run-tests)"
                                             #'clojure-test-get-results))))))

(defun clojure-test-show-result ()
  "Show the result of the test under point."
  (interactive)
  (let ((overlay (find-if (lambda (o) (overlay-get o 'message))
                          (overlays-at (point)))))
    (if overlay
        (message (replace-regexp-in-string "%" "%%" (overlay-get overlay 'message))))))

(defun clojure-test-clear (&optional callback)
  "Remove overlays and clear stored results."
  (interactive)
  (remove-overlays)
  (setq clojure-test-count 0
        clojure-test-failure-count 0
        clojure-test-error-count 0)
  (clojure-test-eval
   "(doseq [t (vals (ns-interns *ns*))]
(alter-meta! t assoc :status [])
(alter-meta! t assoc :test nil))"
   callback))

(defun clojure-test-jump-to-implementation ()
  "Jump from test file to implementation."
  (interactive)
  (find-file (format "%s/src/%s.clj"
                     (locate-dominating-file buffer-file-name "src/")
                     (clojure-test-implementation-for (slime-current-package)))))

(defun clojure-test-jump-to-test ()
  "Jump from implementation file to test."
  (interactive)
  (find-file (format "%s/test/%s.clj"
                     (locate-dominating-file buffer-file-name "src/")
                     (clojure-test-test-for (slime-current-package)))))

(defvar clojure-test-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "C-c C-,") 'clojure-test-run-tests)
    (define-key map (kbd "C-c C-'") 'clojure-test-show-result)
    (define-key map (kbd "C-c '") 'clojure-test-show-result)
    (define-key map (kbd "C-c k") 'clojure-test-clear)
    (define-key map (kbd "C-c t") 'clojure-test-jump-to-implementation)
    map)
  "Keymap for Clojure test mode.")

(define-key clojure-mode-map (kbd "C-c t") 'clojure-test-jump-to-test)

;;;###autoload
(define-minor-mode clojure-test-mode
  "A minor mode for running Clojure tests."
  nil " Test" clojure-test-mode-map
  (if (slime-connected-p)
      (clojure-test-load-reporting)))

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

;;;###autoload
(defun clojure-test-maybe-enable ()
  "Enable clojure-test-mode if the current buffer contains Clojure tests."
  (save-excursion
    (goto-char (point-min))
    (if (or (search-forward "(deftest" nil t)
            (search-forward "(with-test" nil t))
        (clojure-test-mode t))))

;;;###autoload
(add-hook 'clojure-mode-hook 'clojure-test-maybe-enable)

(provide 'clojure-test-mode)
;;; clojure-test-mode.el ends here
Something went wrong with that request. Please try again.