diff options
Diffstat (limited to 'emacs.d/nxhtml/tests/ert2.el')
| -rw-r--r-- | emacs.d/nxhtml/tests/ert2.el | 268 |
1 files changed, 0 insertions, 268 deletions
diff --git a/emacs.d/nxhtml/tests/ert2.el b/emacs.d/nxhtml/tests/ert2.el deleted file mode 100644 index 1fe971c..0000000 --- a/emacs.d/nxhtml/tests/ert2.el +++ /dev/null @@ -1,268 +0,0 @@ -;;; 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 |