org-test.el 16 KB

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