mapl.lsp 3.17 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Apr 20 07:23:23 2003
;;;; Contains: Tests of MAPL

(in-package :cl-test)

8 9
(compile-and-load "cons-aux.lsp")

10 11 12 13 14 15
(deftest mapl.1
  (mapl #'list nil)
  nil)

(deftest mapl.2
  (let* ((a nil)
sds's avatar
sds committed
16 17 18 19 20
         (x (copy-list '(a b c)))
         (xcopy (make-scaffold-copy x))
         (result
          (mapl #'(lambda (y) (push y a))
                x)))
21 22 23 24 25 26 27 28
    (and
     (check-scaffold-copy x xcopy)
     (eqt result x)
     a))
  ((c) (b c) (a b c)))

(deftest mapl.3
  (let* ((a nil)
sds's avatar
sds committed
29 30 31 32 33 34 35 36 37 38
         (x (copy-list '(a b c d)))
         (y (copy-list '(1 2 3 4)))
         (xcopy (make-scaffold-copy x))
         (ycopy (make-scaffold-copy y))
         (result
          (mapl #'(lambda (xtail ytail)
                    (setf a
                          (append (mapcar #'list xtail ytail)
                                  a)))
                x y)))
39 40 41 42 43 44 45 46 47 48
    (and
     (eqt result x)
     (check-scaffold-copy x xcopy)
     (check-scaffold-copy y ycopy)
     a))
  ((d 4) (c 3) (d 4) (b 2) (c 3) (d 4)
   (a 1) (b 2) (c 3) (d 4)))

(deftest mapl.4
  (let* ((a nil)
sds's avatar
sds committed
49 50 51 52 53 54 55 56 57 58
         (x (copy-list '(a b c d)))
         (y (copy-list '(1 2 3 4 5 6 7 8)))
         (xcopy (make-scaffold-copy x))
         (ycopy (make-scaffold-copy y))
         (result
          (mapl #'(lambda (xtail ytail)
                    (setf a
                          (append (mapcar #'list xtail ytail)
                                  a)))
                x y)))
59 60 61 62 63 64 65 66 67 68
    (and
     (eqt result x)
     (check-scaffold-copy x xcopy)
     (check-scaffold-copy y ycopy)
     a))
  ((d 4) (c 3) (d 4) (b 2) (c 3) (d 4)
   (a 1) (b 2) (c 3) (d 4)))

(deftest mapl.5
  (let* ((a nil)
sds's avatar
sds committed
69 70 71 72 73 74 75 76 77 78
         (x (copy-list '(a b c d e f g)))
         (y (copy-list '(1 2 3 4)))
         (xcopy (make-scaffold-copy x))
         (ycopy (make-scaffold-copy y))
         (result
          (mapl #'(lambda (xtail ytail)
                    (setf a
                          (append (mapcar #'list xtail ytail)
                                  a)))
                x y)))
79 80 81 82 83 84 85 86 87 88 89 90
    (and
     (eqt result x)
     (check-scaffold-copy x xcopy)
     (check-scaffold-copy y ycopy)
     a))
  ((d 4) (c 3) (d 4) (b 2) (c 3) (d 4)
   (a 1) (b 2) (c 3) (d 4)))

(deftest mapl.order.1
  (let ((i 0) x y z)
    (values
     (mapl (progn
sds's avatar
sds committed
91 92 93 94 95 96 97 98
             (setf x (incf i))
             (constantly nil))
           (progn
             (setf y (incf i))
             '(a b c))
           (progn
             (setf z (incf i))
             '(1 2 3)))
99 100 101 102
     i x y z))
  (a b c) 3 1 2 3)

(deftest mapl.error.1
pfdietz's avatar
pfdietz committed
103 104
  (check-type-error #'(lambda (x) (mapl #'identity x)) #'sequencep)
  nil)
105 106

(deftest mapl.error.2
107 108
  (signals-error (mapl) program-error)
  t)
109 110

(deftest mapl.error.3
111 112
  (signals-error (mapl #'append) program-error)
  t)
113 114

(deftest mapl.error.4
115 116
  (signals-error (locally (mapl #'identity 1) t) type-error)
  t)
117 118

(deftest mapl.error.5
119 120
  (signals-error (mapl #'cons '(a b c)) program-error)
  t)
121 122

(deftest mapl.error.6
123 124
  (signals-error (mapl #'cons '(a b c) '(1 2 3) '(4 5 6)) program-error)
  t)
125 126

(deftest mapl.error.7
127 128
  (signals-error (mapl #'caar '(a b c)) type-error)
  t)
129 130

(deftest mapl.error.8
131 132 133
  (signals-error (mapl #'identity (list* (list 1) (list 2) 3)) type-error)
  t)