Mercurial > hg > xemacs-beta

comparison tests/automated/lisp-tests.el @ 5420:b9167d522a9a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Rebase with 21.5 trunk.
author Mats Lidell <matsl@xemacs.org>
date Thu, 28 Oct 2010 23:53:24 +0200
parents 308d34e9f07d 2474dce7304e
children 46491edfd94a
comparison
equal deleted inserted replaced
5419:eaf01113cd42 5420:b9167d522a9a
196 (Assert (eq z x)) 196 (Assert (eq z x))
197 (Assert (not (eq y x))) 197 (Assert (not (eq y x)))
198 (Assert (equal y '(0 1 2 3))) 198 (Assert (equal y '(0 1 2 3)))
199 (Assert (equal z y))) 199 (Assert (equal z y)))
200 200
201 (let* ((x (list* 0 1 2 3 4 5 6.0 ?7 ?8 (vector 'a 'b 'c)))
202 (y (butlast x 0))
203 (z (nbutlast x 0)))
204 (Assert (eq z x))
205 (Assert (not (eq y x)))
206 (Assert (equal y '(0 1 2 3 4 5 6.0 ?7 ?8)))
207 (Assert (equal z y)))
208
201 (Assert (eq (butlast '(x)) nil)) 209 (Assert (eq (butlast '(x)) nil))
202 (Assert (eq (nbutlast '(x)) nil)) 210 (Assert (eq (nbutlast '(x)) nil))
203 (Assert (eq (butlast '()) nil)) 211 (Assert (eq (butlast '()) nil))
204 (Assert (eq (nbutlast '()) nil)) 212 (Assert (eq (nbutlast '()) nil))
205 213
213 (Check-Error circular-list (copy-list (make-circular-list 2000))) 221 (Check-Error circular-list (copy-list (make-circular-list 2000)))
214 (Assert (eq '() (copy-list '()))) 222 (Assert (eq '() (copy-list '())))
215 (dolist (x '((1) (1 2) (1 2 3) (1 2 . 3))) 223 (dolist (x '((1) (1 2) (1 2 3) (1 2 . 3)))
216 (let ((y (copy-list x))) 224 (let ((y (copy-list x)))
217 (Assert (and (equal x y) (not (eq x y)))))) 225 (Assert (and (equal x y) (not (eq x y))))))
226
227 ;;-----------------------------------------------------
228 ;; Test `ldiff'
229 ;;-----------------------------------------------------
230 (Check-Error wrong-type-argument (ldiff 'foo pi))
231 (Check-Error wrong-number-of-arguments (ldiff))
232 (Check-Error wrong-number-of-arguments (ldiff '(1 2)))
233 (Check-Error circular-list (ldiff (make-circular-list 1) nil))
234 (Check-Error circular-list (ldiff (make-circular-list 2000) nil))
235 (Assert (eq '() (ldiff '() pi)))
236 (dolist (x '((1) (1 2) (1 2 3) (1 2 . 3)))
237 (let ((y (ldiff x nil)))
238 (Assert (and (equal x y) (not (eq x y))))))
239
240 (let* ((vector (vector 'foo))
241 (dotted `(1 2 3 ,pi 40 50 . ,vector))
242 (dotted-pi `(1 2 3 . ,pi))
243 without-vector without-pi)
244 (Assert (equal dotted (ldiff dotted nil))
245 "checking ldiff handles dotted lists properly")
246 (Assert (equal (butlast dotted 0) (ldiff dotted vector))
247 "checking ldiff discards dotted elements correctly")
248 (Assert (equal (butlast dotted-pi 0) (ldiff dotted-pi (* 4 (atan 1))))
249 "checking ldiff handles float equivalence correctly"))
250
251 ;;-----------------------------------------------------
252 ;; Test `tailp'
253 ;;-----------------------------------------------------
254 (Check-Error wrong-type-argument (tailp pi 'foo))
255 (Check-Error wrong-number-of-arguments (tailp))
256 (Check-Error wrong-number-of-arguments (tailp '(1 2)))
257 (Check-Error circular-list (tailp nil (make-circular-list 1)))
258 (Check-Error circular-list (tailp nil (make-circular-list 2000)))
259 (Assert (null (tailp pi '()))
260 "checking pi is not a tail of the list nil")
261 (Assert (tailp 3 '(1 2 . 3))
262 "checking #'tailp works with a dotted integer.")
263 (Assert (tailp pi `(1 2 . ,(* 4 (atan 1))))
264 "checking tailp works with non-eq dotted floats.")
265 (let ((list (make-list 2048 nil)))
266 (Assert (tailp (nthcdr 2000 list) (nconc list list))
267 "checking #'tailp succeeds with circular LIST containing SUBLIST"))
268
269 ;;-----------------------------------------------------
270 ;; Test `endp'
271 ;;-----------------------------------------------------
272 (Check-Error wrong-type-argument (endp 'foo))
273 (Check-Error wrong-number-of-arguments (endp))
274 (Check-Error wrong-number-of-arguments (endp '(1 2) 'foo))
275 (Assert (endp nil) "checking nil is recognized as the end of a list")
276 (Assert (not (endp (list 200 200 4 0 9)))
277 "checking a cons is not recognised as the end of a list")
218 278
219 ;;----------------------------------------------------- 279 ;;-----------------------------------------------------
220 ;; Arithmetic operations 280 ;; Arithmetic operations
221 ;;----------------------------------------------------- 281 ;;-----------------------------------------------------
222 282
1261 ;;----------------------------------------------------- 1321 ;;-----------------------------------------------------
1262 ;; format test 1322 ;; format test
1263 ;;----------------------------------------------------- 1323 ;;-----------------------------------------------------
1264 (Assert (string= (format "%d" 10) "10")) 1324 (Assert (string= (format "%d" 10) "10"))
1265 (Assert (string= (format "%o" 8) "10")) 1325 (Assert (string= (format "%o" 8) "10"))
1326 (Assert (string= (format "%b" 2) "10"))
1266 (Assert (string= (format "%x" 31) "1f")) 1327 (Assert (string= (format "%x" 31) "1f"))
1267 (Assert (string= (format "%X" 31) "1F")) 1328 (Assert (string= (format "%X" 31) "1F"))
1329 (Assert (string= (format "%b" 0) "0"))
1330 (Assert (string= (format "%b" 3) "11"))
1268 ;; MS-Windows uses +002 in its floating-point numbers. #### We should 1331 ;; MS-Windows uses +002 in its floating-point numbers. #### We should
1269 ;; perhaps fix this, but writing our own floating-point support in doprnt.c 1332 ;; perhaps fix this, but writing our own floating-point support in doprnt.c
1270 ;; is very hard. 1333 ;; is very hard.
1271 (Assert (or (string= (format "%e" 100) "1.000000e+02") 1334 (Assert (or (string= (format "%e" 100) "1.000000e+02")
1272 (string= (format "%e" 100) "1.000000e+002"))) 1335 (string= (format "%e" 100) "1.000000e+002")))
2405 (Assert (not (eql '1/2 (read (prin1-to-string (intern "1/2"))))) 2468 (Assert (not (eql '1/2 (read (prin1-to-string (intern "1/2")))))
2406 "checking symbols with ratio-like names are printed distinctly") 2469 "checking symbols with ratio-like names are printed distinctly")
2407 (Assert (not (eql '1/5 (read (prin1-to-string (intern "2/10"))))) 2470 (Assert (not (eql '1/5 (read (prin1-to-string (intern "2/10")))))
2408 "checking symbol named \"2/10\" not eql to ratio 1/5 on read")) 2471 "checking symbol named \"2/10\" not eql to ratio 1/5 on read"))
2409 2472
2473 (let* ((count 0)
2474 (list (map-into (make-list 2048 nil) #'(lambda () (decf count))))
2475 (expected (append list '(1))))
2476 (Assert (equal expected (merge 'list list '(1) #'<))
2477 "checking merge's circularity checks are sane"))
2478
2410 ;;; end of lisp-tests.el 2479 ;;; end of lisp-tests.el