summaryrefslogtreecommitdiffstats
path: root/emacs.d/nxhtml/tests/ert2.el
diff options
context:
space:
mode:
authorGravatar Tom Willemsen2011-03-07 09:04:49 +0100
committerGravatar Tom Willemsen2011-03-07 09:04:49 +0100
commit94d2fc1815a919734353c942f224db1de4b4fcb8 (patch)
tree4168e816ead132bfa3510e272427837c3895f5e2 /emacs.d/nxhtml/tests/ert2.el
parentd0e7674fdb1de12c8de202d4028a5d7ed3669a6e (diff)
downloaddotfiles-94d2fc1815a919734353c942f224db1de4b4fcb8.tar.gz
dotfiles-94d2fc1815a919734353c942f224db1de4b4fcb8.zip
Django, org
* Added nxhtml, mostly for django support. * Changed some org settings.
Diffstat (limited to 'emacs.d/nxhtml/tests/ert2.el')
-rw-r--r--emacs.d/nxhtml/tests/ert2.el268
1 files changed, 268 insertions, 0 deletions
diff --git a/emacs.d/nxhtml/tests/ert2.el b/emacs.d/nxhtml/tests/ert2.el
new file mode 100644
index 0000000..1fe971c
--- /dev/null
+++ b/emacs.d/nxhtml/tests/ert2.el
@@ -0,0 +1,268 @@
+;;; ert2.el --- Additions to ert.el
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-09-02T11:46:03+0200 Tue
+;; Version:
+;; Last-Updated: 2009-01-06 Tue
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; Cannot open load file: ert2.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile
+ (let* ((this-file (or load-file-name
+ (when (boundp 'bytecomp-filename) bytecomp-filename)
+ buffer-file-name))
+ (this-dir (file-name-directory this-file))
+ (load-path (cons this-dir load-path)))
+ (require 'ert)))
+
+(let* ((this-dir
+ (file-name-directory (if load-file-name load-file-name buffer-file-name)))
+ ;;(load-path (copy-list load-path)))
+ (load-path (copy-sequence load-path)))
+ (add-to-list 'load-path this-dir)
+ (require 'ert))
+
+
+(defvar ert-temp-test-buffer-test nil)
+(make-variable-buffer-local 'ert-temp-test-buffer-test)
+(put 'ert-temp-test-buffer-test 'permanent-local t)
+
+(defvar ert-temp-test-buffer-file nil)
+(make-variable-buffer-local 'ert-temp-test-buffer-file)
+(put 'ert-temp-test-buffer-file 'permanent-local t)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Test buffers
+
+(defvar ert-failed-tests-temp-buffers nil)
+
+(defvar ert-list-failed-buffers-name "*Ert Failed Test Buffers*")
+
+(defun ert-kill-temp-test-buffers ()
+ "Delete test buffers from unsuccessful tests."
+ (interactive)
+ (let ((failed (get-buffer ert-list-failed-buffers-name)))
+ (when failed (kill-buffer failed)))
+ (dolist (buf ert-failed-tests-temp-buffers)
+ (when (buffer-live-p buf)
+ (kill-buffer buf)))
+ (setq ert-failed-tests-temp-buffers nil))
+
+(defun ert-list-temp-test-buffers ()
+ "List test buffers from unsuccessful tests."
+ (interactive)
+ (setq ert-failed-tests-temp-buffers
+ (delq nil
+ (mapcar (lambda (buf)
+ (when (buffer-live-p buf)
+ buf))
+ ert-failed-tests-temp-buffers)))
+ (let ((ert-buffer (get-buffer "*ert*"))
+ (buffers ert-failed-tests-temp-buffers))
+ (when ert-buffer (setq buffers (cons ert-buffer buffers)))
+ (switch-to-buffer
+ (let ((Buffer-menu-buffer+size-width 40))
+ (list-buffers-noselect nil buffers)))
+ (rename-buffer ert-list-failed-buffers-name t))
+ (unless ert-failed-tests-temp-buffers
+ (message "No test buffers from unsuccessful tests")))
+
+(defvar ert-temp-test-buffer-minor-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; Add menu bar entries for test buffer and test function
+ (define-key map [(control ?c) ?? ?t] 'ert-temp-test-buffer-go-test)
+ (define-key map [(control ?c) ?? ?f] 'ert-temp-test-buffer-go-file)
+ map))
+(defun ert-temp-test-buffer-go-test ()
+ (interactive)
+ (ert-find-test-other-window ert-temp-test-buffer-test))
+(defun ert-temp-test-buffer-go-file ()
+ (interactive)
+ (find-file-other-window ert-temp-test-buffer-file))
+
+(define-minor-mode ert-temp-test-buffer-minor-mode
+ "Helpers for those buffers ..."
+ )
+(put 'ert-temp-test-buffer-minor-mode 'permanent-local t)
+
+;; Fix-me: doc
+(defvar ert-test-files-root nil)
+(defun ert-get-test-file-name (file-name)
+ (unless ert-test-files-root
+ (error "Please set ert-test-files-root for your tests"))
+ (unless (file-directory-p ert-test-files-root)
+ (error "Can't find directory %s" ert-test-files-root))
+ (expand-file-name file-name ert-test-files-root))
+
+(defmacro* ert-with-temp-buffer-include-file (file-name-form &body body)
+ "Insert FILE-NAME-FORM in a temporary buffer and eval BODY.
+If success then delete the temporary buffer, otherwise keep it.
+
+To access these temporary test buffers use
+- `ert-list-temp-test-buffers': list them
+- `ert-kill-temp-test-buffers': delete them"
+ (declare (indent 1) (debug t))
+ (let ((file-name (make-symbol "file-name-")))
+ `(let* ((,file-name (ert-get-test-file-name ,file-name-form))
+ (mode-line-buffer-identification (list (propertize "%b" 'face 'highlight)))
+ ;; Give the buffer a name that allows us to switch to it
+ ;; quickly when debugging a failure.
+ (temp-buf
+ (generate-new-buffer
+ (format "%s" (ert-this-test)))))
+ (unless (file-readable-p ,file-name)
+ (if (file-exists-p ,file-name)
+ (error "Can't read %s" ,file-name)
+ (error "Can't find %s" ,file-name)))
+ (message "Testing with file %s" ,file-name)
+ (setq ert-failed-tests-temp-buffers (cons temp-buf ert-failed-tests-temp-buffers))
+ (with-current-buffer temp-buf
+ (ert-temp-test-buffer-minor-mode 1)
+ (setq ert-temp-test-buffer-file ,file-name)
+ (setq ert-temp-test-buffer-test (ert-this-test))
+ ;; Avoid global font lock
+ (let ((font-lock-global-modes nil))
+ ;; Turn off font lock in buffer
+ (font-lock-mode -1)
+ (when (> emacs-major-version 22)
+ (assert (not font-lock-mode) t "%s %s" "in ert-with-temp-buffer-include-file"))
+ (insert-file-contents ,file-name)
+ (save-window-excursion
+ ;; Switch to buffer so it will show immediately when
+ ;; debugging a failure.
+ (switch-to-buffer-other-window (current-buffer))
+ ,@body)
+ ;; Fix-me: move to success list?
+ (kill-buffer temp-buf))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Simulate commands
+
+(defvar ert-simulate-command-delay nil)
+
+(defvar ert-simulate-command-post-hook nil
+ "Normal hook to be run at end of `ert-simulate-command'.")
+
+;; Fix-me: use this in all tests where applicable.
+(defun ert-simulate-command (command run-idle-timers)
+ ;; Fix-me: run-idle-timers - use seconds
+ ;; Fix-me: add unread-events
+ "Simulate calling command COMMAND as in Emacs command loop.
+If RUN-IDLE-TIMERS is non-nil then run the idle timers after
+calling everything involved with the command.
+
+COMMAND should be a list where the car is the command symbol and
+the rest are arguments to the command.
+
+NOTE: Since the command is not called by `call-interactively'
+test for `called-interactively' in the command will fail.
+
+Return the value of calling the command, ie
+
+ (apply (car COMMAND) (cdr COMMAND)).
+
+Run the hook `ert-simulate-command-post-hook' at the very end."
+
+ (message "command=%s" command)
+ (ert-should (listp command))
+ (ert-should (commandp (car command)))
+ (ert-should (not unread-command-events))
+ (let (return-value
+ (font-lock-mode t))
+ ;; For the order of things here see command_loop_1 in keyboard.c
+ ;;
+ ;; The command loop will reset the command related variables so
+ ;; there is no reason to let bind them. They are set here however
+ ;; to be able to test several commands in a row and how they
+ ;; affect each other.
+ (setq deactivate-mark nil)
+ (setq this-original-command (car command))
+ ;; remap through active keymaps
+ (setq this-command (or (command-remapping this-original-command)
+ this-original-command))
+ (run-hooks 'pre-command-hook)
+ (setq return-value (apply (car command) (cdr command))) ;; <-----
+ (message "post-command-hook=%s" post-command-hook)
+ (run-hooks 'post-command-hook)
+ (when deferred-action-list
+ (run-hooks 'deferred_action_function))
+ (setq real-last-command (car command))
+ (setq last-repeatable-command real-last-command)
+ (setq last-command this-command)
+ (when (and deactivate-mark transient-mark-mode) (deactivate-mark))
+ ;;(message "ert-simulate-command.before idle-timers, point=%s" (point))
+ (when run-idle-timers
+ ;;(dolist (timer (copy-list timer-idle-list))
+ (dolist (timer (copy-sequence timer-idle-list))
+ (timer-event-handler timer)
+ ;;(message " after timer=%s, point=%s" timer (point))
+ )
+ (redisplay t))
+ ;;(message "ert-simulate-command.after idle-timers, point=%s" (point))
+ (when ert-simulate-command-delay
+ ;; Show user
+ ;;(message "After M-x %s" command)
+ (let ((old-buffer-name (buffer-name)))
+ (rename-buffer (propertize (format "After M-x %s" (car command))
+ 'face 'highlight)
+ t)
+ (sit-for ert-simulate-command-delay)
+ (rename-buffer old-buffer-name)))
+ (ert-should (not unread-command-events))
+ (run-hooks 'ert-simulate-command-post-hook)
+ return-value))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Misc
+
+(defun ert-this-test ()
+ "Return current `ert-deftest' function."
+ (elt test 1))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Self tests
+
+(provide 'ert2)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; ert2.el ends here