From: ueno Date: Wed, 25 Apr 2001 04:15:19 +0000 (+0000) Subject: *** empty log message *** X-Git-Tag: flim-1_14-rfc2231-merged~5 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=1fe7d81d92386d6d1c34e20e4457960fb73ba7fc;p=elisp%2Fflim.git *** empty log message *** --- diff --git a/ChangeLog b/ChangeLog index 579ed58..40b5185 100644 --- a/ChangeLog +++ b/ChangeLog @@ -7,6 +7,16 @@ * std11.el (std11-lexical-analyze): Fix typo. +2001-04-01 Daiki Ueno + + * lunit.el (lunit-test-listener-*): Abolish generic interface. + (lunit-test-result-notify): New function. + (lunit-test-result-run): Use it. + (lunit-test-result-error): Use it. + (lunit-test-result-failure): Use it. + (lunit-create-index-function): New function. + (lunit-generate-template): New command. + 2001-03-19 Shuhei KOBAYASHI * hmac-md5.el, hmac-sha1.el: Revert to load-time check. diff --git a/lunit.el b/lunit.el index 8f5c6e7..99132d3 100644 --- a/lunit.el +++ b/lunit.el @@ -75,19 +75,7 @@ ;;; @ test listener ;;; -(luna-define-class lunit-test-listener ()) - -(luna-define-generic lunit-test-listener-error (listener case error) - "An error occurred.") - -(luna-define-generic lunit-test-listener-failure (listener case failure) - "A failure occurred.") - -(luna-define-generic lunit-test-listener-start (listener case) - "A test started.") - -(luna-define-generic lunit-test-listener-end (listener case) - "A test ended.") +(luna-define-class lunit-test-listener) ;;; @ test result ;;; @@ -109,6 +97,9 @@ (luna-define-generic lunit-test-result-run (result case) "Run the test case.") +(luna-define-generic lunit-test-result-notify (result message &rest args) + "Report the current state of execution.") + (luna-define-generic lunit-test-result-error (result case error) "Add error to the list of errors. The passed in exception caused the error.") @@ -124,45 +115,45 @@ The passed in exception caused the failure.") "Return a newly allocated `lunit-test-result' instance with LISTENERS." (luna-make-entity 'lunit-test-result :listeners listeners)) -(luna-define-method lunit-test-result-run ((result lunit-test-result) case) - (let ((listeners (lunit-test-result-listeners-internal result))) +(luna-define-method lunit-test-result-notify ((result lunit-test-result) + message args) + (let ((listeners + (lunit-test-result-listeners-internal result))) (dolist (listener listeners) - (lunit-test-listener-start listener case)) - (condition-case error - (lunit-test-case-run case) - (lunit-failure - (lunit-test-result-failure result case (nth 1 error))) - (lunit-error - (lunit-test-result-error result case (cdr error)))) - (dolist (listener listeners) - (lunit-test-listener-end listener case)))) + (apply #'luna-send listener message listener args)))) + +(luna-define-method lunit-test-result-run ((result lunit-test-result) case) + (lunit-test-result-notify result 'lunit-test-listener-start case) + (condition-case error + (lunit-test-case-run case) + (lunit-failure + (lunit-test-result-failure result case (nth 1 error))) + (lunit-error + (lunit-test-result-error result case (cdr error)))) + (lunit-test-result-notify result 'lunit-test-listener-end case)) (luna-define-method lunit-test-result-error ((result lunit-test-result) case error) - (let ((listeners (lunit-test-result-listeners-internal result)) - (errors (lunit-test-result-errors-internal result))) - (if errors - (nconc errors (list (cons case error))) - (lunit-test-result-set-errors-internal result (list (cons case error)))) - (dolist (listener listeners) - (lunit-test-listener-error listener case error)))) + (let ((errors + (lunit-test-result-errors-internal result))) + (setq errors (nconc errors (list (cons case error)))) + (lunit-test-result-set-errors-internal result errors)) + (lunit-test-result-notify result 'lunit-test-listener-error case error)) (luna-define-method lunit-test-result-failure ((result lunit-test-result) case failure) - (let ((listeners (lunit-test-result-listeners-internal result)) - (failures (lunit-test-result-failures-internal result))) - (if failures - (nconc failures (list (cons case failure))) - (lunit-test-result-set-failures-internal result (list (cons case failure)))) - (dolist (listener listeners) - (lunit-test-listener-failure listener case failure)))) + (let ((failures + (lunit-test-result-failures-internal result))) + (setq failures (nconc failures (list (cons case failure)))) + (lunit-test-result-set-failures-internal result failures)) + (lunit-test-result-notify result 'lunit-test-listener-failure case failure)) (luna-define-method lunit-test-result-add-listener ((result lunit-test-result) listener) - (let ((listeners (lunit-test-result-listeners-internal result))) - (if listeners - (nconc listeners (list listener)) - (lunit-test-result-set-listeners-internal result (list listener))))) + (let ((listeners + (lunit-test-result-listeners-internal result))) + (setq listeners (nconc listeners (list listener))) + (lunit-test-result-set-listeners-internal result listeners))) ;;; @ test case ;;; @@ -226,9 +217,7 @@ TESTS holds a number of instances of `lunit-test'." (luna-define-method lunit-test-suite-add-test ((suite lunit-test-suite) test) (let ((tests (lunit-test-suite-tests-internal suite))) - (if tests - (nconc tests (list test)) - (lunit-test-suite-set-tests-internal suite (list test))))) + (lunit-test-suite-set-tests-internal suite (nconc tests (list test))))) (luna-define-method lunit-test-number-of-tests ((suite lunit-test-suite)) (let ((tests (lunit-test-suite-tests-internal suite)) @@ -261,7 +250,8 @@ TESTS holds a number of instances of `lunit-test'." case failure) (princ (format " failure: %S" failure))) -(luna-define-method lunit-test-listener-start ((printer lunit-test-printer) case) +(luna-define-method lunit-test-listener-start ((printer lunit-test-printer) + case) (princ (format "Running `%S#%S'..." (luna-class-name case) (lunit-test-name-internal case)))) @@ -285,16 +275,55 @@ TESTS holds a number of instances of `lunit-test'." (let* ((printer (luna-make-entity 'lunit-test-printer)) (result - (lunit-make-test-result printer)) - failures - errors) + (lunit-make-test-result printer))) (lunit-test-run test result) - (setq failures (lunit-test-result-failures-internal result) - errors (lunit-test-result-errors-internal result)) - (princ (format "%d runs, %d failures, %d errors\n" - (lunit-test-number-of-tests test) - (length failures) - (length errors))))) + (let ((failures + (lunit-test-result-failures-internal result)) + (errors + (lunit-test-result-errors-internal result))) + (princ (format "%d runs, %d failures, %d errors\n" + (lunit-test-number-of-tests test) + (length failures) + (length errors)))))) + +(defvar imenu-create-index-function) +(defun lunit-create-index-function () + (require 'imenu) + (save-excursion + (unwind-protect + (progn + (goto-char (point-min)) + (setq imenu-generic-expression + '((nil "^\\s-*(def\\(un\\|subst\\|macro\\)\\s-+\\([-A-Za-z0-9+*|:]+\\)" 2))) + (funcall imenu-create-index-function)) + (setq imenu-create-index-function lisp-imenu-generic-expression)))) + +(defun lunit-generate-template (file) + (interactive "fGenerate lunit template for: ") + (save-excursion + (set-buffer (find-file-noselect file)) + (let ((index-alist + (lunit-create-index-function))) + (with-output-to-temp-buffer "*Lunit template*" + (let* ((feature + (file-name-sans-extension + (file-name-nondirectory file))) + (class + (concat "test-" feature))) + (set-buffer standard-output) + (insert "\ +\(require 'lunit) +\(require '" feature ") + +\(luna-define-class " class " (lunit-test-case)) + +") + (dolist (index index-alist) + (insert "\ +\(luna-define-method " class "-" (car index) " ((case " class ")) + (lunit-assert nil)) + +"))))))) (provide 'lunit)