cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

some testing improvements

Browse source
This commit is contained in:
Helmut Merz 2024-05-21 15:02:44 +02:00
parent 547e02b85f
commit 8436ed3742
1 changed files with 14 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
testing.lisp
View file

@ -14,19 +14,28 @@
(defclass test-suite () (defclass test-suite ()
((name :reader name :initform "test" :initarg :name) ((name :reader name :initform "test" :initarg :name)
(result :accessor result :initform nil))) (result :accessor result :initform nil)
(ok :accessor ok :initform t)))
(defun test-suite (&optional (name "test")) (defun test-suite (&optional (name "test"))
(make-instance 'test-suite :name name)) (make-instance 'test-suite :name name))
(defun show-result () (defun show-result ()
(format t "~a~%" (name *test-suite*) ) (format t "=== ~a Tests ===~%" (name *test-suite*) )
(dolist (res (result *test-suite*)) (dolist (res (reverse (result *test-suite*)))
(let ((tst (reverse res))) (let ((tst (reverse res)))
(format t "~a: ~a~%" (string-downcase (car tst)) (cdr tst))))) (format t "~a: ~a~%" (string-downcase (car tst)) (cdr tst))))
(if (not (ok *test-suite*))
(format t "*****~%"))
(values))
(defun == (have wanted) (defun == (have wanted)
(push (equalp have wanted) (car (result *test-suite*)))) (let ((is-ok (equalp have wanted)))
(if (not is-ok)
(progn
(push (format nil "~a!=~a" have wanted) (car (result *test-suite*)))
(setf (ok *test-suite*) nil))
(push is-ok (car (result *test-suite*))))))
(defmacro deftest (name args &body body) (defmacro deftest (name args &body body)
`(defun ,name ,args `(defun ,name ,args