Mercurial > hg > xemacs-beta
diff tests/automated/lisp-tests.el @ 5420:b9167d522a9a
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 |
line wrap: on
line diff
--- a/tests/automated/lisp-tests.el Wed Oct 27 23:36:14 2010 +0200 +++ b/tests/automated/lisp-tests.el Thu Oct 28 23:53:24 2010 +0200 @@ -198,6 +198,14 @@ (Assert (equal y '(0 1 2 3))) (Assert (equal z y))) +(let* ((x (list* 0 1 2 3 4 5 6.0 ?7 ?8 (vector 'a 'b 'c))) + (y (butlast x 0)) + (z (nbutlast x 0))) + (Assert (eq z x)) + (Assert (not (eq y x))) + (Assert (equal y '(0 1 2 3 4 5 6.0 ?7 ?8))) + (Assert (equal z y))) + (Assert (eq (butlast '(x)) nil)) (Assert (eq (nbutlast '(x)) nil)) (Assert (eq (butlast '()) nil)) @@ -217,6 +225,58 @@ (Assert (and (equal x y) (not (eq x y)))))) ;;----------------------------------------------------- +;; Test `ldiff' +;;----------------------------------------------------- +(Check-Error wrong-type-argument (ldiff 'foo pi)) +(Check-Error wrong-number-of-arguments (ldiff)) +(Check-Error wrong-number-of-arguments (ldiff '(1 2))) +(Check-Error circular-list (ldiff (make-circular-list 1) nil)) +(Check-Error circular-list (ldiff (make-circular-list 2000) nil)) +(Assert (eq '() (ldiff '() pi))) +(dolist (x '((1) (1 2) (1 2 3) (1 2 . 3))) + (let ((y (ldiff x nil))) + (Assert (and (equal x y) (not (eq x y)))))) + +(let* ((vector (vector 'foo)) + (dotted `(1 2 3 ,pi 40 50 . ,vector)) + (dotted-pi `(1 2 3 . ,pi)) + without-vector without-pi) + (Assert (equal dotted (ldiff dotted nil)) + "checking ldiff handles dotted lists properly") + (Assert (equal (butlast dotted 0) (ldiff dotted vector)) + "checking ldiff discards dotted elements correctly") + (Assert (equal (butlast dotted-pi 0) (ldiff dotted-pi (* 4 (atan 1)))) + "checking ldiff handles float equivalence correctly")) + +;;----------------------------------------------------- +;; Test `tailp' +;;----------------------------------------------------- +(Check-Error wrong-type-argument (tailp pi 'foo)) +(Check-Error wrong-number-of-arguments (tailp)) +(Check-Error wrong-number-of-arguments (tailp '(1 2))) +(Check-Error circular-list (tailp nil (make-circular-list 1))) +(Check-Error circular-list (tailp nil (make-circular-list 2000))) +(Assert (null (tailp pi '())) + "checking pi is not a tail of the list nil") +(Assert (tailp 3 '(1 2 . 3)) + "checking #'tailp works with a dotted integer.") +(Assert (tailp pi `(1 2 . ,(* 4 (atan 1)))) + "checking tailp works with non-eq dotted floats.") +(let ((list (make-list 2048 nil))) + (Assert (tailp (nthcdr 2000 list) (nconc list list)) + "checking #'tailp succeeds with circular LIST containing SUBLIST")) + +;;----------------------------------------------------- +;; Test `endp' +;;----------------------------------------------------- +(Check-Error wrong-type-argument (endp 'foo)) +(Check-Error wrong-number-of-arguments (endp)) +(Check-Error wrong-number-of-arguments (endp '(1 2) 'foo)) +(Assert (endp nil) "checking nil is recognized as the end of a list") +(Assert (not (endp (list 200 200 4 0 9))) + "checking a cons is not recognised as the end of a list") + +;;----------------------------------------------------- ;; Arithmetic operations ;;----------------------------------------------------- @@ -1263,8 +1323,11 @@ ;;----------------------------------------------------- (Assert (string= (format "%d" 10) "10")) (Assert (string= (format "%o" 8) "10")) +(Assert (string= (format "%b" 2) "10")) (Assert (string= (format "%x" 31) "1f")) (Assert (string= (format "%X" 31) "1F")) +(Assert (string= (format "%b" 0) "0")) +(Assert (string= (format "%b" 3) "11")) ;; MS-Windows uses +002 in its floating-point numbers. #### We should ;; perhaps fix this, but writing our own floating-point support in doprnt.c ;; is very hard. @@ -2407,4 +2470,10 @@ (Assert (not (eql '1/5 (read (prin1-to-string (intern "2/10"))))) "checking symbol named \"2/10\" not eql to ratio 1/5 on read")) +(let* ((count 0) + (list (map-into (make-list 2048 nil) #'(lambda () (decf count)))) + (expected (append list '(1)))) + (Assert (equal expected (merge 'list list '(1) #'<)) + "checking merge's circularity checks are sane")) + ;;; end of lisp-tests.el