aboutsummaryrefslogtreecommitdiffstats
path: root/lib/tools/emacs/erlang-eunit.el
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/tools/emacs/erlang-eunit.el
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/tools/emacs/erlang-eunit.el')
-rw-r--r--lib/tools/emacs/erlang-eunit.el254
1 files changed, 254 insertions, 0 deletions
diff --git a/lib/tools/emacs/erlang-eunit.el b/lib/tools/emacs/erlang-eunit.el
new file mode 100644
index 0000000000..05528aee6d
--- /dev/null
+++ b/lib/tools/emacs/erlang-eunit.el
@@ -0,0 +1,254 @@
+;;
+;; %CopyrightBegin%
+;;
+;; Copyright Ericsson AB 2009. All Rights Reserved.
+;;
+;; The contents of this file are subject to the Erlang Public License,
+;; Version 1.1, (the "License"); you may not use this file except in
+;; compliance with the License. You should have received a copy of the
+;; Erlang Public License along with this software. If not, it can be
+;; retrieved online at http://www.erlang.org/.
+;;
+;; Software distributed under the License is distributed on an "AS IS"
+;; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+;; the License for the specific language governing rights and limitations
+;; under the License.
+;;
+;; %CopyrightEnd%
+;;;
+;;; Purpose: Provide EUnit utilities.
+;;;
+;;; Author: Klas Johansson
+
+(defvar erlang-eunit-separate-src-and-test-directories t
+ "*Whether or not to keep source and EUnit test files in separate directories")
+
+;;;
+;;; Switch between src/EUnit test buffers
+;;;
+(defun erlang-eunit-toggle-src-and-test-file-other-window ()
+ "Switch to the src file if the EUnit test file is the current
+buffer and vice versa"
+ (interactive)
+ (if (erlang-eunit-test-file-p buffer-file-name)
+ (erlang-eunit-open-src-file-other-window buffer-file-name)
+ (erlang-eunit-open-test-file-other-window buffer-file-name)))
+
+;;;
+;;; Open the EUnit test file which corresponds to a src file
+;;;
+(defun erlang-eunit-open-test-file-other-window (src-file-path)
+ "Open the EUnit test file which corresponds to a src file"
+ (find-file-other-window (erlang-eunit-test-filename src-file-path)))
+
+
+;;;
+;;; Open the src file which corresponds to the an EUnit test file
+;;;
+(defun erlang-eunit-open-src-file-other-window (test-file-path)
+ "Open the src file which corresponds to the an EUnit test file"
+ (find-file-other-window (erlang-eunit-src-filename test-file-path)))
+
+;;; Return the name and path of the EUnit test file
+;;, (input may be either the source filename itself or the EUnit test filename)
+(defun erlang-eunit-test-filename (file-path)
+ (erlang-eunit-rewrite-filename file-path "test" "_tests"))
+
+;;; Return the name and path of the source file
+;;, (input may be either the source filename itself or the EUnit test filename)
+(defun erlang-eunit-src-filename (file-path)
+ (erlang-eunit-rewrite-filename file-path "src" ""))
+
+;;; Rewrite a filename from the src or test filename to the other
+(defun erlang-eunit-rewrite-filename (orig-file-path dest-dirname dest-suffix)
+ (let* ((root-dir-name (erlang-eunit-file-root-dir-name orig-file-path))
+ (src-module-name (erlang-eunit-source-module-name orig-file-path))
+ (dest-base-name (concat src-module-name dest-suffix ".erl"))
+ (dest-dir-name-1 (file-name-directory orig-file-path))
+ (dest-dir-name-2 (filename-join root-dir-name dest-dirname))
+ (dest-file-name-1 (filename-join dest-dir-name-1 dest-base-name))
+ (dest-file-name-2 (filename-join dest-dir-name-2 dest-base-name)))
+ ;; This function tries to be a bit intelligent:
+ ;; * if there already is a test (or source) file in the same
+ ;; directory as a source (or test) file, it'll be picked
+ ;; * if there already is a test (or source) file in a separate
+ ;; test (or src) directory, it'll be picked
+ ;; * otherwise it'll resort to whatever alternative (same or
+ ;; separate directories) that the user has chosen
+ (cond ((file-readable-p dest-file-name-1)
+ dest-file-name-1)
+ ((file-readable-p dest-file-name-2)
+ dest-file-name-2)
+ (erlang-eunit-separate-src-and-test-directories
+ dest-file-name-2)
+ (t
+ dest-file-name-1))))
+
+;;; Checks whether a file is a EUnit test file or not
+(defun erlang-eunit-test-file-p (file-path)
+ (erlang-eunit-string-match-p "^\\(.+\\)_tests.erl$" file-path))
+
+;;; Return the module name of the source file
+;;; /tmp/foo/src/x.erl --> x
+;;; /tmp/foo/test/x_tests.erl --> x
+(defun erlang-eunit-source-module-name (file-path)
+ (interactive)
+ (let* ((file-name (file-name-nondirectory file-path))
+ (base-name (file-name-sans-extension file-name)))
+ (if (string-match "^\\(.+\\)_tests$" base-name)
+ (substring base-name (match-beginning 1) (match-end 1))
+ base-name)))
+
+;;; Return the directory name which is common to both src and test
+;;; /tmp/foo/src/x.erl --> /tmp/foo
+;;; /tmp/foo/test/x_tests.erl --> /tmp/foo
+(defun erlang-eunit-file-root-dir-name (file-path)
+ (erlang-eunit-dir-parent-dirname (file-name-directory file-path)))
+
+;;; Return the parent directory name of a directory
+;;; /tmp/foo/ --> /tmp
+;;; /tmp/foo --> /tmp
+(defun erlang-eunit-dir-parent-dirname (dir-name)
+ (file-name-directory (directory-file-name dir-name)))
+
+;;; Older emacsen don't have string-match-p.
+(defun erlang-eunit-string-match-p (regexp string &optional start)
+ (if (fboundp 'string-match-p) ;; appeared in emacs 23
+ (string-match-p regexp string start)
+ (save-match-data ;; fallback for earlier versions of emacs
+ (string-match regexp string start))))
+
+;;; Join filenames
+(defun filename-join (dir file)
+ (if (or (= (elt file 0) ?/)
+ (= (car (last (append dir nil))) ?/))
+ (concat dir file)
+ (concat dir "/" file)))
+
+;;; Run EUnit tests for the current module
+(defun erlang-eunit-run-tests ()
+ "Run the EUnit test suite for the current module.
+
+With prefix arg, runs tests with the verbose flag set."
+ (interactive)
+ (let* ((module-name (erlang-add-quotes-if-needed
+ (erlang-eunit-source-module-name buffer-file-name)))
+ (opts (if current-prefix-arg ", [verbose]" ""))
+ (command (format "eunit:test(%s%s)." module-name opts)))
+ (erlang-eunit-inferior-erlang-send-command command)))
+
+;;; Compile source and EUnit test file and finally run EUnit tests for
+;;; the current module
+(defun erlang-eunit-compile-and-run-tests ()
+ "Compile the source and test files and run the EUnit test suite.
+
+With prefix arg, compiles for debug and runs tests with the verbose flag set."
+ (interactive)
+ (let ((src-filename (erlang-eunit-src-filename buffer-file-name))
+ (test-filename (erlang-eunit-test-filename buffer-file-name)))
+
+ ;; The purpose of out-maneuvering `save-some-buffers', as is done
+ ;; below, is to ask the question about saving buffers only once,
+ ;; instead of possibly several: one for each file to compile,
+ ;; for instance for both x.erl and x_tests.erl.
+ (save-some-buffers)
+ (flet ((save-some-buffers (&optional any) nil))
+
+ ;; Compilation of the source file is mandatory (the file must
+ ;; exist, otherwise the procedure is aborted). Compilation of the
+ ;; test file on the other hand, is optional, since eunit tests may
+ ;; be placed in the source file instead. Any compilation error
+ ;; will prevent the subsequent steps to be run (hence the `and')
+ (and (erlang-eunit-compile-file src-filename)
+ (if (file-readable-p test-filename)
+ (erlang-eunit-compile-file test-filename)
+ t)
+ (erlang-eunit-run-tests)))))
+
+(defun erlang-eunit-compile-file (file-path)
+ (if (file-readable-p file-path)
+ (save-excursion
+ (set-buffer (find-file-noselect file-path))
+ (erlang-compile)
+ (erlang-eunit-last-compilation-successful-p))
+ (let ((msg (format "Could not read %s" file-path)))
+ (erlang-eunit-inferior-erlang-send-command
+ (format "%% WARNING: %s" msg))
+ (error msg))))
+
+(defun erlang-eunit-last-compilation-successful-p ()
+ (save-excursion
+ (set-buffer inferior-erlang-buffer)
+ (goto-char compilation-parsing-end)
+ (erlang-eunit-all-list-elems-fulfill-p
+ (lambda (re) (let ((continue t)
+ (result t))
+ (while continue ; ignore warnings, stop at errors
+ (if (re-search-forward re (point-max) t)
+ (if (erlang-eunit-is-compilation-warning)
+ t
+ (setq result nil)
+ (setq continue nil))
+ (setq result t)
+ (setq continue nil)))
+ result))
+ (mapcar (lambda (e) (car e)) erlang-error-regexp-alist))))
+
+(defun erlang-eunit-is-compilation-warning ()
+ (erlang-eunit-string-match-p
+ "[0-9]+: Warning:"
+ (buffer-substring (line-beginning-position) (line-end-position))))
+
+(defun erlang-eunit-all-list-elems-fulfill-p (pred list)
+ (let ((matches-p t))
+ (while (and list matches-p)
+ (if (not (funcall pred (car list)))
+ (setq matches-p nil))
+ (setq list (cdr list)))
+ matches-p))
+
+;;; Evaluate a command in an erlang buffer
+(defun erlang-eunit-inferior-erlang-send-command (command)
+ "Evaluate a command in an erlang buffer."
+ (interactive "P")
+ (inferior-erlang-prepare-for-input)
+ (inferior-erlang-send-command command)
+ (sit-for 0) ;; redisplay
+ (inferior-erlang-wait-prompt))
+
+
+;;;====================================================================
+;;; Key bindings
+;;;====================================================================
+
+(defvar erlang-eunit-toggle-src-and-test-file-other-window-key "\C-c\C-et"
+ "*Key to which the `erlang-eunit-toggle-src-and-test-file-other-window'
+function will be bound.")
+(defvar erlang-eunit-compile-and-run-tests-key "\C-c\C-ek"
+ "*Key to which the `erlang-eunit-compile-and-run-tests'
+function will be bound.")
+
+(defun erlang-eunit-add-key-bindings ()
+ (erlang-eunit-ensure-keymap-for-key
+ erlang-eunit-toggle-src-and-test-file-other-window-key)
+ (local-set-key erlang-eunit-toggle-src-and-test-file-other-window-key
+ 'erlang-eunit-toggle-src-and-test-file-other-window)
+ (erlang-eunit-ensure-keymap-for-key
+ erlang-eunit-compile-and-run-tests-key)
+ (local-set-key erlang-eunit-compile-and-run-tests-key
+ 'erlang-eunit-compile-and-run-tests))
+
+(defun erlang-eunit-ensure-keymap-for-key (key-seq)
+ (let ((prefix-keys (butlast (append key-seq nil)))
+ (prefix-seq ""))
+ (while prefix-keys
+ (setq prefix-seq (concat prefix-seq (make-string 1 (car prefix-keys))))
+ (setq prefix-keys (cdr prefix-keys))
+ (if (not (keymapp (lookup-key (current-local-map) prefix-seq)))
+ (local-set-key prefix-seq (make-sparse-keymap))))))
+
+(add-hook 'erlang-mode-hook 'erlang-eunit-add-key-bindings)
+
+
+(provide 'erlang-eunit)
+;; erlang-eunit ends here