;;;; While most of SBCL is derived from the CMU CL system, the test
;;;; files (like this one) were written from scratch after the fork
;;;; from CMU CL.
;;;; While most of SBCL is derived from the CMU CL system, the test
;;;; files (like this one) were written from scratch after the fork
;;;; from CMU CL.
;;;; This software is in the public domain and is provided with
;;;; absolutely no warranty. See the COPYING and CREDITS files for
;;;; more information.
;;;; This software is in the public domain and is provided with
;;;; absolutely no warranty. See the COPYING and CREDITS files for
;;;; more information.
;;; EXPECTED-ERROR-LAMBDA to require that an error be signalled and
;;; that further it satisfies the given lambda.
(defmacro assertoid (expr
;;; EXPECTED-ERROR-LAMBDA to require that an error be signalled and
;;; that further it satisfies the given lambda.
(defmacro assertoid (expr
- &key
- extra-optimizations
- (expected-eql nil expected-eql-p)
- (expected-equal nil expected-equal-p)
- (expected-equalp nil expected-equalp-p)
- (expected-lambda (cond
- (expected-eql-p
- (lambda (x)
- (eql x (eval expected-eql))))
- (expected-equal-p
- (lambda (x)
- (equal x (eval expected-equal))))
- (expected-equalp-p
- (lambda (x)
- (equalp x (eval expected-equalp))))
- (t
- (lambda (x)
- x)))
- expected-lambda-p)
- (expected-error-type nil expected-error-type-p)
- (expected-error-lambda (if expected-error-type
- (lambda (condition)
- (typep condition
- expected-error-type))
- nil)
- expected-error-lambda-p))
+ &key
+ extra-optimizations
+ (expected-eql nil expected-eql-p)
+ (expected-equal nil expected-equal-p)
+ (expected-equalp nil expected-equalp-p)
+ (expected-lambda (cond
+ (expected-eql-p
+ (lambda (x)
+ (eql x (eval expected-eql))))
+ (expected-equal-p
+ (lambda (x)
+ (equal x (eval expected-equal))))
+ (expected-equalp-p
+ (lambda (x)
+ (equalp x (eval expected-equalp))))
+ (t
+ (lambda (x)
+ x)))
+ expected-lambda-p)
+ (expected-error-type nil expected-error-type-p)
+ (expected-error-lambda (if expected-error-type
+ (lambda (condition)
+ (typep condition
+ expected-error-type))
+ nil)
+ expected-error-lambda-p))
(error "multiple EXPECTED-FOO arguments"))
(when expected-error-lambda
(error "stub: expected-error functionality not supported yet"))
(let ((eval-expected-lambda (eval expected-lambda)))
(flet ((frob (evaloid)
(error "multiple EXPECTED-FOO arguments"))
(when expected-error-lambda
(error "stub: expected-error functionality not supported yet"))
(let ((eval-expected-lambda (eval expected-lambda)))
(flet ((frob (evaloid)
- (let ((result (funcall evaloid expr)))
- (unless (funcall eval-expected-lambda result)
- (error "failed assertoid ~S" expr))))
- (compile-as-evaloid (optimizations)
+ (let ((result (funcall evaloid expr)))
+ (unless (funcall eval-expected-lambda result)
+ (error "failed assertoid ~S" expr))))
+ (compile-as-evaloid (optimizations)