test-framework.lisp - clic - Clic is an command line interactive client for gop… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
test-framework.lisp (1935B) | |
--- | |
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 … | |
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))) |