- (arrange (expr)
- (push expr reversed-assertoids))
- ;; We toggle the various type declarations on and
- ;; off depending on the bit pattern in ARG-TYPE-INDEX,
- ;; so that we get lots of different things to test.
- (eff-arg-type (i)
- (if (and (< i (length arg-types))
- (plusp (logand (expt 2 i)
- arg-type-index)))
- (nth i arg-types)
- t))
- (args-with-type-decls ()
- (let ((reversed-result nil))
- (dotimes (i (length arg-seqs) (nreverse reversed-result))
- (push `(the ,(eff-arg-type i)
- ,(nth i arg-seqs))
- reversed-result)))))
- (dolist (fun `(',fun-name #',fun-name))
- (dolist (result-type (cons 'list
- (mapcan (lambda (et)
- `((vector ,et)
- (simple-array ,et 1)))
- result-element-types)))
- (arrange
- `(assertoid (map ',result-type ,fun ,@(args-with-type-decls))
- :expected-equalp (coerce ,result-seq
- ',result-type)))))
- (arrange
- `(assertoid (mapcar (lambda (args) (apply #',fun-name args))
- (with-mapnil-test-fun mtf
- (map nil
- ;; (It would be nice to test MAP
- ;; NIL with function names, too,
- ;; but I can't see any concise way
- ;; to do it..)
- #'mtf
- ,@(args-with-type-decls))))
- :expected-equal (coerce ,result-seq 'list)))))
+ (arrange (expr)
+ (push expr reversed-assertoids))
+ ;; We toggle the various type declarations on and
+ ;; off depending on the bit pattern in ARG-TYPE-INDEX,
+ ;; so that we get lots of different things to test.
+ (eff-arg-type (i)
+ (if (and (< i (length arg-types))
+ (plusp (logand (expt 2 i)
+ arg-type-index)))
+ (nth i arg-types)
+ t))
+ (args-with-type-decls ()
+ (let ((reversed-result nil))
+ (dotimes (i (length arg-seqs) (nreverse reversed-result))
+ (push `(the ,(eff-arg-type i)
+ ,(nth i arg-seqs))
+ reversed-result)))))
+ (dolist (fun `(',fun-name #',fun-name))
+ (dolist (result-type (cons 'list
+ (mapcan (lambda (et)
+ `((vector ,et)
+ (simple-array ,et 1)))
+ result-element-types)))
+ (arrange
+ `(assertoid (map ',result-type ,fun ,@(args-with-type-decls))
+ :expected-equalp (coerce ,result-seq
+ ',result-type)))))
+ (arrange
+ `(assertoid (mapcar (lambda (args) (apply #',fun-name args))
+ (with-mapnil-test-fun mtf
+ (map nil
+ ;; (It would be nice to test MAP
+ ;; NIL with function names, too,
+ ;; but I can't see any concise way
+ ;; to do it..)
+ #'mtf
+ ,@(args-with-type-decls))))
+ :expected-equal (coerce ,result-seq 'list)))))