org-test.el 14 KB

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