1 ;;;; the ASSERTOID macro, asserting something with added generality
2 ;;;; to help in regression tests
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; While most of SBCL is derived from the CMU CL system, the test
8 ;;;; files (like this one) were written from scratch after the fork
11 ;;;; This software is in the public domain and is provided with
12 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
13 ;;;; more information.
15 (cl:in-package :cl-user)
17 ;;; EXPR is an expression to evaluate (both with EVAL and with
18 ;;; COMPILE/FUNCALL). EXTRA-OPTIMIZATIONS is a list of lists of
19 ;;; optimizations to pass to (DECLARE (OPTIMIZE ..)), to cause the
20 ;;; expression to be tested in other than the default optimization
23 ;;; The messiness with the various flavors of EXPECTED stuff is
24 ;;; to handle various issues:
25 ;;; * Some things are expected to signal errors instead of returning
27 ;;; * Some things are expected to return multiple values.
28 ;;; * Some things can return any of several values (e.g. generalized
30 ;;; The default is to expect a generalized boolean true.
32 ;;; Use EXPECTED-LAMBDA to require an answer which satisfies the given
33 ;;; LAMBDA. EXPECTED-EQL, EXPECTED-EQUAL, and EXPECTED-EQUALP are
34 ;;; shorthand for special cases of EXPECTED-LAMBDA.
36 ;;; Use EXPECTED-ERROR to require an error to be thrown. Use
37 ;;; EXPECTED-ERROR-LAMBDA to require that an error be thrown and
38 ;;; that further it satisfies the given lambda.
39 (defmacro assertoid (expr
42 (expected-eql nil expected-eql-p)
43 (expected-equal nil expected-equal-p)
44 (expected-equalp nil expected-equalp-p)
45 (expected-lambda (cond
48 (eql x (eval expected-eql))))
51 (equal x (eval expected-equal))))
54 (equalp x (eval expected-equalp))))
59 (expected-error-type nil expected-error-type-p)
60 (expected-error-lambda (if expected-error-type
65 expected-error-lambda-p))
66 (when (> (count-if #'identity
67 (vector expected-eql-p
72 expected-error-lambda-p))
74 (error "multiple EXPECTED-FOO arguments"))
75 (when expected-error-lambda
76 (error "stub: expected-error functionality not supported yet"))
77 (let ((eval-expected-lambda (eval expected-lambda)))
78 (flet ((frob (evaloid)
79 (let ((result (funcall evaloid expr)))
80 (unless (funcall eval-expected-lambda result)
81 (error "failed assertoid" expr))))
82 (compile-as-evaloid (optimizations)
86 (declare (optimize ,@optimizations))
89 (frob (compile-as-evaloid ()))
90 (dolist (i extra-optimizations)
91 (frob (compile-as-evaloid i))))))
94 (assertoid (= 2 (length (list 1 2))))
95 (assertoid (= 2 (length (list 1 2)))
96 :extra-optimizations (((speed 2) (space 3))
97 ((speed 1) (space 3))))
99 :expected-lambda (lambda (x) (equal x '(1 . 2))))
100 (assertoid (cons (list 1 2) (list 1 2))
101 :expected-equal '((1 2) 1 2))
102 ;;; not implemented yet:
103 #+nil (assertoid (length (eval (find-package :cl)))
104 :expected-error-type 'type-error)