cons-test-14.lsp 6.59 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Mar 28 07:39:29 1998
;;;; Contains: Testing of CL Features related to "CONS", part 14

(in-package :cl-test)
(use-package :rt)
(declaim (optimize (safety 3)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; member-if

13
(deftest member-if.1
14 15 16
  (member-if #'listp nil)
  nil)

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

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

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

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

47 48
;;; Order of argument tests

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

59
(deftest member-if.order.2
60 61 62 63 64 65 66 67 68 69 70 71 72
  (let ((i 0) x y z w)
    (values
     (member-if (progn (setf x (incf i))
		       #'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))
			    
     i x y z w))
  (a b nil c d) 4 1 2 3 4)


73 74 75
;;; Keyword tests

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

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

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

87 88 89 90 91 92 93 94
(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))

95
(deftest member-if.allow-other-keys.6
96 97 98 99
  (member-if #'identity '(nil 2 3 4 5) :allow-other-keys t
	     :allow-other-keys nil)
  (2 3 4 5))

100
(deftest member-if.allow-other-keys.7
101 102 103
  (member-if #'identity '(nil 2 3 4 5) :allow-other-keys t
	     :allow-other-keys nil :key #'identity :key #'null)
  (2 3 4 5))
104 105 106 107

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; member-if-not

108
(deftest member-if-not.1
109 110 111
  (member-if-not #'listp nil)
  nil)

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

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

120
(deftest member-if-not.4
121 122 123 124 125 126 127 128 129
  (let ((test-inputs
	 `(1 a 11.3121 11.31s3 1.123f5 -1 0
	     13.13122d34 581.131e-10
	     ((a) (b) (c) . d)
	     ,(make-array '(10))
	     "ancadas"  #\w)))
    (not (every
	  #'(lambda (x)
	      (let ((result (catch-type-error (member-if-not #'listp x))))
130
		(or (eqt result 'type-error)
131 132 133 134 135
		    (progn
		      (format t "~%On x = ~S, returns: ~%~S" x result)
		      nil))))
	  test-inputs)))
  nil)
136

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

141 142
;;; Order of evaluation tests

143
(deftest member-if-not.order.1
144 145 146 147 148 149 150 151 152
  (let ((i 0) x y)
    (values
     (member-if-not (progn (setf x (incf i))
			   #'not)
		    (progn (setf y (incf i))
			   '(nil nil a b nil c d)))
     i x y))
  (a b nil c d) 2 1 2)

153
(deftest member-if-not.order.2
154 155 156 157 158 159 160 161 162 163 164 165
  (let ((i 0) x y z w)
    (values
     (member-if-not (progn (setf x (incf i))
			   #'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))
			    
     i x y z w))
  (a b nil c d) 4 1 2 3 4)

166 167 168
;;; Keyword tests

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

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

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

180 181 182 183 184 185 186 187 188 189 190 191 192 193
(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
		 :allow-other-keys nil :key #'identity :key #'null)
  (2 3 4 5))


194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
;;; Error cases

(deftest member-if.error.1
  (classify-error (member-if #'identity 'a))
  type-error)
  
(deftest member-if.error.2
  (classify-error (member-if))
  program-error)
  
(deftest member-if.error.3
  (classify-error (member-if #'null))
  program-error)
  
(deftest member-if.error.4
  (classify-error (member-if #'null '(a b c) :bad t))
  program-error)
  
(deftest member-if.error.5
  (classify-error (member-if #'null '(a b c) :bad t :allow-other-keys nil))
  program-error)
  
(deftest member-if.error.6
  (classify-error (member-if #'null '(a b c) :key))
  program-error)
  
(deftest member-if.error.7
  (classify-error (member-if #'null '(a b c) 1 2))
  program-error)

224 225 226 227
(deftest member-if.error.8
  (classify-error (locally (member-if #'identity 'a) t))
  type-error)

228 229 230 231 232 233 234 235
(deftest member-if.error.9
  (classify-error (member-if #'cons '(a b c)))
  program-error)

(deftest member-if.error.10
  (classify-error (member-if #'identity '(a b c) :key #'cons))
  program-error)

236

237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263
(deftest member-if-not.error.1
  (classify-error (member-if-not #'identity 'a))
  type-error)
  
(deftest member-if-not.error.2
  (classify-error (member-if-not))
  program-error)
  
(deftest member-if-not.error.3
  (classify-error (member-if-not #'null))
  program-error)
  
(deftest member-if-not.error.4
  (classify-error (member-if-not #'null '(a b c) :bad t))
  program-error)
  
(deftest member-if-not.error.5
  (classify-error (member-if-not #'null '(a b c) :bad t :allow-other-keys nil))
  program-error)
  
(deftest member-if-not.error.6
  (classify-error (member-if-not #'null '(a b c) :key))
  program-error)
  
(deftest member-if-not.error.7
  (classify-error (member-if-not #'null '(a b c) 1 2))
  program-error)
264 265 266 267

(deftest member-if-not.error.8
  (classify-error (locally (member-if-not #'identity 'a) t))
  type-error)
268 269 270 271 272 273 274 275

(deftest member-if-not.error.9
  (classify-error (member-if-not #'cons '(a b c)))
  program-error)

(deftest member-if-not.error.10
  (classify-error (member-if-not #'identity '(a b c) :key #'cons))
  program-error)