mirrors
/
org-mode
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git
0
0
Fork 1
Code Releases Activity

merge ert-testing and schulte-testing, temporarily removing navigation functions

This commit is contained in:
Eric Schulte 2010-10-03 10:45:07 -06:00
parent 2b52d1911c
commit 70ee58a8ab
4 changed files with 96 additions and 268 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
testing/example-file.org Normal file
View File

@ -0,0 +1,18 @@
#+TITLE: Example file
#+OPTIONS: num:nil ^:nil
#+STARTUP: hideblocks
This is an example file for use by the Org-mode tests.
* top
** code block
:PROPERTIES:
:tangle: yes
:CUSTOM_ID: code-block-section
:END:
Here are a couple of code blocks.
#+begin_src emacs-lisp :tangle no
;; 94839181-184f-4ff4-a72f-94214df6f5ba
(message "I am code")
#+end_src

29
testing/lisp/test-ob.el Normal file
View File

@ -0,0 +1,29 @@
;;; test-ob.el --- tests for ob.el
(require 'org-test)
(defmacro test-ob-in-code-block (marker &rest body)
(declare (indent 1))
`(in-org-example-file
(goto-char (point-min))
(re-search-forward (regexp-quote ,marker))
,@body))
(ert-deftest test-org-babel-get-src-block-info-language ()
(test-ob-in-code-block "94839181-184f-4ff4-a72f-94214df6f5ba"
(let ((info (org-babel-get-src-block-info)))
(should (string= "emacs-lisp" (nth 0 info))))))
(ert-deftest test-org-babel-get-src-block-info-body ()
(test-ob-in-code-block "94839181-184f-4ff4-a72f-94214df6f5ba"
(let ((info (org-babel-get-src-block-info)))
(should (string-match (regexp-quote "94839181-184f-4ff4-a72f-94214df6f5ba")
(nth 1 info))))))
(ert-deftest test-org-babel-get-src-block-info-tangle ()
(test-ob-in-code-block "94839181-184f-4ff4-a72f-94214df6f5ba"
(let ((info (org-babel-get-src-block-info)))
(should (string= "no" (cdr (assoc :tangle (nth 2 info))))))))
(provide 'test-ob)
;;; test-ob ends here

0
testing/org-html/tests.el → testing/old/org-html.el
View File

317
testing/org-test.el
View File

@ -1,8 +1,9 @@
;;;; org-test.el --- Tests for Org-mode
;; Copyright (c) 2010 Sebastian Rose, Hannover, Germany
;; Copyright (c) 2010 Sebastian Rose, Eric Schulte
;; Authors:
;; Sebastian Rose, Hannover, Germany, sebastian_rose gmx de
;; Eric Schulte, Santa Fe, New Mexico, USA, schulte.eric gmail com
;; Released under the GNU General Public License version 3
;; see: http://www.gnu.org/licenses/gpl-3.0.html
@ -11,42 +12,28 @@
;; Interactive testing for Org mode.
;; The heart of all this is the commands
;; `org-test-test-current-defun'. If called while in an emacs-lisp
;; file, org-test first searches for a directory testing/tests/NAME/,
;; where name is the basename of the lisp file you're in. This
;; directory is then searched for a file named like the defun the
;; point is in. If that failes, a file named 'tests.el' is searched
;; in this directory. The file found is loaded and
;; `org-test-run-tests' is called with the prefix "^NAME-OF-DEFUN".
;; The second usefull function is `org-test-test-buffer-file'. This
;; function searches the same way as `org-test-test-current-defun'
;; does, but only for the tests.el file. All tests in that file with
;; the prefix "^BUFFER-FILE-NAME" with the ".el" suffix stripped are
;; executed.
;; The heart of all this is the commands `org-test-current-defun'. If
;; called while in a `defun' all ert tests with names matching the
;; name of the function are run.
;;; Prerequisites:
;; You'll need to download and install ERT to use this stuff. You can
;; get ERT like this:
;; sh$ git clone http://github.com/ohler/ert.git
;; ERT and jump.el are both installed as git submodules to install
;; them run
;; $ git submodule init
;; $ git submodule update
;;;; Code:
(require 'ert-batch)
(require 'ert)
(require 'ert-exp)
(require 'ert-exp-t)
(require 'ert-run)
(require 'ert-ui)
(require 'which-func)
(require 'org)
(defconst org-test-default-test-file-name "tests.el"
"For each defun a separate file with tests may be defined.
tests.el is the fallback or default if you like.")
@ -55,271 +42,65 @@ tests.el is the fallback or default if you like.")
"Basename or the directory where the tests live.
org-test searches this directory up the directory tree.")
(defconst org-test-dir
(expand-file-name (file-name-directory (or load-file-name buffer-file-name))))
(defconst org-test-example-file-name
(expand-file-name "example-file.org" org-test-dir))
;;; Find tests
(defun org-test-test-directory-for-file (file)
"Search up the directory tree for a directory
called like `org-test-default-directory-name'.
If that directory is not found, ask the user.
Return the name of the directory that should contain tests for
FILE regardless of it's existence.
If the directory `org-test-default-directory-name' cannot be
found up the directory tree, return nil."
(let* ((file (file-truename
(or file buffer-file-name)))
(orig
(file-name-directory
(expand-file-name (or file buffer-file-name))))
(parent orig)
(child "")
base)
(catch 'dir
(progn
(while (not (string= parent child))
(let ((td (file-name-as-directory
(concat parent
org-test-default-directory-name))))
(when (file-directory-p td)
(setq base parent)
(throw 'dir parent))
(setq child parent)
(setq parent (file-name-as-directory
(file-truename (concat parent ".."))))))
(throw 'dir nil)))
(if base
;; For now, rely on the fact, that if base exists, the rest of
;; the directory setup is as expected, too.
(progn
(file-name-as-directory
(concat
(file-name-as-directory
(file-truename
(concat
(file-name-as-directory
(concat base org-test-default-directory-name))
(file-relative-name orig base))))
(file-name-nondirectory file))))
;; TODO:
;; it's up to the user to find the directory for the file he's
;; testing...
;; (setq base (read-directory-name
;; "Testdirectory: " orig orig t))
nil)))
(defun org-test-test-file-name-for-file (directory file)
"Return the name of the file that should contain the tests for FILE.
FILE might be a path or a base filename.
Return nil if no file tests for FILE exists."
;; TODO: fall back on a list of all *.el files in this directory.
(let ((tf (concat directory
org-test-default-test-file-name)))
(if (file-exists-p tf)
tf
nil)))
(defun org-test-test-file-name-for-defun (directory fun &optional file)
"Return the name of the file that might or might not contain tests
for defun FUN (a string) defined FILE. Return nil if no file with
special tests for FUN exists."
(let* ((funsym (intern fun))
(file (or file
(find-lisp-object-file-name
(intern fun)
(symbol-function (intern fun)))))
(tf (concat directory fun ".el")))
(if (file-exists-p tf)
tf
nil)))
;;; TODO: Test buffers and control files
;;; Functions for writing tests
;; TODO
(defun org-test-buffer (&optional file)
"TODO: Setup and return a buffer to work with.
If file is non-nil insert it's contents in there.")
;; TODO
(defun org-test-compare-with-file (&optional file)
"TODO: Compare the contents of the test buffer with FILE.
If file is not given, search for a file named after the test
currently executed.")
(defmacro in-org-example-file (&rest body)
"Execute body in the Org-mode example file."
(declare (indent 0))
`(let ((visited-p (get-file-buffer org-test-example-file-name))
to-be-removed)
(save-window-excursion
(save-match-data
(find-file org-test-example-file-name)
(setq to-be-removed (current-buffer))
(goto-char (point-min))
(outline-next-visible-heading 1)
(org-show-subtree)
(org-show-block-all)
,@body))
(unless visited-p
(kill-buffer to-be-removed))))
;;; Run tests
;;; Load and Run tests
(defun org-test-run-tests (&optional selector)
"Run all tests matched by SELECTOR.
SELECTOR defaults to \"^org\".
See the docstring of `ert-select-tests' for valid selectors.
Unless `ert', this function runs all tests inside
(let ((deactivate-mark nil))
(save-excursion
(save-match-data
...)))."
(defun org-load-tests ()
"Load up the org-mode test suite."
(interactive)
(let ((select (or selector "^org"))
(deactivate-mark nil))
(save-excursion
(save-match-data
(ert select)))))
(mapc (lambda (file) (load-file file))
(directory-files (expand-file-name "lisp" org-test-dir)
'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el")))
(defun org-test-current-defun ()
"Test the current function."
(interactive)
(ert (car (which-function))))
(defun org-test-run-all-tests ()
"Run all defined tests matching \"^org\".
Unlike `org-test-run-tests', load all test files first.
Uses `org-test-run-tests' to run the actual tests."
Load all test files first."
(interactive)
(let* ((org-dir
(file-name-directory
(find-lisp-object-file-name 'org-mode 'function)))
(org-files
(directory-files org-dir nil "\\.el")))
(message "Loading all tests....")
(mapc
(lambda (f)
(let* ((dir (org-test-test-directory-for-file f)))
(when (and dir (file-directory-p dir))
(let ((tfs (directory-files dir t "\\.el")))
(mapc (lambda (tf)
(load-file tf))
tfs)))))
org-files)
(org-test-run-tests)))
;;; Utility functions:
(defun org-test-which-func ()
"Return the name of the current defun."
(save-excursion
(save-match-data
(end-of-line)
(beginning-of-defun)
(if (looking-at "(defun[[:space:]]+\\([^([:space:]]*\\)[[:space:]]*(")
(match-string-no-properties 1)
(error "No defun found around point.")))))
(defun org-test-ensure-buffer-emacs-lisp-p (&optional buffer)
"Ensure BUFFER contains an elisp file based on extension.
If BUFFER is nil, use the current buffer.
Error if not."
(save-excursion
(save-match-data
;; Check, if editing an emacs-lisp file
(with-current-buffer (or buffer (current-buffer))
(unless
(string-match "\\.el$" buffer-file-name)
(error "Not an emacs lisp file: %s" buffer-file-name))))))
;;; Commands:
(defun org-test-test-current-defun ()
"Execute all tests for function at point if tests exist."
(interactive)
(ert-delete-all-tests)
(let* ((fun (org-test-wich-func))
(dir (org-test-test-directory-for-file buffer-file-name))
(tf (or (org-test-test-file-name-for-defun
dir fun buffer-file-name)
(org-test-test-file-name-for-file dir buffer-file-name))))
(if tf
(progn
(load-file tf)
(org-test-run-tests
(concat "^" fun)))
(error "No test files found for \"%s\"" fun))))
(defun org-test-test-buffer-file (&optional only)
"Run all tests for current `buffer-file-name' if tests exist.
If ONLY is non-nil, use the `org-test-default-test-file-name'
file only."
(interactive "P")
(ert-delete-all-tests)
(let* ((pref
(concat
"^"
(file-name-sans-extension
(file-name-nondirectory buffer-file-name))))
(dir (org-test-test-directory-for-file buffer-file-name))
(tfs (if only
(list
(org-test-test-file-name-for-file
dir buffer-file-name))
(directory-files dir t "\\.el$"))))
(if (car tfs)
(mapc
(lambda (tf)
(load-file tf)
(org-test-run-tests pref))
tfs)
(error "No %s found for \"%s\""
(if only
(format "file \"%s\"" org-test-default-test-file-name)
"test files")
buffer-file-name))))
(defun org-test-edit-buffer-file-tests (&optional func)
"Open the `org-test-default-test-file-name' file for editing.
If the file (and parent directories) do not yet exist,
create them."
(interactive)
(org-test-ensure-buffer-emacs-lisp-p)
(let ((dir (org-test-test-directory-for-file
buffer-file-name)))
(unless dir
(error "Directory %s not found. Sorry."
org-test-default-directory-name))
(let* ((tf (concat
dir
(if func
(concat func ".el")
org-test-default-test-file-name)))
(exists (file-exists-p tf))
(rel (file-relative-name buffer-file-name dir))
(tprefix (file-name-nondirectory
(file-name-sans-extension buffer-file-name))))
(unless (file-directory-p dir) ; FIXME: Ask?
(make-directory dir t))
(find-file tf)
(unless exists
(insert
";;; " (file-name-nondirectory tf) "\n"
";; Tests for `"
(if func (concat func "' in `") "")
(replace-regexp-in-string "^\\(?:\\.+/\\)+" "" rel)
"'\n\n"
" \n"
";;; Code:\n"
"(require 'org-test)\n"
"(unless (fboundp 'org-test-run-all-tests)\n"
" (error \"%s\" \"org-test.el not loaded. Giving up.\"))\n"
"\n"
" \n"
";;; Tests\n"
"(ert-deftest " tprefix "/example-test ()\n"
" \"Just an example to get you started.\"\n"
" (should t)\n"
" (should-not nil)\n"
" (should-error (error \"errr...\")))\n")))))
(defun org-test-edit-current-defuns-tests ()
"Open the file with tests related to the current defun.
If the file (and parent directories) do not yet exist,
create them."
(interactive)
(org-test-ensure-buffer-emacs-lisp-p)
(org-test-edit-buffer-file-tests
(org-test-which-func)))
(org-load-tests)
(ert "^org"))
(provide 'org-test)
;;; org-test.el ends here