3rdparties/software/trivial-gray-streams-20181018-git/test/test-framework.lisp (1935 bytes)
1 (in-package :trivial-gray-streams-test) 2 3 ;;; test framework 4 5 #| 6 Used like this: 7 8 (list (test (add) (assert (= 5 (+ 2 2)))) 9 (test (mul) (assert (= 4 (* 2 2)))) 10 (test (subst) (assert (= 3 (- 4 2))))) 11 12 => ;; list of test results, 2 failed 1 passed 13 (#<TEST-RESULT ADD :FAIL The assertion (= 5 (+ 2 2)) failed.> 14 #<TEST-RESULT MUL :OK> 15 #<TEST-RESULT SUBST :FAIL The assertion (= 3 (- 4 2)) failed.>) 16 17 |# 18 19 (defclass test-result () 20 ((name :type symbol 21 :initarg :name 22 :initform (error ":name is requierd") 23 :accessor name) 24 (status :type (or (eql :ok) (eql :fail)) 25 :initform :ok 26 :initarg :status 27 :accessor status) 28 (cause :type (or null condition) 29 :initform nil 30 :initarg :cause 31 :accessor cause))) 32 33 (defun failed-p (test-result) 34 (eq (status test-result) :fail)) 35 36 (defmethod print-object ((r test-result) stream) 37 (print-unreadable-object (r stream :type t) 38 (format stream "~S ~S~@[ ~A~]" (name r) (status r) (cause r)))) 39 40 (defparameter *allow-debugger* nil) 41 42 (defun test-impl (name body-fn) 43 (flet ((make-result (status &optional cause) 44 (make-instance 'test-result :name name :status status :cause cause))) 45 (handler-bind ((serious-condition 46 (lambda (c) 47 (unless *allow-debugger* 48 (format t "FAIL: ~A~%" c) 49 (let ((result (make-result :fail c))) 50 (return-from test-impl result)))))) 51 (format t "Running test ~S... " name) 52 (funcall body-fn) 53 (format t "OK~%") 54 (make-result :ok)))) 55 56 (defmacro test ((name) &body body) 57 "If the BODY signals a SERIOUS-CONDITION 58 this macro returns a failed TEST-RESULT; otherwise 59 returns a successfull TEST-RESULT." 60 `(test-impl (quote ,name) (lambda () ,@body)))