Mercurial > hg > xemacs-beta

comparison tests/automated/lisp-tests.el @ 5438:8d29f1c4bb98

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge with 21.5 trunk.
author Mats Lidell <matsl@xemacs.org>
date Fri, 26 Nov 2010 06:43:36 +0100
parents 46491edfd94a c096d8051f89
children 6506fcb40fcf
comparison
equal deleted inserted replaced
5437:002cb5224e4f 5438:8d29f1c4bb98
208 208
209 (Assert (eq (butlast '(x)) nil)) 209 (Assert (eq (butlast '(x)) nil))
210 (Assert (eq (nbutlast '(x)) nil)) 210 (Assert (eq (nbutlast '(x)) nil))
211 (Assert (eq (butlast '()) nil)) 211 (Assert (eq (butlast '()) nil))
212 (Assert (eq (nbutlast '()) nil)) 212 (Assert (eq (nbutlast '()) nil))
213
214 (when (featurep 'bignum)
215 (let* ((x (list* 0 1 2 3 4 5 6.0 ?7 ?8 (vector 'a 'b 'c)))
216 (y (butlast x (* 2 most-positive-fixnum)))
217 (z (nbutlast x (* 3 most-positive-fixnum))))
218 (Assert (eq nil y) "checking butlast with a large bignum gives nil")
219 (Assert (eq nil z) "checking nbutlast with a large bignum gives nil")
220 (Check-Error wrong-type-argument
221 (nbutlast x (1- most-negative-fixnum))
222 "checking nbutlast with a negative bignum errors")))
213 223
214 ;;----------------------------------------------------- 224 ;;-----------------------------------------------------
215 ;; Test `copy-list' 225 ;; Test `copy-list'
216 ;;----------------------------------------------------- 226 ;;-----------------------------------------------------
217 (Check-Error wrong-type-argument (copy-list 'foo)) 227 (Check-Error wrong-type-argument (copy-list 'foo))
2507 (Assert (equal (bvconcat (list-nreverse (copy-list bits))) bit-vector)) 2517 (Assert (equal (bvconcat (list-nreverse (copy-list bits))) bit-vector))
2508 (Assert (not (equal bit-vector 2518 (Assert (not (equal bit-vector
2509 (mapcar fourth-bit 2519 (mapcar fourth-bit
2510 (loop for i from 0 to 6000 collect i))))))) 2520 (loop for i from 0 to 6000 collect i)))))))
2511 2521
2522 (Check-Error wrong-type-argument (self-insert-command 'self-insert-command))
2523 (Check-Error wrong-type-argument (make-list 'make-list 'make-list))
2524 (Check-Error wrong-type-argument (make-vector 'make-vector 'make-vector))
2525 (Check-Error wrong-type-argument (make-bit-vector 'make-bit-vector
2526 'make-bit-vector))
2527 (Check-Error wrong-type-argument (make-byte-code '(&rest ignore) "\xc0\x87" [4]
2528 'ignore))
2529 (Check-Error wrong-type-argument (make-string ?a ?a))
2530 (Check-Error wrong-type-argument (nth-value 'nth-value (truncate pi e)))
2531 (Check-Error wrong-type-argument (make-hash-table :test #'eql :size :size))
2532 (Check-Error wrong-type-argument
2533 (accept-process-output nil 'accept-process-output))
2534 (Check-Error wrong-type-argument
2535 (accept-process-output nil 2000 'accept-process-output))
2536 (Check-Error wrong-type-argument
2537 (self-insert-command 'self-insert-command))
2538 (Check-Error wrong-type-argument (string-to-number "16" 'string-to-number))
2539 (Check-Error wrong-type-argument (move-to-column 'move-to-column))
2540 (stop-profiling)
2541 (Check-Error wrong-type-argument (start-profiling (float most-positive-fixnum)))
2542 (stop-profiling)
2543 (Check-Error wrong-type-argument
2544 (fill '(1 2 3 4 5) 1 :start (float most-positive-fixnum)))
2545 (Check-Error wrong-type-argument
2546 (fill [1 2 3 4 5] 1 :start (float most-positive-fixnum)))
2547 (Check-Error wrong-type-argument
2548 (fill "1 2 3 4 5" ?1 :start (float most-positive-fixnum)))
2549 (Check-Error wrong-type-argument
2550 (fill #*10101010 1 :start (float most-positive-fixnum))
2551 (Check-Error wrong-type-argument
2552 (fill '(1 2 3 4 5) 1 :end (float most-positive-fixnum)))
2553 (Check-Error wrong-type-argument
2554 (fill [1 2 3 4 5] 1 :end (float most-positive-fixnum)))
2555 (Check-Error wrong-type-argument
2556 (fill "1 2 3 4 5" ?1 :end (float most-positive-fixnum)))
2557 (Check-Error wrong-type-argument
2558 (fill #*10101010 1 :end (float most-positive-fixnum)))
2559 (Check-Error wrong-type-argument
2560 (reduce #'cons '(1 2 3 4 5) :start (float most-positive-fixnum)))
2561 (Check-Error wrong-type-argument
2562 (reduce #'cons [1 2 3 4 5] :start (float most-positive-fixnum)))
2563 (Check-Error wrong-type-argument
2564 (reduce #'cons "1 2 3 4 5" :start (float most-positive-fixnum)))
2565 (Check-Error wrong-type-argument
2566 (reduce #'cons #*10101010 :start (float most-positive-fixnum)))
2567 (Check-Error wrong-type-argument
2568 (reduce #'cons '(1 2 3 4 5) :end (float most-positive-fixnum)))
2569 (Check-Error wrong-type-argument
2570 (reduce #'cons [1 2 3 4 5] :end (float most-positive-fixnum)))
2571 (Check-Error wrong-type-argument
2572 (reduce #'cons "1 2 3 4 5" :end (float most-positive-fixnum)))
2573 (Check-Error wrong-type-argument
2574 (reduce #'cons #*10101010 :end (float most-positive-fixnum)))
2575
2576 (when (featurep 'bignum)
2577 (Check-Error args-out-of-range
2578 (self-insert-command (* 2 most-positive-fixnum)))
2579 (Check-Error args-out-of-range
2580 (make-list (* 3 most-positive-fixnum) 'make-list))
2581 (Check-Error args-out-of-range
2582 (make-vector (* 4 most-positive-fixnum) 'make-vector))
2583 (Check-Error args-out-of-range
2584 (make-bit-vector (+ 2 most-positive-fixnum) 'make-bit-vector))
2585 (Check-Error args-out-of-range
2586 (make-byte-code '(&rest ignore) "\xc0\x87" [4]
2587 (1+ most-positive-fixnum)))
2588 (Check-Error args-out-of-range
2589 (make-byte-code '(&rest ignore) "\xc0\x87" [4]
2590 #x10000))
2591 (Check-Error args-out-of-range
2592 (make-string (* 4 most-positive-fixnum) ?a))
2593 (Check-Error args-out-of-range
2594 (nth-value most-positive-fixnum (truncate pi e)))
2595 (Check-Error args-out-of-range
2596 (make-hash-table :test #'equalp :size (1+ most-positive-fixnum)))
2597 (Check-Error args-out-of-range
2598 (accept-process-output nil 4294967))
2599 (Check-Error args-out-of-range
2600 (accept-process-output nil 10 (1+ most-positive-fixnum)))
2601 (Check-Error args-out-of-range
2602 (self-insert-command (1+ most-positive-fixnum)))
2603 (Check-Error args-out-of-range
2604 (string-to-number "16" (1+ most-positive-fixnum)))
2605 (Check-Error args-out-of-range
2606 (recent-keys (1+ most-positive-fixnum)))
2607 (when (featurep 'xbm)
2608 (Check-Error-Message
2609 invalid-argument
2610 "^data is too short for width and height"
2611 (set-face-background-pixmap
2612 'left-margin
2613 `[xbm :data (20 ,(* 2 most-positive-fixnum) "random-text")])))
2614 (Check-Error args-out-of-range
2615 (move-to-column (1+ most-positive-fixnum)))
2616 (Check-Error args-out-of-range
2617 (move-to-column (1- most-negative-fixnum)))
2618 (stop-profiling)
2619 (when (< most-positive-fixnum (lsh 1 32))
2620 ;; We only support machines with integers of 32 bits or more. If
2621 ;; most-positive-fixnum is less than 2^32, we're on a 32-bit machine,
2622 ;; and it's appropriate to test start-profiling with a bignum.
2623 (Assert (eq nil (start-profiling (* most-positive-fixnum 2)))))
2624 (stop-profiling)
2625 (Check-Error args-out-of-range
2626 (fill '(1 2 3 4 5) 1 :start (1+ most-positive-fixnum)))
2627 (Check-Error args-out-of-range
2628 (fill [1 2 3 4 5] 1 :start (1+ most-positive-fixnum)))
2629 (Check-Error args-out-of-range
2630 (fill "1 2 3 4 5" ?1 :start (1+ most-positive-fixnum)))
2631 (Check-Error args-out-of-range
2632 (fill #*10101010 1 :start (1+ most-positive-fixnum)))
2633 (Check-Error args-out-of-range
2634 (fill '(1 2 3 4 5) 1 :end (1+ most-positive-fixnum)))
2635 (Check-Error args-out-of-range
2636 (fill [1 2 3 4 5] 1 :end (1+ most-positive-fixnum)))
2637 (Check-Error args-out-of-range
2638 (fill "1 2 3 4 5" ?1 :end (1+ most-positive-fixnum)))
2639 (Check-Error args-out-of-range
2640 (fill #*10101010 1 :end (1+ most-positive-fixnum)))
2641 (Check-Error args-out-of-range
2642 (reduce #'cons '(1 2 3 4 5) :start (1+ most-positive-fixnum)))
2643 (Check-Error args-out-of-range
2644 (reduce #'cons [1 2 3 4 5] :start (1+ most-positive-fixnum)))
2645 (Check-Error args-out-of-range
2646 (reduce #'cons "1 2 3 4 5" :start (1+ most-positive-fixnum)))
2647 (Check-Error args-out-of-range
2648 (reduce #'cons #*10101010 :start (1+ most-positive-fixnum)))
2649 (Check-Error args-out-of-range
2650 (reduce #'cons '(1 2 3 4 5) :end (1+ most-positive-fixnum)))
2651 (Check-Error args-out-of-range
2652 (reduce #'cons [1 2 3 4 5] :end (1+ most-positive-fixnum)))
2653 (Check-Error args-out-of-range
2654 (reduce #'cons "1 2 3 4 5" :end (1+ most-positive-fixnum)))
2655 (Check-Error args-out-of-range
2656 (reduce #'cons #*10101010 :end (1+ most-positive-fixnum)))
2657 (Check-Error args-out-of-range
2658 (replace '(1 2 3 4 5) [5 4 3 2 1]
2659 :start1 (1+ most-positive-fixnum)))
2660 (Check-Error args-out-of-range
2661 (replace '(1 2 3 4 5) [5 4 3 2 1]
2662 :start2 (1+ most-positive-fixnum)))
2663 (Check-Error args-out-of-range
2664 (replace '(1 2 3 4 5) [5 4 3 2 1]
2665 :end1 (1+ most-positive-fixnum)))
2666 (Check-Error args-out-of-range
2667 (replace '(1 2 3 4 5) [5 4 3 2 1]
2668 :end2 (1+ most-positive-fixnum))))
2669
2512 ;;; end of lisp-tests.el 2670 ;;; end of lisp-tests.el