member-if.lsp 3.48 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 19 22:51:56 2003
;;;; Contains: Tests of MEMBER-IF

6

7

8

9

10 11 12 13 14 15 16 17 18 19 20 21 22 23
(deftest member-if.1
  (member-if #'listp nil)
  nil)

(deftest member-if.2
  (member-if #'(lambda (x) (eqt x 'a)) '(1 2 a 3 4))
  (a 3 4))

(deftest member-if.3
  (member-if #'(lambda (x) (eql x 12)) '(4 12 11 73 11) :key #'1+)
  (11 73 11))

(deftest member-if.4
  (let ((test-inputs
sds's avatar
sds committed
24 25 26 27 28
         `(1 a 11.3121 11.31s3 1.123f5 -1 0
             13.13122d34 581.131e-10
             (a b c . d)
             ,(make-array '(10))
             "ancadas"  #\w)))
29 30 31
    (notnot-mv
     (every
      #'(lambda (x)
sds's avatar
sds committed
32 33 34 35 36
          (let ((result (catch-type-error (member-if #'listp x))))
            (or (eqt result 'type-error)
                (progn
                  (format t "~%On ~S: returned ~%~S" x result)
                  nil))))
37 38 39 40 41 42 43 44 45 46 47 48 49
      test-inputs)))
  t)

(deftest member-if.5
  (member-if #'identity '(1 2 3 4 5) :key #'evenp)
  (2 3 4 5))

;;; Order of argument tests

(deftest member-if.order.1
  (let ((i 0) x y)
    (values
     (member-if (progn (setf x (incf i))
sds's avatar
sds committed
50 51 52
                       #'identity)
                (progn (setf y (incf i))
                       '(nil nil a b nil c d)))
53 54 55 56 57 58 59
     i x y))
  (a b nil c d) 2 1 2)

(deftest member-if.order.2
  (let ((i 0) x y z w)
    (values
     (member-if (progn (setf x (incf i))
sds's avatar
sds committed
60 61 62 63 64 65
                       #'identity)
                (progn (setf y (incf i))
                       '(nil nil a b nil c d))
                :key (progn (setf z (incf i)) #'identity)
                :key (progn (setf w (incf i)) #'not))

66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
     i x y z w))
  (a b nil c d) 4 1 2 3 4)

;;; Keyword tests

(deftest member-if.keywords.1
  (member-if #'identity '(1 2 3 4 5) :key #'evenp :key #'oddp)
  (2 3 4 5))

(deftest member-if.allow-other-keys.2
  (member-if #'identity '(nil 2 3 4 5) :allow-other-keys t :bad t)
  (2 3 4 5))

(deftest member-if.allow-other-keys.3
  (member-if #'identity '(nil 2 3 4 5) :bad t :allow-other-keys t)
  (2 3 4 5))

(deftest member-if.allow-other-keys.4
  (member-if #'identity '(nil 2 3 4 5) :allow-other-keys t)
  (2 3 4 5))

(deftest member-if.allow-other-keys.5
  (member-if #'identity '(nil 2 3 4 5) :allow-other-keys nil)
  (2 3 4 5))

(deftest member-if.allow-other-keys.6
  (member-if #'identity '(nil 2 3 4 5) :allow-other-keys t
sds's avatar
sds committed
93
             :allow-other-keys nil)
94 95 96 97
  (2 3 4 5))

(deftest member-if.allow-other-keys.7
  (member-if #'identity '(nil 2 3 4 5) :allow-other-keys t
sds's avatar
sds committed
98
             :allow-other-keys nil :key #'identity :key #'null)
99 100 101 102 103
  (2 3 4 5))

;;; Error cases

(deftest member-if.error.1
pfdietz's avatar
pfdietz committed
104 105
  (check-type-error #'(lambda (x) (member-if #'identity x)) #'listp)
  nil)
sds's avatar
sds committed
106

107
(deftest member-if.error.2
108 109
  (signals-error (member-if) program-error)
  t)
sds's avatar
sds committed
110

111
(deftest member-if.error.3
112 113
  (signals-error (member-if #'null) program-error)
  t)
sds's avatar
sds committed
114

115
(deftest member-if.error.4
116 117
  (signals-error (member-if #'null '(a b c) :bad t) program-error)
  t)
sds's avatar
sds committed
118

119
(deftest member-if.error.5
120
  (signals-error (member-if #'null '(a b c) :bad t :allow-other-keys nil)
sds's avatar
sds committed
121
                 program-error)
122
  t)
sds's avatar
sds committed
123

124
(deftest member-if.error.6
125 126
  (signals-error (member-if #'null '(a b c) :key) program-error)
  t)
sds's avatar
sds committed
127

128
(deftest member-if.error.7
129 130
  (signals-error (member-if #'null '(a b c) 1 2) program-error)
  t)
131 132

(deftest member-if.error.8
133 134
  (signals-error (locally (member-if #'identity 'a) t) type-error)
  t)
135 136

(deftest member-if.error.9
137 138
  (signals-error (member-if #'cons '(a b c)) program-error)
  t)
139 140

(deftest member-if.error.10
141 142
  (signals-error (member-if #'identity '(a b c) :key #'cons) program-error)
  t)