org-test.el 5.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184
  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. ;; Released under the GNU General Public License version 3
  7. ;; see: http://www.gnu.org/licenses/gpl-3.0.html
  8. ;;;; Comments:
  9. ;; Interactive testing for Org mode.
  10. ;; The heart of all this is the commands `org-test-current-defun'. If
  11. ;; called while in a `defun' all ert tests with names matching the
  12. ;; name of the function are run.
  13. ;;; Prerequisites:
  14. ;; ERT and jump.el are both included as git submodules, install with
  15. ;; $ git submodule init
  16. ;; $ git submodule update
  17. ;;;; Code:
  18. (let* ((org-test-dir (expand-file-name
  19. (file-name-directory
  20. (or load-file-name buffer-file-name))))
  21. (load-path (cons
  22. (expand-file-name "ert" org-test-dir)
  23. (cons
  24. (expand-file-name "jump" org-test-dir)
  25. load-path))))
  26. (require 'ert-batch)
  27. (require 'ert)
  28. (require 'ert-exp)
  29. (require 'ert-exp-t)
  30. (require 'ert-run)
  31. (require 'ert-ui)
  32. (require 'jump)
  33. (require 'which-func)
  34. (require 'org))
  35. (defconst org-test-default-test-file-name "tests.el"
  36. "For each defun a separate file with tests may be defined.
  37. tests.el is the fallback or default if you like.")
  38. (defconst org-test-default-directory-name "testing"
  39. "Basename or the directory where the tests live.
  40. org-test searches this directory up the directory tree.")
  41. (defconst org-test-dir
  42. (expand-file-name (file-name-directory (or load-file-name buffer-file-name))))
  43. (defconst org-base-dir
  44. (expand-file-name ".." org-test-dir))
  45. (defconst org-test-example-dir
  46. (expand-file-name "examples" org-test-dir))
  47. (defconst org-test-file
  48. (expand-file-name "normal.org" org-test-example-dir))
  49. (defconst org-test-no-heading-file
  50. (expand-file-name "no-heading.org" org-test-example-dir))
  51. (defconst org-test-link-in-heading-file
  52. (expand-file-name "link-in-heading.org" org-test-dir))
  53. ;;; Functions for writing tests
  54. (defun org-test-buffer (&optional file)
  55. "TODO: Setup and return a buffer to work with.
  56. If file is non-nil insert it's contents in there.")
  57. (defun org-test-compare-with-file (&optional file)
  58. "TODO: Compare the contents of the test buffer with FILE.
  59. If file is not given, search for a file named after the test
  60. currently executed.")
  61. (defmacro org-test-in-example-file (file &rest body)
  62. "Execute body in the Org-mode example file."
  63. (declare (indent 1))
  64. `(let* ((my-file (or ,file org-test-file))
  65. (visited-p (get-file-buffer my-file))
  66. to-be-removed)
  67. (save-window-excursion
  68. (save-match-data
  69. (find-file my-file)
  70. (setq to-be-removed (current-buffer))
  71. (goto-char (point-min))
  72. (condition-case nil
  73. (progn
  74. (outline-next-visible-heading 1)
  75. (org-show-subtree)
  76. (org-show-block-all))
  77. (error nil))
  78. ,@body))
  79. (unless visited-p
  80. (kill-buffer to-be-removed))))
  81. (defmacro org-test-at-marker (file marker &rest body)
  82. "Run body after placing the point at MARKER in FILE.
  83. Note the uuidgen command-line command can be useful for
  84. generating unique markers for insertion as anchors into org
  85. files."
  86. (declare (indent 2))
  87. `(org-test-in-example-file ,file
  88. (goto-char (point-min))
  89. (re-search-forward (regexp-quote ,marker))
  90. ,@body))
  91. ;;; Navigation Functions
  92. (defjump 'org-test-jump
  93. '(("lisp/\\1.el" . "testing/lisp/test-\\1.el")
  94. ("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el")
  95. ("contrib/lisp/\\1.el" . "testing/contrib/lisp/test-\\1.el")
  96. ("contrib/lisp/\\1.el" . "testing/contrib/lisp/\\1.el/test.*.el")
  97. ("testing/lisp/test-\\1.el" . "lisp/\\1.el")
  98. ("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el")
  99. ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el")
  100. ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el/test.*.el"))
  101. (concat org-base-dir "/")
  102. "Jump between org-mode files and their tests."
  103. (lambda (path)
  104. (let* ((full-path (expand-file-name path org-base-dir))
  105. (file-name (file-name-nondirectory path))
  106. (name (file-name-sans-extension file-name)))
  107. (find-file full-path)
  108. (insert
  109. ";;; " file-name "\n\n"
  110. ";; Copyright (c) 2010 " user-full-name "\n"
  111. ";; Authors: " user-full-name "\n\n"
  112. ";; Released under the GNU General Public License version 3\n"
  113. ";; see: http://www.gnu.org/licenses/gpl-3.0.html\n\n"
  114. ";;;; Comments:\n\n"
  115. ";; Template test file for Org-mode tests\n\n"
  116. " \n"
  117. ";;; Code:\n"
  118. "(require 'org-test)\n\n"
  119. " \n"
  120. ";;; Tests\n"
  121. "(ert-deftest " name "/example-test ()\n"
  122. " \"Just an example to get you started.\"\n"
  123. " (should t)\n"
  124. " (should-not nil)\n"
  125. " (should-error (error \"errr...\")))\n\n\n"
  126. "(provide '" name ")\n\n"
  127. ";;; " file-name " ends here\n") full-path))
  128. (lambda () ((lambda (res) (if (listp res) (car res) res)) (which-function))))
  129. ;;; Load and Run tests
  130. (defun org-test-load ()
  131. "Load up the org-mode test suite."
  132. (interactive)
  133. (flet ((rload (base)
  134. (mapc
  135. (lambda (path)
  136. (if (file-directory-p path) (rload path) (load-file path)))
  137. (directory-files base 'full
  138. "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el"))))
  139. (rload (expand-file-name "lisp" org-test-dir))
  140. (rload (expand-file-name "lisp"
  141. (expand-file-name "contrib" org-test-dir)))))
  142. (defun org-test-current-defun ()
  143. "Test the current function."
  144. (interactive)
  145. (ert (car (which-function))))
  146. (defun org-test-run-all-tests ()
  147. "Run all defined tests matching \"^org\".
  148. Load all test files first."
  149. (interactive)
  150. (org-test-load)
  151. (ert "org"))
  152. (provide 'org-test)
  153. ;;; org-test.el ends here