member-if-not.lsp 3.59 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Mar 28 07:39:29 1998
;;;; Contains: Tests of MEMBER-IF-NOT

Daniel Kochmański's avatar
Daniel Kochmański committed
6

7

8

9

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

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

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

(deftest member-if-not.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
    (not (every
sds's avatar
sds committed
30 31 32 33 34 35 36
          #'(lambda (x)
              (let ((result (catch-type-error (member-if-not #'listp x))))
                (or (eqt result 'type-error)
                    (progn
                      (format t "~%On x = ~S, returns: ~%~S" x result)
                      nil))))
          test-inputs)))
37 38 39 40 41 42 43 44 45 46 47 48
  nil)

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

;;; Order of evaluation tests

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

(deftest member-if-not.order.2
  (let ((i 0) x y z w)
    (values
     (member-if-not (progn (setf x (incf i))
sds's avatar
sds committed
59 60 61 62 63 64
                           #'not)
                    (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))

65 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
     i x y z w))
  (a b nil c d) 4 1 2 3 4)

;;; Keyword tests

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

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

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

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

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

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

;;; Error tests

(deftest member-if-not.error.1
pfdietz's avatar
pfdietz committed
98 99
  (check-type-error #'(lambda (x) (member-if-not #'identity x)) #'listp)
  nil)
sds's avatar
sds committed
100

101
(deftest member-if-not.error.2
102 103
  (signals-error (member-if-not) program-error)
  t)
sds's avatar
sds committed
104

105
(deftest member-if-not.error.3
106 107
  (signals-error (member-if-not #'null) program-error)
  t)
sds's avatar
sds committed
108

109
(deftest member-if-not.error.4
110 111
  (signals-error (member-if-not #'null '(a b c) :bad t) program-error)
  t)
sds's avatar
sds committed
112

113
(deftest member-if-not.error.5
114
  (signals-error (member-if-not #'null '(a b c) :bad t :allow-other-keys nil)
sds's avatar
sds committed
115
                 program-error)
116
  t)
sds's avatar
sds committed
117

118
(deftest member-if-not.error.6
119 120
  (signals-error (member-if-not #'null '(a b c) :key) program-error)
  t)
sds's avatar
sds committed
121

122
(deftest member-if-not.error.7
123 124
  (signals-error (member-if-not #'null '(a b c) 1 2) program-error)
  t)
125 126

(deftest member-if-not.error.8
127
  (signals-error (locally (member-if-not #'identity 'a) t)
sds's avatar
sds committed
128
                 type-error)
129
  t)
130 131

(deftest member-if-not.error.9
132 133
  (signals-error (member-if-not #'cons '(a b c)) program-error)
  t)
134 135

(deftest member-if-not.error.10
136
  (signals-error (member-if-not #'identity '(a b c) :key #'cons)
sds's avatar
sds committed
137
                 program-error)
138
  t)