43 lines
1.1 KiB
Common Lisp
43 lines
1.1 KiB
Common Lisp
;;; cl-scopes/testing
|
|
|
|
;;;; simple testing library
|
|
|
|
(defpackage :scopes/testing
|
|
(:use :common-lisp)
|
|
(:export #:*test-suite*
|
|
#:test-suite #:deftest #:show-result
|
|
#:test #:==))
|
|
|
|
(in-package :scopes/testing)
|
|
|
|
(defvar *test-suite* nil)
|
|
|
|
(defclass test-suite ()
|
|
((name :reader name :initform "test" :initarg :name)
|
|
(result :accessor result :initform nil)
|
|
(ok :accessor ok :initform t)))
|
|
|
|
(defun test-suite (&optional (name "test"))
|
|
(make-instance 'test-suite :name name))
|
|
|
|
(defun show-result ()
|
|
(format t "=== ~a Tests ===~%" (name *test-suite*) )
|
|
(dolist (res (reverse (result *test-suite*)))
|
|
(let ((tst (reverse res)))
|
|
(format t "~a: ~a~%" (string-downcase (car tst)) (cdr tst))))
|
|
(if (not (ok *test-suite*))
|
|
(format t "*****~%"))
|
|
(values))
|
|
|
|
(defun == (have wanted)
|
|
(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)
|
|
`(defun ,name ,args
|
|
(push '(,name) (result *test-suite*))
|
|
,@body))
|