X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fmap-tests.impure.lisp;h=ee984dd3468d8c25eda7f3665fd3b6f736e01552;hb=260de2062fca170efdac3e42491d7d866c2d2e56;hp=efd4ca3981029f275cdc47c385e0052e823b07d5;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/tests/map-tests.impure.lisp b/tests/map-tests.impure.lisp index efd4ca3..ee984dd 100644 --- a/tests/map-tests.impure.lisp +++ b/tests/map-tests.impure.lisp @@ -11,15 +11,81 @@ ;;;; absolutely no warranty. See the COPYING and CREDITS files for ;;;; more information. +(load "test-util.lisp") (load "assertoid.lisp") (use-package "ASSERTOID") ;;; tests of MAP ;;; FIXME: Move these into their own file. -(assertoid (map 'vector #'+ '(1 2 3) '(30 20)) - :expected-equalp #(31 22)) -(assertoid (map 'list #'+ #(1 2) '(100) #(0) #(100 100)) - :expected-equal '(201)) +(test-util:with-test (:name :map) + (assertoid (map 'vector #'+ '(1 2 3) '(30 20)) + :expected-equalp #(31 22)) + (assertoid (map 'list #'+ #(1 2) '(100) #(0) #(100 100)) + :expected-equal '(201))) + +;;; tests of MAP-INTO + +(test-util:with-test (:name :map-into) + (assertoid (map-into (vector) #'+ '(1 2 3) '(30 20)) + :expected-equalp #()) + (assertoid (map-into (vector 99) #'+ '(1 2 3) '(30 20)) + :expected-equalp #(31)) + (assertoid (map-into (vector 99 88) #'+ '(1 2 3) '(30 20)) + :expected-equalp #(31 22)) + (assertoid (map-into (vector 99 88 77) #'+ '(1 2 3) '(30 20)) + :expected-equalp #(31 22 77)) + + (assertoid (map-into (list) #'+ '(1 2 3) '(30 20)) + :expected-equalp '()) + (assertoid (map-into (list 99) #'+ '(1 2 3) '(30 20)) + :expected-equalp '(31)) + (assertoid (map-into (list 99 88) #'+ '(1 2 3) '(30 20)) + :expected-equalp '(31 22)) + (assertoid (map-into (list 99 88 77) #'+ '(1 2 3) '(30 20)) + :expected-equalp '(31 22 77)) + + (assertoid (map-into (vector 99 99 99) (constantly 5)) + :expected-equalp #(5 5 5)) + (assertoid (map-into (vector 99 99 99) (let ((x 0)) (lambda () (incf x)))) + :expected-equalp #(1 2 3)) + + (assertoid (map-into (list 99 99 99) (constantly 5)) + :expected-equalp '(5 5 5)) + (assertoid (map-into (list 99 99 99) (let ((x 0)) (lambda () (incf x)))) + :expected-equalp '(1 2 3)) + + (assertoid (map-into (make-array 0 :element-type 'fixnum) + #'+ '(1 2 3) '(30 20)) + :expected-equalp #()) + (assertoid (map-into (make-array 1 :element-type 'fixnum :initial-element 99) + #'+ '(1 2 3) '(30 20)) + :expected-equalp #(31)) + (assertoid (map-into (make-array 2 :element-type 'fixnum :initial-element 99) + #'+ '(1 2 3) '(30 20)) + :expected-equalp #(31 22)) + (assertoid (map-into (make-array 3 :element-type 'fixnum :initial-element 99) + #'+ '(1 2 3) '(30 20)) + :expected-equalp #(31 22 99)) + + (assertoid (map-into (make-array 0 :fill-pointer 0 :initial-element 99) + #'+ '(1 2 3) '(30 20)) + :expected-equalp #()) + (assertoid (map-into (make-array 1 :fill-pointer 0 :initial-element 99) + #'+ '(1 2 3) '(30 20)) + :expected-equalp #(31)) + (assertoid (map-into (make-array 2 :fill-pointer 0 :initial-element 99) + #'+ '(1 2 3) '(30 20)) + :expected-equalp #(31 22)) + (assertoid (map-into (make-array 3 :fill-pointer 0 :initial-element 99) + #'+ '(1 2 3) '(30 20)) + :expected-equalp #(31 22)) + + (assertoid (map-into (make-array 9 :fill-pointer 9 :initial-element 99) + #'+ '(1 2 3) '(30 20)) + :expected-equalp #(31 22)) + (assertoid (map-into (make-array 9 :fill-pointer 5 :initial-element 99) + #'+ '(1 2 3) '(30 20)) + :expected-equalp #(31 22))) (defmacro with-mapnil-test-fun (fun-name &body body) `(let ((reversed-result nil)) @@ -27,15 +93,17 @@ (push rest reversed-result))) ,@body (nreverse reversed-result)))) -(assertoid (with-mapnil-test-fun fun - (map nil #'fun #(1))) - :expected-equal '((1))) -(assertoid (with-mapnil-test-fun fun - (map nil #'fun #() '(1 2 3))) - :expected-equal '()) -(assertoid (with-mapnil-test-fun fun - (map nil #'fun #(a b c) '(alpha beta) '(aleph beth))) - :expected-equal '((a alpha aleph) (b beta beth))) + +(test-util:with-test (:name :map-nil) + (assertoid (with-mapnil-test-fun fun + (map nil #'fun #(1))) + :expected-equal '((1))) + (assertoid (with-mapnil-test-fun fun + (map nil #'fun #() '(1 2 3))) + :expected-equal '()) + (assertoid (with-mapnil-test-fun fun + (map nil #'fun #(a b c) '(alpha beta) '(aleph beth))) + :expected-equal '((a alpha aleph) (b beta beth)))) ;;; Exercise MAP repeatedly on the same dataset by providing various ;;; combinations of sequence type arguments, declarations, and so @@ -82,7 +150,11 @@ (arrange `(assertoid (map ',result-type ,fun ,@(args-with-type-decls)) :expected-equalp (coerce ,result-seq - ',result-type))))) + ',result-type)))) + (arrange + `(assertoid (map-into (fill (copy-seq ,result-seq) 9999) + ,fun ,@(args-with-type-decls)) + :expected-equalp ,result-seq))) (arrange `(assertoid (mapcar (lambda (args) (apply #',fun-name args)) (with-mapnil-test-fun mtf @@ -95,18 +167,24 @@ ,@(args-with-type-decls)))) :expected-equal (coerce ,result-seq 'list))))) `(progn ,@(nreverse reversed-assertoids)))) -(maptest :result-seq '(2 3) - :fun-name 1+ - :arg-seqs (*list-2*) - :arg-types (list)) -(maptest :result-seq '(nil nil nil) - :fun-name oddp - :arg-seqs (*vector-30*) - :arg-types (vector)) -(maptest :result-seq '(12 24) - :fun-name + - :arg-seqs (*list-2* *list-2* *vector-30*) - :arg-types (list list vector)) + +(test-util:with-test (:name :maptest) + (maptest :result-seq '(2 3) + :fun-name 1+ + :arg-seqs (*list-2*) + :arg-types (list)) + (maptest :result-seq '(nil nil nil) + :fun-name oddp + :arg-seqs (*vector-30*) + :arg-types (vector)) + (maptest :result-seq '(12 24) + :fun-name + + :arg-seqs (*list-2* *list-2* *vector-30*) + :arg-types (list list vector))) + +(test-util:with-test (:name :map-into-vector-from-list) + (map-into (eval (make-array 10)) + #'list + (make-list 10))) ;;; success -(quit :unix-status 104)