Skip to content
Snippets Groups Projects
Commit c91ff829 authored by Raymond Toy's avatar Raymond Toy
Browse files

Update lisp-unit.

parent 7a1457da
No related branches found
No related tags found
No related merge requests found
...@@ -57,6 +57,10 @@ ...@@ -57,6 +57,10 @@
(dotimes (i 5) (dotimes (i 5)
(assert-equal i (my-sqrt (* i i)) i))) (assert-equal i (my-sqrt (* i i)) i)))
(define-test cl-user::my-sqrt
(dotimes (i 5)
(assert-equal i (my-sqrt (* i i)) i)))
;;; Macro ;;; Macro
(defmacro my-macro (arg1 arg2) (defmacro my-macro (arg1 arg2)
......
...@@ -126,8 +126,9 @@ functions or even macros does not require reloading any tests. ...@@ -126,8 +126,9 @@ functions or even macros does not require reloading any tests.
"If not NIL, enter the debugger when an error is encountered in an "If not NIL, enter the debugger when an error is encountered in an
assertion.") assertion.")
(defparameter *signal-results* nil (defun use-debugger (&optional (flag t))
"Signal the result if non NIL.") "Use the debugger when testing, or not."
(setq *use-debugger* flag))
(defun use-debugger-p (condition) (defun use-debugger-p (condition)
"Debug or ignore errors." "Debug or ignore errors."
...@@ -136,9 +137,8 @@ assertion.") ...@@ -136,9 +137,8 @@ assertion.")
(y-or-n-p "~A -- debug?" condition)) (y-or-n-p "~A -- debug?" condition))
(*use-debugger*))) (*use-debugger*)))
(defun use-debugger (&optional (flag t)) (defparameter *signal-results* nil
"Use the debugger when testing, or not." "Signal the result if non NIL.")
(setq *use-debugger* flag))
(defun signal-results (&optional (flag t)) (defun signal-results (&optional (flag t))
"Signal the results for extensibility." "Signal the results for extensibility."
...@@ -238,7 +238,7 @@ assertion.") ...@@ -238,7 +238,7 @@ assertion.")
((and (stringp item) (not doc) (rest body)) ((and (stringp item) (not doc) (rest body))
(if tag (if tag
(values doc tag (rest body)) (values doc tag (rest body))
(parse-body (rest body) doc tag))) (parse-body (rest body) item tag)))
(t (values doc tag body))))) (t (values doc tag body)))))
(defun test-name-error-report (test-name-error stream) (defun test-name-error-report (test-name-error stream)
...@@ -260,20 +260,31 @@ assertion.") ...@@ -260,20 +260,31 @@ assertion.")
name name
(error 'test-name-error :datum name))) (error 'test-name-error :datum name)))
(defun test-package (name)
"Return the package for storing the test."
(multiple-value-bind (symbol status)
(find-symbol (symbol-name name))
(declare (ignore symbol))
(ecase status
((:internal :external nil)
(symbol-package name))
(:inherited *package*))))
(defmacro define-test (name &body body) (defmacro define-test (name &body body)
"Store the test in the test database." "Store the test in the test database."
(let ((qname (gensym "NAME-"))) (let ((qname (gensym "NAME-")))
(multiple-value-bind (doc tag code) (parse-body body) (multiple-value-bind (doc tag code) (parse-body body)
`(let* ((,qname (valid-test-name ',name)) `(let* ((,qname (valid-test-name ',name))
(doc (or ,doc (string ,qname)))) (doc (or ,doc (symbol-name ,qname)))
(package (test-package ,qname)))
(setf (setf
;; Unit test ;; Unit test
(gethash ,qname (package-table *package* t)) (gethash ,qname (package-table package t))
(make-instance 'unit-test :doc doc :code ',code)) (make-instance 'unit-test :doc doc :code ',code))
;; Tags ;; Tags
(loop for tag in ',tag do (loop
(pushnew for tag in ',tag do
,qname (gethash tag (package-tags *package* t)))) (pushnew ,qname (gethash tag (package-tags package t))))
;; Return the name of the test ;; Return the name of the test
,qname)))) ,qname))))
......
...@@ -43,6 +43,7 @@ New in this release: ...@@ -43,6 +43,7 @@ New in this release:
* Unix support on Linux has been unified with all other OSes. * Unix support on Linux has been unified with all other OSes.
Thus, src/code/unix-glibc2.lisp is no longer used. Thus, src/code/unix-glibc2.lisp is no longer used.
* Micro-optimize modular shifts on x86. * Micro-optimize modular shifts on x86.
* Update lisp-unit to commit e6c259f.
* ANSI compliance fixes: * ANSI compliance fixes:
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment