org-mode/testing/org-test.el

186 lines
5.7 KiB
EmacsLisp
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;;; org-test.el --- Tests for Org-mode
;; Copyright (c) 2010 Sebastian Rose, Eric Schulte
;; Authors:
;; Sebastian Rose, Hannover, Germany, sebastian_rose gmx de
;; Eric Schulte, Santa Fe, New Mexico, USA, schulte.eric gmail com
;; Released under the GNU General Public License version 3
;; see: http://www.gnu.org/licenses/gpl-3.0.html
;;;; Comments:
;; Interactive testing for Org mode.
;; The heart of all this is the commands `org-test-current-defun'. If
;; called while in a `defun' all ert tests with names matching the
;; name of the function are run.
;;; Prerequisites:
;; ERT and jump.el are both included as git submodules, install with
;; $ git submodule init
;; $ git submodule update
;;;; Code:
(let* ((org-test-dir (expand-file-name
(file-name-directory
(or load-file-name buffer-file-name))))
(load-path (cons
(expand-file-name "ert" org-test-dir)
(cons
(expand-file-name "jump" org-test-dir)
load-path))))
(require 'ert-batch)
(require 'ert)
(require 'ert-exp)
(require 'ert-exp-t)
(require 'ert-run)
(require 'ert-ui)
(require 'jump)
(require 'which-func)
(require 'org))
(defconst org-test-default-test-file-name "tests.el"
"For each defun a separate file with tests may be defined.
tests.el is the fallback or default if you like.")
(defconst org-test-default-directory-name "testing"
"Basename or the directory where the tests live.
org-test searches this directory up the directory tree.")
(defconst org-test-dir
(expand-file-name (file-name-directory (or load-file-name buffer-file-name))))
(defconst org-base-dir
(expand-file-name ".." org-test-dir))
(defconst org-test-example-dir
(expand-file-name "examples" org-test-dir))
(defconst org-test-file
(expand-file-name "normal.org" org-test-example-dir))
(defconst org-test-no-heading-file
(expand-file-name "no-heading.org" org-test-example-dir))
(defconst org-test-link-in-heading-file
(expand-file-name "link-in-heading.org" org-test-dir))
;;; Functions for writing tests
(defun org-test-buffer (&optional file)
"TODO: Setup and return a buffer to work with.
If file is non-nil insert it's contents in there.")
(defun org-test-compare-with-file (&optional file)
"TODO: Compare the contents of the test buffer with FILE.
If file is not given, search for a file named after the test
currently executed.")
(defmacro org-test-in-example-file (file &rest body)
"Execute body in the Org-mode example file."
(declare (indent 1))
`(let* ((my-file (or ,file org-test-file))
(visited-p (get-file-buffer my-file))
to-be-removed)
(save-window-excursion
(save-match-data
(find-file my-file)
(setq to-be-removed (current-buffer))
(goto-char (point-min))
(condition-case nil
(progn
(outline-next-visible-heading 1)
(org-show-subtree)
(org-show-block-all))
(error nil))
,@body))
(unless visited-p
(kill-buffer to-be-removed))))
(defmacro org-test-at-marker (file marker &rest body)
"Run body after placing the point at MARKER in FILE.
Note the uuidgen command-line command can be useful for
generating unique markers for insertion as anchors into org
files."
(declare (indent 2))
`(org-test-in-example-file ,file
(goto-char (point-min))
(re-search-forward (regexp-quote ,marker))
,@body))
;;; Navigation Functions
(defjump 'org-test-jump
'(("lisp/\\1.el" . "testing/lisp/test-\\1.el")
("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el")
("contrib/lisp/\\1.el" . "testing/contrib/lisp/test-\\1.el")
("contrib/lisp/\\1.el" . "testing/contrib/lisp/\\1.el/test.*.el")
("testing/lisp/test-\\1.el" . "lisp/\\1.el")
("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el")
("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el")
("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el/test.*.el"))
(concat org-base-dir "/")
"Jump between org-mode files and their tests."
(lambda (path)
(let* ((full-path (expand-file-name path org-base-dir))
(file-name (file-name-nondirectory path))
(name (file-name-sans-extension file-name)))
(find-file full-path)
(insert
";;; " file-name "\n\n"
";; Copyright (c) 2010 " user-full-name "\n"
";; Authors: " user-full-name "\n\n"
";; Released under the GNU General Public License version 3\n"
";; see: http://www.gnu.org/licenses/gpl-3.0.html\n\n"
";;;; Comments:\n\n"
";; Template test file for Org-mode tests\n\n"
" \n"
";;; Code:\n"
"(require 'org-test)\n\n"
" \n"
";;; Tests\n"
"(ert-deftest " name "/example-test ()\n"
" \"Just an example to get you started.\"\n"
" (should t)\n"
" (should-not nil)\n"
" (should-error (error \"errr...\")))\n\n\n"
"(provide '" name ")\n\n"
";;; " file-name " ends here\n") full-path))
(lambda () ((lambda (res) (if (listp res) (car res) res)) (which-function))))
(define-key emacs-lisp-mode-map "\M-\C-j" 'org-test-jump)
;;; Load and Run tests
(defun org-test-load ()
"Load up the org-mode test suite."
(interactive)
(flet ((rload (base)
(mapc
(lambda (path)
(if (file-directory-p path) (rload path) (load-file path)))
(directory-files base 'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el"))))
(rload (expand-file-name "lisp" org-test-dir))
(rload (expand-file-name "lisp"
(expand-file-name "contrib" org-test-dir)))))
(defun org-test-current-defun ()
"Test the current function."
(interactive)
(ert (car (which-function))))
(defun org-test-run-all-tests ()
"Run all defined tests matching \"^org\".
Load all test files first."
(interactive)
(org-test-load)
(ert "org"))
(provide 'org-test)
;;; org-test.el ends here