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