From 94d2fc1815a919734353c942f224db1de4b4fcb8 Mon Sep 17 00:00:00 2001 From: Tom Willemsen Date: Mon, 7 Mar 2011 09:04:49 +0100 Subject: Django, org * Added nxhtml, mostly for django support. * Changed some org settings. --- emacs.d/nxhtml/tests/ert2.el | 268 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 268 insertions(+) create mode 100644 emacs.d/nxhtml/tests/ert2.el (limited to 'emacs.d/nxhtml/tests/ert2.el') 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 -- cgit v1.2.3-54-g00ecf