1 ;;;; the ASSERTOID macro, asserting something with added generality
2 ;;;; to help in regression tests
4 (cl:in-package :cl-user)
6 ;;; EXPR is an expression to evaluate (both with EVAL and with
7 ;;; COMPILE/FUNCALL). EXTRA-OPTIMIZATIONS is a list of lists of
8 ;;; optimizations to pass to (DECLARE (OPTIMIZE ..)), to cause the
9 ;;; expression to be tested in other than the default optimization
12 ;;; The messiness with the various flavors of EXPECTED stuff is
13 ;;; to handle various issues:
14 ;;; * Some things are expected to signal errors instead of returning
16 ;;; * Some things are expected to return multiple values.
17 ;;; * Some things can return any of several values (e.g. generalized
19 ;;; The default is to expect a generalized boolean true.
21 ;;; Use EXPECTED-LAMBDA to require an answer which satisfies the given
22 ;;; LAMBDA. EXPECTED-EQL, EXPECTED-EQUAL, and EXPECTED-EQUALP are
23 ;;; shorthand for special cases of EXPECTED-LAMBDA.
25 ;;; Use EXPECTED-ERROR to require an error to be thrown. Use
26 ;;; EXPECTED-ERROR-LAMBDA to require that an error be thrown and
27 ;;; that further it satisfies the given lambda.
28 (defmacro assertoid (expr
31 (expected-eql nil expected-eql-p)
32 (expected-equal nil expected-equal-p)
33 (expected-equalp nil expected-equalp-p)
34 (expected-lambda (cond
37 (eql x (eval expected-eql))))
40 (equal x (eval expected-equal))))
43 (equalp x (eval expected-equalp))))
48 (expected-error-type nil expected-error-type-p)
49 (expected-error-lambda (if expected-error-type
54 expected-error-lambda-p))
55 (when (> (count-if #'identity
56 (vector expected-eql-p
61 expected-error-lambda-p))
63 (error "multiple EXPECTED-FOO arguments"))
64 (when expected-error-lambda
65 (error "stub: expected-error functionality not supported yet"))
66 (let ((eval-expected-lambda (eval expected-lambda)))
67 (flet ((frob (evaloid)
68 (let ((result (funcall evaloid expr)))
69 (unless (funcall eval-expected-lambda result)
70 (error "failed assertoid" expr))))
71 (compile-as-evaloid (optimizations)
75 (declare (optimize ,@optimizations))
78 (frob (compile-as-evaloid ()))
79 (dolist (i extra-optimizations)
80 (frob (compile-as-evaloid i))))))
83 (assertoid (= 2 (length (list 1 2))))
84 (assertoid (= 2 (length (list 1 2)))
85 :extra-optimizations (((speed 2) (space 3))
86 ((speed 1) (space 3))))
88 :expected-lambda (lambda (x) (equal x '(1 . 2))))
89 (assertoid (cons (list 1 2) (list 1 2))
90 :expected-equal '((1 2) 1 2))
91 ;;; not implemented yet:
92 #+nil (assertoid (length (eval (find-package :cl)))
93 :expected-error-type 'type-error)