test-framework.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
 (HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
 (DIR) Log
 (DIR) Files
 (DIR) Refs
 (DIR) Tags
 (DIR) README
 (DIR) 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 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)))