Mercurial > hg > xemacs-beta

comparison tests/automated/lisp-tests.el @ 5307:c096d8051f89

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Have NATNUMP give t for positive bignums; check limits appropriately. src/ChangeLog addition: 2010-11-20 Aidan Kehoe <kehoea@parhasard.net> * abbrev.c (Fexpand_abbrev): * alloc.c: * alloc.c (Fmake_list): * alloc.c (Fmake_vector): * alloc.c (Fmake_bit_vector): * alloc.c (Fmake_byte_code): * alloc.c (Fmake_string): * alloc.c (vars_of_alloc): * bytecode.c (UNUSED): * bytecode.c (Fbyte_code): * chartab.c (decode_char_table_range): * cmds.c (Fself_insert_command): * data.c (check_integer_range): * data.c (Fnatnump): * data.c (Fnonnegativep): * data.c (Fstring_to_number): * elhash.c (hash_table_size_validate): * elhash.c (decode_hash_table_size): * eval.c (Fbacktrace_frame): * event-stream.c (lisp_number_to_milliseconds): * event-stream.c (Faccept_process_output): * event-stream.c (Frecent_keys): * event-stream.c (Fdispatch_event): * events.c (Fmake_event): * events.c (Fevent_timestamp): * events.c (Fevent_timestamp_lessp): * events.h: * events.h (struct command_builder): * file-coding.c (gzip_putprop): * fns.c: * fns.c (check_sequence_range): * fns.c (Frandom): * fns.c (Fnthcdr): * fns.c (Flast): * fns.c (Fnbutlast): * fns.c (Fbutlast): * fns.c (Fmember): * fns.c (Ffill): * fns.c (Freduce): * fns.c (replace_string_range_1): * fns.c (Freplace): * font-mgr.c (Ffc_pattern_get): * frame-msw.c (msprinter_set_frame_properties): * glyphs.c (check_valid_xbm_inline): * indent.c (Fmove_to_column): * intl-win32.c (mswindows_multibyte_to_unicode_putprop): * lisp.h: * lisp.h (ARRAY_DIMENSION_LIMIT): * lread.c (decode_mode_1): * mule-ccl.c (ccl_get_compiled_code): * number.h: * process-unix.c (unix_open_multicast_group): * process.c (Fset_process_window_size): * profile.c (Fstart_profiling): * unicode.c (Funicode_to_char): Change NATNUMP to return 1 for positive bignums; changes uses of it and of CHECK_NATNUM appropriately, usually by checking for an integer in an appropriate range. Add array-dimension-limit and use it in #'make-vector, #'make-string. Add array-total-size-limit, array-rank-limit while we're at it, for the sake of any Common Lisp-oriented code that uses these limits. Rename check_int_range to check_integer_range, have it take Lisp_Objects (and thus bignums) instead. Remove bignum_butlast(), just set int_n to an appropriately large integer if N is a bignum. Accept bignums in check_sequence_range(), change the functions that use check_sequence_range() appropriately. Move the definition of NATNUMP() to number.h; document why it's a reasonable name, contradicting an old comment. tests/ChangeLog addition: 2010-11-20 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: * automated/lisp-tests.el (featurep): * automated/lisp-tests.el (wrong-type-argument): * automated/mule-tests.el (featurep): Check for args-out-of-range errors instead of wrong-type-argument errors in various places when code is handed a large bignum instead of a fixnum. Also check for the wrong-type-argument errors when giving the same code a non-integer value.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 20 Nov 2010 16:49:11 +0000
parents 9f738305f80f
children f87bb35a6b94 8d29f1c4bb98
comparison
equal deleted inserted replaced
5306:cde1608596d0 5307:c096d8051f89
210 210
211 (Assert (eq (butlast '(x)) nil)) 211 (Assert (eq (butlast '(x)) nil))
212 (Assert (eq (nbutlast '(x)) nil)) 212 (Assert (eq (nbutlast '(x)) nil))
213 (Assert (eq (butlast '()) nil)) 213 (Assert (eq (butlast '()) nil))
214 (Assert (eq (nbutlast '()) nil)) 214 (Assert (eq (nbutlast '()) nil))
215
216 (when (featurep 'bignum)
217 (let* ((x (list* 0 1 2 3 4 5 6.0 ?7 ?8 (vector 'a 'b 'c)))
218 (y (butlast x (* 2 most-positive-fixnum)))
219 (z (nbutlast x (* 3 most-positive-fixnum))))
220 (Assert (eq nil y) "checking butlast with a large bignum gives nil")
221 (Assert (eq nil z) "checking nbutlast with a large bignum gives nil")
222 (Check-Error wrong-type-argument
223 (nbutlast x (1- most-negative-fixnum))
224 "checking nbutlast with a negative bignum errors")))
215 225
216 ;;----------------------------------------------------- 226 ;;-----------------------------------------------------
217 ;; Test `copy-list' 227 ;; Test `copy-list'
218 ;;----------------------------------------------------- 228 ;;-----------------------------------------------------
219 (Check-Error wrong-type-argument (copy-list 'foo)) 229 (Check-Error wrong-type-argument (copy-list 'foo))
2509 (Assert (equal (bvconcat (list-nreverse (copy-list bits))) bit-vector)) 2519 (Assert (equal (bvconcat (list-nreverse (copy-list bits))) bit-vector))
2510 (Assert (not (equal bit-vector 2520 (Assert (not (equal bit-vector
2511 (mapcar fourth-bit 2521 (mapcar fourth-bit
2512 (loop for i from 0 to 6000 collect i))))))) 2522 (loop for i from 0 to 6000 collect i)))))))
2513 2523
2524 (Check-Error wrong-type-argument (self-insert-command 'self-insert-command))
2525 (Check-Error wrong-type-argument (make-list 'make-list 'make-list))
2526 (Check-Error wrong-type-argument (make-vector 'make-vector 'make-vector))
2527 (Check-Error wrong-type-argument (make-bit-vector 'make-bit-vector
2528 'make-bit-vector))
2529 (Check-Error wrong-type-argument (make-byte-code '(&rest ignore) "\xc0\x87" [4]
2530 'ignore))
2531 (Check-Error wrong-type-argument (make-string ?a ?a))
2532 (Check-Error wrong-type-argument (nth-value 'nth-value (truncate pi e)))
2533 (Check-Error wrong-type-argument (make-hash-table :test #'eql :size :size))
2534 (Check-Error wrong-type-argument
2535 (accept-process-output nil 'accept-process-output))
2536 (Check-Error wrong-type-argument
2537 (accept-process-output nil 2000 'accept-process-output))
2538 (Check-Error wrong-type-argument
2539 (self-insert-command 'self-insert-command))
2540 (Check-Error wrong-type-argument (string-to-number "16" 'string-to-number))
2541 (Check-Error wrong-type-argument (move-to-column 'move-to-column))
2542 (stop-profiling)
2543 (Check-Error wrong-type-argument (start-profiling (float most-positive-fixnum)))
2544 (stop-profiling)
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 "1 2 3 4 5" ?1 :start (float most-positive-fixnum)))
2551 (Check-Error wrong-type-argument
2552 (fill #*10101010 1 :start (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 "1 2 3 4 5" ?1 :end (float most-positive-fixnum)))
2559 (Check-Error wrong-type-argument
2560 (fill #*10101010 1 :end (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 "1 2 3 4 5" :start (float most-positive-fixnum)))
2567 (Check-Error wrong-type-argument
2568 (reduce #'cons #*10101010 :start (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 "1 2 3 4 5" :end (float most-positive-fixnum)))
2575 (Check-Error wrong-type-argument
2576 (reduce #'cons #*10101010 :end (float most-positive-fixnum)))
2577
2578 (when (featurep 'bignum)
2579 (Check-Error args-out-of-range
2580 (self-insert-command (* 2 most-positive-fixnum)))
2581 (Check-Error args-out-of-range
2582 (make-list (* 3 most-positive-fixnum) 'make-list))
2583 (Check-Error args-out-of-range
2584 (make-vector (* 4 most-positive-fixnum) 'make-vector))
2585 (Check-Error args-out-of-range
2586 (make-bit-vector (+ 2 most-positive-fixnum) 'make-bit-vector))
2587 (Check-Error args-out-of-range
2588 (make-byte-code '(&rest ignore) "\xc0\x87" [4]
2589 (1+ most-positive-fixnum)))
2590 (Check-Error args-out-of-range
2591 (make-byte-code '(&rest ignore) "\xc0\x87" [4]
2592 #x10000))
2593 (Check-Error args-out-of-range
2594 (make-string (* 4 most-positive-fixnum) ?a))
2595 (Check-Error args-out-of-range
2596 (nth-value most-positive-fixnum (truncate pi e)))
2597 (Check-Error args-out-of-range
2598 (make-hash-table :test #'equalp :size (1+ most-positive-fixnum)))
2599 (Check-Error args-out-of-range
2600 (accept-process-output nil 4294967))
2601 (Check-Error args-out-of-range
2602 (accept-process-output nil 10 (1+ most-positive-fixnum)))
2603 (Check-Error args-out-of-range
2604 (self-insert-command (1+ most-positive-fixnum)))
2605 (Check-Error args-out-of-range
2606 (string-to-number "16" (1+ most-positive-fixnum)))
2607 (Check-Error args-out-of-range
2608 (recent-keys (1+ most-positive-fixnum)))
2609 (when (featurep 'xbm)
2610 (Check-Error-Message
2611 invalid-argument
2612 "^data is too short for width and height"
2613 (set-face-background-pixmap
2614 'left-margin
2615 `[xbm :data (20 ,(* 2 most-positive-fixnum) "random-text")])))
2616 (Check-Error args-out-of-range
2617 (move-to-column (1+ most-positive-fixnum)))
2618 (Check-Error args-out-of-range
2619 (move-to-column (1- most-negative-fixnum)))
2620 (stop-profiling)
2621 (when (< most-positive-fixnum (lsh 1 32))
2622 ;; We only support machines with integers of 32 bits or more. If
2623 ;; most-positive-fixnum is less than 2^32, we're on a 32-bit machine,
2624 ;; and it's appropriate to test start-profiling with a bignum.
2625 (Assert (eq nil (start-profiling (* most-positive-fixnum 2)))))
2626 (stop-profiling)
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 "1 2 3 4 5" ?1 :start (1+ most-positive-fixnum)))
2633 (Check-Error args-out-of-range
2634 (fill #*10101010 1 :start (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 "1 2 3 4 5" ?1 :end (1+ most-positive-fixnum)))
2641 (Check-Error args-out-of-range
2642 (fill #*10101010 1 :end (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 "1 2 3 4 5" :start (1+ most-positive-fixnum)))
2649 (Check-Error args-out-of-range
2650 (reduce #'cons #*10101010 :start (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 "1 2 3 4 5" :end (1+ most-positive-fixnum)))
2657 (Check-Error args-out-of-range
2658 (reduce #'cons #*10101010 :end (1+ most-positive-fixnum)))
2659 (Check-Error args-out-of-range
2660 (replace '(1 2 3 4 5) [5 4 3 2 1]
2661 :start1 (1+ most-positive-fixnum)))
2662 (Check-Error args-out-of-range
2663 (replace '(1 2 3 4 5) [5 4 3 2 1]
2664 :start2 (1+ most-positive-fixnum)))
2665 (Check-Error args-out-of-range
2666 (replace '(1 2 3 4 5) [5 4 3 2 1]
2667 :end1 (1+ most-positive-fixnum)))
2668 (Check-Error args-out-of-range
2669 (replace '(1 2 3 4 5) [5 4 3 2 1]
2670 :end2 (1+ most-positive-fixnum))))
2671
2514 ;;; end of lisp-tests.el 2672 ;;; end of lisp-tests.el