Mercurial > hg > xemacs-beta
comparison tests/automated/lisp-tests.el @ 5285:99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
lisp/ChangeLog addition:
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns):
* cl-macs.el (remf, getf):
* cl-extra.el (tailp, cl-set-getf, cl-do-remf):
* cl.el (ldiff, endp):
Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp;
add circularity checking for the first two.
#'cl-set-getf and #'cl-do-remf were Lisp implementations of
#'plist-put and #'plist-remprop; change the names to aliases,
changes the macros that use them to using #'plist-put and
#'plist-remprop directly.
src/ChangeLog addition:
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* fns.c (Fnbutlast, Fbutlast):
Tighten up Common Lisp compatibility for these two functions; they
need to operate on dotted lists without erroring.
tests/ChangeLog addition:
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el (x):
Test #'nbutlast, #'butlast with dotted lists.
Check that #'ldiff and #'tailp don't hang on circular lists; check
that #'tailp returns t with circular lists when that is
appropriate. Test them both with dotted lists.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Thu, 14 Oct 2010 18:50:38 +0100 |
| parents | be436ac36ba4 |
| children | 2474dce7304e |
comparison
equal
deleted
inserted
replaced
| 5284:d27c1ee1943b | 5285:99de5fd48e87 |
|---|---|
| 198 (Assert (eq z x)) | 198 (Assert (eq z x)) |
| 199 (Assert (not (eq y x))) | 199 (Assert (not (eq y x))) |
| 200 (Assert (equal y '(0 1 2 3))) | 200 (Assert (equal y '(0 1 2 3))) |
| 201 (Assert (equal z y))) | 201 (Assert (equal z y))) |
| 202 | 202 |
| 203 (let* ((x (list* 0 1 2 3 4 5 6.0 ?7 ?8 (vector 'a 'b 'c))) | |
| 204 (y (butlast x 0)) | |
| 205 (z (nbutlast x 0))) | |
| 206 (Assert (eq z x)) | |
| 207 (Assert (not (eq y x))) | |
| 208 (Assert (equal y '(0 1 2 3 4 5 6.0 ?7 ?8))) | |
| 209 (Assert (equal z y))) | |
| 210 | |
| 203 (Assert (eq (butlast '(x)) nil)) | 211 (Assert (eq (butlast '(x)) nil)) |
| 204 (Assert (eq (nbutlast '(x)) nil)) | 212 (Assert (eq (nbutlast '(x)) nil)) |
| 205 (Assert (eq (butlast '()) nil)) | 213 (Assert (eq (butlast '()) nil)) |
| 206 (Assert (eq (nbutlast '()) nil)) | 214 (Assert (eq (nbutlast '()) nil)) |
| 207 | 215 |
| 215 (Check-Error circular-list (copy-list (make-circular-list 2000))) | 223 (Check-Error circular-list (copy-list (make-circular-list 2000))) |
| 216 (Assert (eq '() (copy-list '()))) | 224 (Assert (eq '() (copy-list '()))) |
| 217 (dolist (x '((1) (1 2) (1 2 3) (1 2 . 3))) | 225 (dolist (x '((1) (1 2) (1 2 3) (1 2 . 3))) |
| 218 (let ((y (copy-list x))) | 226 (let ((y (copy-list x))) |
| 219 (Assert (and (equal x y) (not (eq x y)))))) | 227 (Assert (and (equal x y) (not (eq x y)))))) |
| 228 | |
| 229 ;;----------------------------------------------------- | |
| 230 ;; Test `ldiff' | |
| 231 ;;----------------------------------------------------- | |
| 232 (Check-Error wrong-type-argument (ldiff 'foo pi)) | |
| 233 (Check-Error wrong-number-of-arguments (ldiff)) | |
| 234 (Check-Error wrong-number-of-arguments (ldiff '(1 2))) | |
| 235 (Check-Error circular-list (ldiff (make-circular-list 1) nil)) | |
| 236 (Check-Error circular-list (ldiff (make-circular-list 2000) nil)) | |
| 237 (Assert (eq '() (ldiff '() pi))) | |
| 238 (dolist (x '((1) (1 2) (1 2 3) (1 2 . 3))) | |
| 239 (let ((y (ldiff x nil))) | |
| 240 (Assert (and (equal x y) (not (eq x y)))))) | |
| 241 | |
| 242 (let* ((vector (vector 'foo)) | |
| 243 (dotted `(1 2 3 ,pi 40 50 . ,vector)) | |
| 244 (dotted-pi `(1 2 3 . ,pi)) | |
| 245 without-vector without-pi) | |
| 246 (Assert (equal dotted (ldiff dotted nil)) | |
| 247 "checking ldiff handles dotted lists properly") | |
| 248 (Assert (equal (butlast dotted 0) (ldiff dotted vector)) | |
| 249 "checking ldiff discards dotted elements correctly") | |
| 250 (Assert (equal (butlast dotted-pi 0) (ldiff dotted-pi (* 4 (atan 1)))) | |
| 251 "checking ldiff handles float equivalence correctly")) | |
| 252 | |
| 253 ;;----------------------------------------------------- | |
| 254 ;; Test `tailp' | |
| 255 ;;----------------------------------------------------- | |
| 256 (Check-Error wrong-type-argument (tailp pi 'foo)) | |
| 257 (Check-Error wrong-number-of-arguments (tailp)) | |
| 258 (Check-Error wrong-number-of-arguments (tailp '(1 2))) | |
| 259 (Check-Error circular-list (tailp nil (make-circular-list 1))) | |
| 260 (Check-Error circular-list (tailp nil (make-circular-list 2000))) | |
| 261 (Assert (null (tailp pi '())) | |
| 262 "checking pi is not a tail of the list nil") | |
| 263 (Assert (tailp 3 '(1 2 . 3)) | |
| 264 "checking #'tailp works with a dotted integer.") | |
| 265 (Assert (tailp pi `(1 2 . ,(* 4 (atan 1)))) | |
| 266 "checking tailp works with non-eq dotted floats.") | |
| 267 (let ((list (make-list 2048 nil))) | |
| 268 (Assert (tailp (nthcdr 2000 list) (nconc list list)) | |
| 269 "checking #'tailp succeeds with circular LIST containing SUBLIST")) | |
| 270 | |
| 271 ;;----------------------------------------------------- | |
| 272 ;; Test `endp' | |
| 273 ;;----------------------------------------------------- | |
| 274 (Check-Error wrong-type-argument (endp 'foo)) | |
| 275 (Check-Error wrong-number-of-arguments (endp)) | |
| 276 (Check-Error wrong-number-of-arguments (endp '(1 2) 'foo)) | |
| 277 (Assert (endp nil) "checking nil is recognized as the end of a list") | |
| 278 (Assert (not (endp (list 200 200 4 0 9))) | |
| 279 "checking a cons is not recognised as the end of a list") | |
| 220 | 280 |
| 221 ;;----------------------------------------------------- | 281 ;;----------------------------------------------------- |
| 222 ;; Arithmetic operations | 282 ;; Arithmetic operations |
| 223 ;;----------------------------------------------------- | 283 ;;----------------------------------------------------- |
| 224 | 284 |