org-test.el 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380
  1. ;;;; org-test.el --- Tests for Org-mode
  2. ;; Copyright (c) 2010-2012 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. (require 'org-id)
  33. (org-babel-do-load-languages
  34. 'org-babel-load-languages '((sh . t) (org . t))))
  35. (let* ((load-path (cons
  36. org-test-dir
  37. (cons
  38. (expand-file-name "jump" org-test-dir)
  39. load-path))))
  40. (require 'cl)
  41. (when (= emacs-major-version 22)
  42. (defvar special-mode-map
  43. (let ((map (make-sparse-keymap)))
  44. (suppress-keymap map)
  45. (define-key map "q" 'quit-window)
  46. (define-key map " " 'scroll-up)
  47. (define-key map "\C-?" 'scroll-down)
  48. (define-key map "?" 'describe-mode)
  49. (define-key map "h" 'describe-mode)
  50. (define-key map ">" 'end-of-buffer)
  51. (define-key map "<" 'beginning-of-buffer)
  52. (define-key map "g" 'revert-buffer)
  53. (define-key map "z" 'kill-this-buffer)
  54. map))
  55. (put 'special-mode 'mode-class 'special)
  56. (define-derived-mode special-mode nil "Special"
  57. "Parent major mode from which special major modes should inherit."
  58. (setq buffer-read-only t)))
  59. (require 'ert)
  60. (require 'ert-x)
  61. (when (file-exists-p
  62. (expand-file-name "jump/jump.el" org-test-dir))
  63. (require 'jump)
  64. (require 'which-func))))
  65. (defconst org-test-default-test-file-name "tests.el"
  66. "For each defun a separate file with tests may be defined.
  67. tests.el is the fallback or default if you like.")
  68. (defconst org-test-default-directory-name "testing"
  69. "Basename or the directory where the tests live.
  70. org-test searches this directory up the directory tree.")
  71. (defconst org-test-dir
  72. (expand-file-name (file-name-directory (or load-file-name buffer-file-name))))
  73. (defconst org-base-dir
  74. (expand-file-name ".." org-test-dir))
  75. (defconst org-test-example-dir
  76. (expand-file-name "examples" org-test-dir))
  77. (defconst org-test-file
  78. (expand-file-name "normal.org" org-test-example-dir))
  79. (defconst org-test-no-heading-file
  80. (expand-file-name "no-heading.org" org-test-example-dir))
  81. (defconst org-test-link-in-heading-file
  82. (expand-file-name "link-in-heading.org" org-test-dir))
  83. ;;; Functions for writing tests
  84. (put 'missing-test-dependency
  85. 'error-conditions
  86. '(error missing-test-dependency))
  87. (defun org-test-for-executable (exe)
  88. "Throw an error if EXE is not available.
  89. This can be used at the top of code-block-language specific test
  90. files to avoid loading the file on systems without the
  91. executable."
  92. (unless (reduce
  93. (lambda (acc dir)
  94. (or acc (file-exists-p (expand-file-name exe dir))))
  95. exec-path :initial-value nil)
  96. (signal 'missing-test-dependency (list exe))))
  97. (defun org-test-buffer (&optional file)
  98. "TODO: Setup and return a buffer to work with.
  99. If file is non-nil insert it's contents in there.")
  100. (defun org-test-compare-with-file (&optional file)
  101. "TODO: Compare the contents of the test buffer with FILE.
  102. If file is not given, search for a file named after the test
  103. currently executed.")
  104. (defmacro org-test-at-id (id &rest body)
  105. "Run body after placing the point in the headline identified by ID."
  106. (declare (indent 1))
  107. `(let* ((id-location (org-id-find ,id))
  108. (id-file (car id-location))
  109. (visited-p (get-file-buffer id-file))
  110. to-be-removed)
  111. (save-window-excursion
  112. (save-match-data
  113. (org-id-goto ,id)
  114. (setq to-be-removed (current-buffer))
  115. (condition-case nil
  116. (progn
  117. (org-show-subtree)
  118. (org-show-block-all))
  119. (error nil))
  120. (save-restriction ,@body)))
  121. (unless visited-p
  122. (kill-buffer to-be-removed))))
  123. (def-edebug-spec org-test-at-id (form body))
  124. (defmacro org-test-in-example-file (file &rest body)
  125. "Execute body in the Org-mode example file."
  126. (declare (indent 1))
  127. `(let* ((my-file (or ,file org-test-file))
  128. (visited-p (get-file-buffer my-file))
  129. to-be-removed)
  130. (save-window-excursion
  131. (save-match-data
  132. (find-file my-file)
  133. (unless (eq major-mode 'org-mode)
  134. (org-mode))
  135. (setq to-be-removed (current-buffer))
  136. (goto-char (point-min))
  137. (condition-case nil
  138. (progn
  139. (outline-next-visible-heading 1)
  140. (org-show-subtree)
  141. (org-show-block-all))
  142. (error nil))
  143. (save-restriction ,@body)))
  144. (unless visited-p
  145. (kill-buffer to-be-removed))))
  146. (def-edebug-spec org-test-in-example-file (form body))
  147. (defmacro org-test-at-marker (file marker &rest body)
  148. "Run body after placing the point at MARKER in FILE.
  149. Note the uuidgen command-line command can be useful for
  150. generating unique markers for insertion as anchors into org
  151. files."
  152. (declare (indent 2))
  153. `(org-test-in-example-file ,file
  154. (goto-char (point-min))
  155. (re-search-forward (regexp-quote ,marker))
  156. ,@body))
  157. (def-edebug-spec org-test-at-marker (form form body))
  158. (defmacro org-test-with-temp-text (text &rest body)
  159. "Run body in a temporary buffer with Org-mode as the active
  160. mode holding TEXT. If the string \"<point>\" appears in TEXT
  161. then remove it and place the point there before running BODY,
  162. otherwise place the point at the beginning of the inserted text."
  163. (declare (indent 1))
  164. (let ((inside-text (if (stringp text) text (eval text))))
  165. `(with-temp-buffer
  166. (org-mode)
  167. ,(let ((point (string-match (regexp-quote "<point>") inside-text)))
  168. (if point
  169. `(progn (insert `(replace-match "" nil nil inside-text))
  170. (goto-char ,(match-beginning 0)))
  171. `(progn (insert ,inside-text)
  172. (goto-char (point-min)))))
  173. (prog1 ,@body (kill-buffer)))))
  174. (def-edebug-spec org-test-with-temp-text (form body))
  175. (defmacro org-test-with-temp-text-in-file (text &rest body)
  176. "Run body in a temporary file buffer with Org-mode as the active mode."
  177. (declare (indent 1))
  178. (let ((file (make-temp-file "org-test"))
  179. (inside-text (if (stringp text) text (eval text)))
  180. (results (gensym)))
  181. `(let ((kill-buffer-query-functions nil) ,results)
  182. (with-temp-file ,file (insert ,inside-text))
  183. (find-file ,file)
  184. (org-mode)
  185. (setq ,results ,@body)
  186. (save-buffer) (kill-buffer (current-buffer))
  187. (delete-file ,file)
  188. ,results)))
  189. (def-edebug-spec org-test-with-temp-text-in-file (form body))
  190. ;;; Navigation Functions
  191. (when (featurep 'jump)
  192. (defjump org-test-jump
  193. (("lisp/\\1.el" . "testing/lisp/test-\\1.el")
  194. ("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el")
  195. ("contrib/lisp/\\1.el" . "testing/contrib/lisp/test-\\1.el")
  196. ("contrib/lisp/\\1.el" . "testing/contrib/lisp/\\1.el/test.*.el")
  197. ("testing/lisp/test-\\1.el" . "lisp/\\1.el")
  198. ("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el")
  199. ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el")
  200. ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el/test.*.el"))
  201. (concat org-base-dir "/")
  202. "Jump between org-mode files and their tests."
  203. (lambda (path)
  204. (let* ((full-path (expand-file-name path org-base-dir))
  205. (file-name (file-name-nondirectory path))
  206. (name (file-name-sans-extension file-name)))
  207. (find-file full-path)
  208. (insert
  209. ";;; " file-name "\n\n"
  210. ";; Copyright (c) " (nth 5 (decode-time (current-time)))
  211. " " user-full-name "\n"
  212. ";; Authors: " user-full-name "\n\n"
  213. ";; Released under the GNU General Public License version 3\n"
  214. ";; see: http://www.gnu.org/licenses/gpl-3.0.html\n\n"
  215. ";;;; Comments:\n\n"
  216. ";; Template test file for Org-mode tests\n\n"
  217. " \n"
  218. ";;; Code:\n"
  219. "(let ((load-path (cons (expand-file-name\n"
  220. " \"..\" (file-name-directory\n"
  221. " (or load-file-name buffer-file-name)))\n"
  222. " load-path)))\n"
  223. " (require 'org-test)\n"
  224. " (require 'org-test-ob-consts))\n\n"
  225. " \n"
  226. ";;; Tests\n"
  227. "(ert-deftest " name "/example-test ()\n"
  228. " \"Just an example to get you started.\"\n"
  229. " (should t)\n"
  230. " (should-not nil)\n"
  231. " (should-error (error \"errr...\")))\n\n\n"
  232. "(provide '" name ")\n\n"
  233. ";;; " file-name " ends here\n") full-path))
  234. (lambda () ((lambda (res) (if (listp res) (car res) res)) (which-function)))))
  235. (define-key emacs-lisp-mode-map "\M-\C-j" 'org-test-jump)
  236. ;;; Miscellaneous helper functions
  237. (defun org-test-strip-text-props (s)
  238. "Return S without any text properties."
  239. (let ((noprop (copy-sequence s)))
  240. (set-text-properties 0 (length noprop) nil noprop)
  241. noprop))
  242. (defun org-test-string-exact-match (regex string &optional start)
  243. "case sensative string-match"
  244. (let ((case-fold-search nil)
  245. (case-replace nil))
  246. (if(and (equal regex "")
  247. (not(equal string "")))
  248. nil
  249. (if (equal 0 (string-match regex string start))
  250. t
  251. nil))))
  252. ;;; Load and Run tests
  253. (defun org-test-load ()
  254. "Load up the org-mode test suite."
  255. (interactive)
  256. (flet ((rld (base)
  257. ;; Recursively load all files, if files throw errors
  258. ;; then silently ignore the error and continue to the
  259. ;; next file. This allows files to error out if
  260. ;; required executables aren't available.
  261. (mapc
  262. (lambda (path)
  263. (if (file-directory-p path)
  264. (rld path)
  265. (condition-case err
  266. (when (string-match "^[A-Za-z].*\\.el$"
  267. (file-name-nondirectory path))
  268. (load-file path))
  269. (missing-test-dependency
  270. (let ((name (intern
  271. (concat "org-missing-dependency/"
  272. (file-name-nondirectory
  273. (file-name-sans-extension path))))))
  274. (eval `(ert-deftest ,name ()
  275. :expected-result :failed (should nil))))))))
  276. (directory-files base 'full
  277. "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el$"))))
  278. (rld (expand-file-name "lisp" org-test-dir))
  279. (rld (expand-file-name "lisp" (expand-file-name "contrib" org-test-dir)))))
  280. (defun org-test-current-defun ()
  281. "Test the current function."
  282. (interactive)
  283. (ert (which-function)))
  284. (defun org-test-current-file ()
  285. "Run all tests for current file."
  286. (interactive)
  287. (ert (concat "test-"
  288. (file-name-sans-extension
  289. (file-name-nondirectory (buffer-file-name)))
  290. "/")))
  291. (defvar org-test-buffers nil
  292. "Hold buffers open for running Org-mode tests.")
  293. (defun org-test-touch-all-examples ()
  294. (dolist (file (directory-files
  295. org-test-example-dir 'full
  296. "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$"))
  297. (unless (get-file-buffer file)
  298. (add-to-list 'org-test-buffers (find-file file)))))
  299. (defun org-test-kill-all-examples ()
  300. (while org-test-buffers
  301. (let ((b (pop org-test-buffers)))
  302. (when (buffer-live-p b) (kill-buffer b)))))
  303. (defun org-test-update-id-locations ()
  304. (org-id-update-id-locations
  305. (directory-files
  306. org-test-example-dir 'full
  307. "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$")))
  308. (defun org-test-run-batch-tests ()
  309. "Run all defined tests matching \"\\(org\\|ob\\)\".
  310. Load all test files first."
  311. (interactive)
  312. (let ((org-id-track-globally t)
  313. (org-id-locations-file
  314. (convert-standard-filename
  315. (expand-file-name
  316. "testing/.test-org-id-locations"
  317. org-base-dir))))
  318. (org-test-touch-all-examples)
  319. (org-test-update-id-locations)
  320. (org-test-load)
  321. (ert-run-tests-batch-and-exit "\\(org\\|ob\\)")))
  322. (defun org-test-run-all-tests ()
  323. "Run all defined tests matching \"\\(org\\|ob\\)\".
  324. Load all test files first."
  325. (interactive)
  326. (org-test-touch-all-examples)
  327. (org-test-load)
  328. (ert "\\(org\\|ob\\)")
  329. (org-test-kill-all-examples))
  330. (provide 'org-test)
  331. ;;; org-test.el ends here