org-test.el 10 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323
  1. ;;;; org-test.el --- Tests for Org-mode
  2. ;; Copyright (c) 2010 Sebastian Rose, Eric Schulte
  3. ;; Authors:
  4. ;; Sebastian Rose, Hannover, Germany, sebastian_rose gmx de
  5. ;; Eric Schulte, Santa Fe, New Mexico, USA, schulte.eric gmail com
  6. ;; David Maus, Brunswick, Germany, dmaus ictsoc de
  7. ;; Released under the GNU General Public License version 3
  8. ;; see: http://www.gnu.org/licenses/gpl-3.0.html
  9. ;; Definition of `special-mode' copied from Emacs23's simple.el to be
  10. ;; provide a testing environment for Emacs22.
  11. ;;;; Comments:
  12. ;; Interactive testing for Org mode.
  13. ;; The heart of all this is the commands `org-test-current-defun'. If
  14. ;; called while in a `defun' all ert tests with names matching the
  15. ;; name of the function are run.
  16. ;;; Test Development
  17. ;; For test development purposes a number of navigation and test
  18. ;; function construction routines are available as a git submodule
  19. ;; (jump.el)
  20. ;; Install with...
  21. ;; $ git submodule init
  22. ;; $ git submodule update
  23. ;;;; Code:
  24. (let* ((org-test-dir (expand-file-name
  25. (file-name-directory
  26. (or load-file-name buffer-file-name))))
  27. (org-lisp-dir (expand-file-name
  28. (concat org-test-dir "../lisp"))))
  29. (unless (featurep 'org)
  30. (setq load-path (cons org-lisp-dir load-path))
  31. (require 'org)
  32. (org-babel-do-load-languages
  33. 'org-babel-load-languages '((sh . t))))
  34. (let* ((load-path (cons
  35. org-test-dir
  36. (cons
  37. (expand-file-name "jump" org-test-dir)
  38. load-path))))
  39. (require 'cl)
  40. (when (= emacs-major-version 22)
  41. (defvar special-mode-map
  42. (let ((map (make-sparse-keymap)))
  43. (suppress-keymap map)
  44. (define-key map "q" 'quit-window)
  45. (define-key map " " 'scroll-up)
  46. (define-key map "\C-?" 'scroll-down)
  47. (define-key map "?" 'describe-mode)
  48. (define-key map "h" 'describe-mode)
  49. (define-key map ">" 'end-of-buffer)
  50. (define-key map "<" 'beginning-of-buffer)
  51. (define-key map "g" 'revert-buffer)
  52. (define-key map "z" 'kill-this-buffer)
  53. map))
  54. (put 'special-mode 'mode-class 'special)
  55. (define-derived-mode special-mode nil "Special"
  56. "Parent major mode from which special major modes should inherit."
  57. (setq buffer-read-only t)))
  58. (require 'ert)
  59. (require 'ert-x)
  60. (when (file-exists-p
  61. (expand-file-name "jump/jump.el" org-test-dir))
  62. (require 'jump)
  63. (require 'which-func))))
  64. (defconst org-test-default-test-file-name "tests.el"
  65. "For each defun a separate file with tests may be defined.
  66. tests.el is the fallback or default if you like.")
  67. (defconst org-test-default-directory-name "testing"
  68. "Basename or the directory where the tests live.
  69. org-test searches this directory up the directory tree.")
  70. (defconst org-test-dir
  71. (expand-file-name (file-name-directory (or load-file-name buffer-file-name))))
  72. (defconst org-base-dir
  73. (expand-file-name ".." org-test-dir))
  74. (defconst org-test-example-dir
  75. (expand-file-name "examples" org-test-dir))
  76. (defconst org-test-file
  77. (expand-file-name "normal.org" org-test-example-dir))
  78. (defconst org-test-no-heading-file
  79. (expand-file-name "no-heading.org" org-test-example-dir))
  80. (defconst org-test-link-in-heading-file
  81. (expand-file-name "link-in-heading.org" org-test-dir))
  82. ;;; Functions for writing tests
  83. (defun org-test-for-executable (exe)
  84. "Throw an error if EXE is not available.
  85. This can be used at the top of code-block-language specific test
  86. files to avoid loading the file on systems without the
  87. executable."
  88. (unless (reduce
  89. (lambda (acc dir)
  90. (or acc (file-exists-p (expand-file-name exe dir))))
  91. exec-path :initial-value nil)
  92. (throw 'missing-test-dependency exe)))
  93. (defun org-test-buffer (&optional file)
  94. "TODO: Setup and return a buffer to work with.
  95. If file is non-nil insert it's contents in there.")
  96. (defun org-test-compare-with-file (&optional file)
  97. "TODO: Compare the contents of the test buffer with FILE.
  98. If file is not given, search for a file named after the test
  99. currently executed.")
  100. (defmacro org-test-at-id (id &rest body)
  101. "Run body after placing the point in the headline identified by ID."
  102. (declare (indent 1))
  103. `(let* ((id-location (org-id-find ,id))
  104. (id-file (car id-location))
  105. (visited-p (get-file-buffer id-file))
  106. to-be-removed)
  107. (save-window-excursion
  108. (save-match-data
  109. (org-id-goto ,id)
  110. (setq to-be-removed (current-buffer))
  111. (condition-case nil
  112. (progn
  113. (org-show-subtree)
  114. (org-show-block-all))
  115. (error nil))
  116. (save-restriction ,@body)))
  117. (unless visited-p
  118. (kill-buffer to-be-removed))))
  119. (defmacro org-test-in-example-file (file &rest body)
  120. "Execute body in the Org-mode example file."
  121. (declare (indent 1))
  122. `(let* ((my-file (or ,file org-test-file))
  123. (visited-p (get-file-buffer my-file))
  124. to-be-removed)
  125. (save-window-excursion
  126. (save-match-data
  127. (find-file my-file)
  128. (unless (eq major-mode 'org-mode)
  129. (org-mode))
  130. (setq to-be-removed (current-buffer))
  131. (goto-char (point-min))
  132. (condition-case nil
  133. (progn
  134. (outline-next-visible-heading 1)
  135. (org-show-subtree)
  136. (org-show-block-all))
  137. (error nil))
  138. (save-restriction ,@body)))
  139. (unless visited-p
  140. (kill-buffer to-be-removed))))
  141. (defmacro org-test-at-marker (file marker &rest body)
  142. "Run body after placing the point at MARKER in FILE.
  143. Note the uuidgen command-line command can be useful for
  144. generating unique markers for insertion as anchors into org
  145. files."
  146. (declare (indent 2))
  147. `(org-test-in-example-file ,file
  148. (goto-char (point-min))
  149. (re-search-forward (regexp-quote ,marker))
  150. ,@body))
  151. (defmacro org-test-with-temp-text (text &rest body)
  152. "Run body in a temporary buffer with Org-mode as the active
  153. mode holding TEXT. If the string \"<point>\" appears in TEXT
  154. then remove it and place the point there before running BODY,
  155. otherwise place the point at the beginning of the inserted text."
  156. (declare (indent 1))
  157. (let ((inside-text (if (stringp text) text (eval text))))
  158. `(with-temp-buffer
  159. (org-mode)
  160. ,(let ((point (string-match (regexp-quote "<point>") inside-text)))
  161. (if point
  162. `(progn (insert `(replace-match "" nil nil inside-text))
  163. (goto-char ,(match-beginning 0)))
  164. `(progn (insert ,inside-text)
  165. (goto-char (point-min)))))
  166. ,@body)))
  167. ;;; Navigation Functions
  168. (when (featurep 'jump)
  169. (defjump org-test-jump
  170. (("lisp/\\1.el" . "testing/lisp/test-\\1.el")
  171. ("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el")
  172. ("contrib/lisp/\\1.el" . "testing/contrib/lisp/test-\\1.el")
  173. ("contrib/lisp/\\1.el" . "testing/contrib/lisp/\\1.el/test.*.el")
  174. ("testing/lisp/test-\\1.el" . "lisp/\\1.el")
  175. ("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el")
  176. ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el")
  177. ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el/test.*.el"))
  178. (concat org-base-dir "/")
  179. "Jump between org-mode files and their tests."
  180. (lambda (path)
  181. (let* ((full-path (expand-file-name path org-base-dir))
  182. (file-name (file-name-nondirectory path))
  183. (name (file-name-sans-extension file-name)))
  184. (find-file full-path)
  185. (insert
  186. ";;; " file-name "\n\n"
  187. ";; Copyright (c) " (nth 5 (decode-time (current-time)))
  188. " " user-full-name "\n"
  189. ";; Authors: " user-full-name "\n\n"
  190. ";; Released under the GNU General Public License version 3\n"
  191. ";; see: http://www.gnu.org/licenses/gpl-3.0.html\n\n"
  192. ";;;; Comments:\n\n"
  193. ";; Template test file for Org-mode tests\n\n"
  194. " \n"
  195. ";;; Code:\n"
  196. "(let ((load-path (cons (expand-file-name\n"
  197. " \"..\" (file-name-directory\n"
  198. " (or load-file-name buffer-file-name)))\n"
  199. " load-path)))\n"
  200. " (require 'org-test)\n"
  201. " (require 'org-test-ob-consts))\n\n"
  202. " \n"
  203. ";;; Tests\n"
  204. "(ert-deftest " name "/example-test ()\n"
  205. " \"Just an example to get you started.\"\n"
  206. " (should t)\n"
  207. " (should-not nil)\n"
  208. " (should-error (error \"errr...\")))\n\n\n"
  209. "(provide '" name ")\n\n"
  210. ";;; " file-name " ends here\n") full-path))
  211. (lambda () ((lambda (res) (if (listp res) (car res) res)) (which-function)))))
  212. (define-key emacs-lisp-mode-map "\M-\C-j" 'org-test-jump)
  213. ;;; Miscellaneous helper functions
  214. (defun org-test-strip-text-props (s)
  215. "Return S without any text properties."
  216. (let ((noprop (copy-sequence s)))
  217. (set-text-properties 0 (length noprop) nil noprop)
  218. noprop))
  219. (defun org-test-string-exact-match (regex string &optional start)
  220. "case sensative string-match"
  221. (let ((case-fold-search nil)
  222. (case-replace nil))
  223. (if(and (equal regex "")
  224. (not(equal string "")))
  225. nil
  226. (if (equal 0 (string-match regex string start))
  227. t
  228. nil))))
  229. ;;; Load and Run tests
  230. (defun org-test-load ()
  231. "Load up the org-mode test suite."
  232. (interactive)
  233. (flet ((rld (base)
  234. ;; Recursively load all files, if files throw errors
  235. ;; then silently ignore the error and continue to the
  236. ;; next file. This allows files to error out if
  237. ;; required executables aren't available.
  238. (mapc
  239. (lambda (path)
  240. (if (file-directory-p path)
  241. (rld path)
  242. (catch 'missing-test-dependency
  243. (load-file path))))
  244. (directory-files base 'full
  245. "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el$"))))
  246. (rld (expand-file-name "lisp" org-test-dir))
  247. (rld (expand-file-name "lisp" (expand-file-name "contrib" org-test-dir)))))
  248. (defun org-test-current-defun ()
  249. "Test the current function."
  250. (interactive)
  251. (ert (which-function)))
  252. (defun org-test-current-file ()
  253. "Run all tests for current file."
  254. (interactive)
  255. (ert (concat "test-"
  256. (file-name-sans-extension
  257. (file-name-nondirectory (buffer-file-name)))
  258. "/")))
  259. (defun org-test-touch-all-examples ()
  260. (dolist (file (directory-files
  261. org-test-example-dir 'full
  262. "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$"))
  263. (find-file file)))
  264. (defun org-test-run-batch-tests ()
  265. "Run all defined tests matching \"\\(org\\|ob\\)\".
  266. Load all test files first."
  267. (interactive)
  268. (org-test-touch-all-examples)
  269. (org-test-load)
  270. (ert-run-tests-batch-and-exit "\\(org\\|ob\\)"))
  271. (defun org-test-run-all-tests ()
  272. "Run all defined tests matching \"\\(org\\|ob\\)\".
  273. Load all test files first."
  274. (interactive)
  275. (org-test-touch-all-examples)
  276. (org-test-load)
  277. (ert "\\(org\\|ob\\)"))
  278. (provide 'org-test)
  279. ;;; org-test.el ends here