org-test.el 4.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155
  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-file-name
  46. (expand-file-name "example-file.org" org-test-dir))
  47. ;;; Functions for writing tests
  48. (defun org-test-buffer (&optional file)
  49. "TODO: Setup and return a buffer to work with.
  50. If file is non-nil insert it's contents in there.")
  51. (defun org-test-compare-with-file (&optional file)
  52. "TODO: Compare the contents of the test buffer with FILE.
  53. If file is not given, search for a file named after the test
  54. currently executed.")
  55. (defmacro in-org-example-file (&rest body)
  56. "Execute body in the Org-mode example file."
  57. (declare (indent 0))
  58. `(let ((visited-p (get-file-buffer org-test-example-file-name))
  59. to-be-removed)
  60. (save-window-excursion
  61. (save-match-data
  62. (find-file org-test-example-file-name)
  63. (setq to-be-removed (current-buffer))
  64. (goto-char (point-min))
  65. (outline-next-visible-heading 1)
  66. (org-show-subtree)
  67. (org-show-block-all)
  68. ,@body))
  69. (unless visited-p
  70. (kill-buffer to-be-removed))))
  71. ;;; Navigation Functions
  72. (defjump 'org-test-jump
  73. '(("lisp/\\1.el" . "testing/lisp/test-\\1.el")
  74. ("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el")
  75. ("contrib/lisp/\\1.el" . "testing/contrib/lisp/test-\\1.el")
  76. ("contrib/lisp/\\1.el" . "testing/contrib/lisp/\\1.el/test.*.el")
  77. ("testing/lisp/test-\\1.el" . "lisp/\\1.el")
  78. ("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el")
  79. ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el")
  80. ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el/test.*.el"))
  81. (concat org-base-dir "/")
  82. "Jump between org-mode files and their tests."
  83. (lambda (path)
  84. (let ((full-path (expand-file-name path org-base-dir))
  85. (name (file-name-nondirectory path)))
  86. (find-file full-path)
  87. (insert
  88. ";;; " name "\n\n"
  89. ";; Copyright (c) 2010 " user-full-name "\n"
  90. ";; Authors: " user-full-name "\n\n"
  91. ";; Released under the GNU General Public License version 3\n"
  92. ";; see: http://www.gnu.org/licenses/gpl-3.0.html\n\n"
  93. ";;;; Comments:\n\n"
  94. ";; Template test file for Org-mode tests\n\n"
  95. " \n"
  96. ";;; Code:\n"
  97. "(require 'org-test)\n\n"
  98. " \n"
  99. ";;; Tests\n"
  100. "(ert-deftest " name "/example-test ()\n"
  101. " \"Just an example to get you started.\"\n"
  102. " (should t)\n"
  103. " (should-not nil)\n"
  104. " (should-error (error \"errr...\")))") full-path))
  105. (lambda () (car (which-function))))
  106. ;;; Load and Run tests
  107. (defun org-test-load ()
  108. "Load up the org-mode test suite."
  109. (interactive)
  110. (flet ((rload (base)
  111. (mapc
  112. (lambda (path)
  113. (if (file-directory-p path) (rload path) (load-file path)))
  114. (directory-files base 'full
  115. "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el"))))
  116. (rload (expand-file-name "lisp" org-test-dir))))
  117. (defun org-test-current-defun ()
  118. "Test the current function."
  119. (interactive)
  120. (ert (car (which-function))))
  121. (defun org-test-run-all-tests ()
  122. "Run all defined tests matching \"^org\".
  123. Load all test files first."
  124. (interactive)
  125. (org-test-load)
  126. (ert "^org"))
  127. (provide 'org-test)
  128. ;;; org-test.el ends here