Mercurial > hg > xemacs-beta
comparison tests/automated/lisp-tests.el @ 5432:46491edfd94a
Merge with trunk.
| author | Mats Lidell <matsl@xemacs.org> |
|---|---|
| date | Sun, 07 Nov 2010 00:22:33 +0100 |
| parents | b9167d522a9a 9f738305f80f |
| children | 8d29f1c4bb98 |
comparison
equal
deleted
inserted
replaced
| 5431:5cddeeeb25bb | 5432:46491edfd94a |
|---|---|
| 1035 (Assert (eql | 1035 (Assert (eql |
| 1036 (length (multiple-value-list | 1036 (length (multiple-value-list |
| 1037 (car (mapcar #'(lambda (argument) (floor argument)) (list pi e))))) | 1037 (car (mapcar #'(lambda (argument) (floor argument)) (list pi e))))) |
| 1038 1) | 1038 1) |
| 1039 "checking multiple values are correctly discarded in mapcar") | 1039 "checking multiple values are correctly discarded in mapcar") |
| 1040 | |
| 1041 (let ((malformed-list '(1 2 3 4 hi there . tail))) | |
| 1042 (Check-Error malformed-list (mapcar #'identity malformed-list)) | |
| 1043 (Check-Error malformed-list (map nil #'eq [1 2 3 4] | |
| 1044 malformed-list)) | |
| 1045 (Check-Error malformed-list (list-length malformed-list))) | |
| 1040 | 1046 |
| 1041 ;;----------------------------------------------------- | 1047 ;;----------------------------------------------------- |
| 1042 ;; Test vector functions | 1048 ;; Test vector functions |
| 1043 ;;----------------------------------------------------- | 1049 ;;----------------------------------------------------- |
| 1044 (Assert (equal [1 2 3] [1 2 3])) | 1050 (Assert (equal [1 2 3] [1 2 3])) |
| 2474 (list (map-into (make-list 2048 nil) #'(lambda () (decf count)))) | 2480 (list (map-into (make-list 2048 nil) #'(lambda () (decf count)))) |
| 2475 (expected (append list '(1)))) | 2481 (expected (append list '(1)))) |
| 2476 (Assert (equal expected (merge 'list list '(1) #'<)) | 2482 (Assert (equal expected (merge 'list list '(1) #'<)) |
| 2477 "checking merge's circularity checks are sane")) | 2483 "checking merge's circularity checks are sane")) |
| 2478 | 2484 |
| 2485 (flet ((list-nreverse (list) | |
| 2486 (do ((list1 list (cdr list1)) | |
| 2487 (list2 nil (prog1 list1 (setcdr list1 list2)))) | |
| 2488 ((atom list1) list2)))) | |
| 2489 (let* ((integers (loop for i from 0 to 6000 collect i)) | |
| 2490 (characters (mapcan #'(lambda (integer) | |
| 2491 (if (char-int-p integer) | |
| 2492 (list (int-char integer)))) integers)) | |
| 2493 (fourth-bit #'(lambda (integer) (ash (logand #x10 integer) -4))) | |
| 2494 (bits (mapcar fourth-bit integers)) | |
| 2495 (vector (vconcat integers)) | |
| 2496 (string (concat characters)) | |
| 2497 (bit-vector (bvconcat bits))) | |
| 2498 (Assert (equal (reverse vector) | |
| 2499 (vconcat (list-nreverse (copy-list integers))))) | |
| 2500 (Assert (eq vector (nreverse vector))) | |
| 2501 (Assert (equal vector (vconcat (list-nreverse (copy-list integers))))) | |
| 2502 (Assert (equal (reverse string) | |
| 2503 (concat (list-nreverse (copy-list characters))))) | |
| 2504 (Assert (eq string (nreverse string))) | |
| 2505 (Assert (equal string (concat (list-nreverse (copy-list characters))))) | |
| 2506 (Assert (eq bit-vector (nreverse bit-vector))) | |
| 2507 (Assert (equal (bvconcat (list-nreverse (copy-list bits))) bit-vector)) | |
| 2508 (Assert (not (equal bit-vector | |
| 2509 (mapcar fourth-bit | |
| 2510 (loop for i from 0 to 6000 collect i))))))) | |
| 2511 | |
| 2479 ;;; end of lisp-tests.el | 2512 ;;; end of lisp-tests.el |