1 (cl:in-package :cl-user)
3 (load "assertoid.lisp")
6 ;;; FIXME: Move these into their own file.
7 (assertoid (map 'vector #'+ '(1 2 3) '(30 20))
8 :expected-equalp #(31 22))
9 (assertoid (map 'list #'+ #(1 2) '(100) #(0) #(100 100))
10 :expected-equal '(201))
12 (defmacro with-mapnil-test-fun (fun-name &body body)
13 `(let ((reversed-result nil))
14 (flet ((,fun-name (&rest rest)
15 (push rest reversed-result)))
17 (nreverse reversed-result))))
18 (assertoid (with-mapnil-test-fun fun
20 :expected-equal '((1)))
21 (assertoid (with-mapnil-test-fun fun
22 (map nil #'fun #() '(1 2 3)))
24 (assertoid (with-mapnil-test-fun fun
25 (map nil #'fun #(a b c) '(alpha beta) '(aleph beth)))
26 :expected-equal '((a alpha aleph) (b beta beth)))
28 ;;; Exercise MAP repeatedly on the same dataset by providing various
29 ;;; combinations of sequence type arguments, declarations, and so
31 (defvar *list-1* '(1))
32 (defvar *list-2* '(1 2))
33 (defvar *list-3* '(1 2 3))
34 (defvar *list-4* '(1 2 3 4))
35 (defvar *vector-10* #(10))
36 (defvar *vector-20* #(10 20))
37 (defvar *vector-30* #(10 20 30))
38 (defmacro maptest (&key
43 (result-element-types '(t)))
44 (let ((reversed-assertoids nil))
45 (dotimes (arg-type-index (expt 2 (length arg-types)))
46 (labels (;; Arrange for EXPR to be executed.
48 (push expr reversed-assertoids))
49 ;; We toggle the various type declarations on and
50 ;; off depending on the bit pattern in ARG-TYPE-INDEX,
51 ;; so that we get lots of different things to test.
53 (if (and (< i (length arg-types))
54 (plusp (logand (expt 2 i)
58 (args-with-type-decls ()
59 (let ((reversed-result nil))
60 (dotimes (i (length arg-seqs) (nreverse reversed-result))
61 (push `(the ,(eff-arg-type i)
64 (dolist (fun `(',fun-name #',fun-name))
65 (dolist (result-type (cons 'list
68 (simple-array ,et 1)))
69 result-element-types)))
71 `(assertoid (map ',result-type ,fun ,@(args-with-type-decls))
72 :expected-equalp (coerce ,result-seq
75 `(assertoid (mapcar (lambda (args) (apply #',fun-name args))
76 (with-mapnil-test-fun mtf
78 ;; (It would be nice to test MAP
79 ;; NIL with function names, too,
80 ;; but I can't see any concise way
83 ,@(args-with-type-decls))))
84 :expected-equal (coerce ,result-seq 'list)))))
85 `(progn ,@(nreverse reversed-assertoids))))
86 (maptest :result-seq '(2 3)
90 (maptest :result-seq '(nil nil nil)
92 :arg-seqs (*vector-30*)
94 (maptest :result-seq '(12 24)
96 :arg-seqs (*list-2* *list-2* *vector-30*)
97 :arg-types (list list vector))
99 (print "returning successfully")
101 ;;(sb-impl::flush-standard-output-streams)
103 (quit :unix-status 104)