Mercurial > hg > xemacs-beta

comparison tests/automated/lisp-tests.el @ 5864:750fab17b299

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits. src/ChangeLog addition: 2015-02-25 Aidan Kehoe <kehoea@parhasard.net> * lread.c (read_atom): Use the new calling convention for parse_integer(). * lisp.h: Change the declaration of parse_integer (). * number.h (bignum_set_emacs_int, make_bignum_emacs_uint): New #defines, used in data.c. * lread.c (read_integer): Ditto. * lread.c (read1): Ditto. * data.c (find_highest_value): New. * data.c (fill_ichar_array): New. * data.c (build_fixnum_to_char_map): New. * data.c (Fset_digit_fixnum_map): New. * data.c (Fdigit_char_p): Moved from cl-extra.el. * data.c (Fdigit_char): Moved from cl-extra.el. * data.c (parse_integer): Moved from lread.c. * data.c (Fparse_integer): Made available to Lisp. * data.c (syms_of_data): Make the new subrs available. * data.c (vars_of_data): Make the new vars available. Expose parse_integer to Lisp, make it follow the Common Lisp API (with some extensions, to allow us to support non ASCII digit characters). lisp/ChangeLog addition: 2015-02-25 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (digit-char-p): Moved to data.c. * cl-extra.el (digit-char): Moved to data.c. tests/ChangeLog addition: 2015-02-25 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: parse_integer(), used in #'read, now signals invalid-argument rather than invalid-read-syntax, check for that. * automated/lisp-tests.el: Check #'parse-integer now it's available to Lisp, check #'digit-char, #'digit-char-p and the congruence in behaviour, check the XEmacs-specific RADIX-TABLE argument behaviour.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 25 Feb 2015 11:47:12 +0000
parents cd4f5f1f1f4c
children a45722e74335
comparison
equal deleted inserted replaced
5844:83e5c3cd6be6 5864:750fab17b299
1471 ;;; For bignum XEmacsen, we make %u with a negative value throw an error. 1471 ;;; For bignum XEmacsen, we make %u with a negative value throw an error.
1472 (if (featurep 'bignum) 1472 (if (featurep 'bignum)
1473 (progn 1473 (progn
1474 (Check-Error wrong-type-argument (format "%u" most-negative-fixnum)) 1474 (Check-Error wrong-type-argument (format "%u" most-negative-fixnum))
1475 (Check-Error wrong-type-argument (format "%u" -1))) 1475 (Check-Error wrong-type-argument (format "%u" -1)))
1476 (Check-Error invalid-read-syntax (read (format "%u" most-negative-fixnum))) 1476 (Check-Error invalid-argument (read (format "%u" most-negative-fixnum)))
1477 (Check-Error invalid-read-syntax (read (format "%u" -1)))) 1477 (Check-Error invalid-argument (read (format "%u" -1))))
1478 1478
1479 ;; Check all-completions ignore element start with space. 1479 ;; Check all-completions ignore element start with space.
1480 (Assert (not (all-completions "" '((" hidden" . "object"))))) 1480 (Assert (not (all-completions "" '((" hidden" . "object")))))
1481 (Assert (all-completions " " '((" hidden" . "object")))) 1481 (Assert (all-completions " " '((" hidden" . "object"))))
1482 1482
3449 (kill-buffer marker-buffer))))))) 3449 (kill-buffer marker-buffer)))))))
3450 (test-write-string write-sequence :sequences-too t) 3450 (test-write-string write-sequence :sequences-too t)
3451 (test-write-string write-string :sequences-too nil) 3451 (test-write-string write-string :sequences-too nil)
3452 (test-write-string write-line :worry-about-newline t :sequences-too nil)) 3452 (test-write-string write-line :worry-about-newline t :sequences-too nil))
3453 3453
3454 ;;-----------------------------------------------------
3455 ;; Test #'parse-integer and friends.
3456 ;;-----------------------------------------------------
3457
3458 (Check-Error wrong-type-argument (parse-integer 123456789))
3459 (Check-Error wrong-type-argument (parse-integer "123456789" :start -1))
3460 (if (featurep 'bignum)
3461 (progn
3462 (Check-Error args-out-of-range
3463 (parse-integer "123456789" :start (1+ most-positive-fixnum)))
3464 (Check-Error args-out-of-range
3465 (parse-integer "123456789" :end (1+ most-positive-fixnum))))
3466 (Check-Error wrong-type-argument
3467 (parse-integer "123456789" :start (1+ most-positive-fixnum)))
3468 (Check-Error wrong-type-argument
3469 (parse-integer "123456789" :end (1+ most-positive-fixnum))))
3470
3471 (Check-Error args-out-of-range (parse-integer "123456789" :radix -1))
3472 (Check-Error args-out-of-range
3473 (parse-integer "123456789" :radix (1+ most-positive-fixnum)))
3474 (Check-Error wrong-number-of-arguments
3475 (parse-integer "123456789" :junk-allowed))
3476 (Check-Error invalid-keyword-argument
3477 (parse-integer "123456789" :no-such-keyword t))
3478
3479 ;; Next two paragraphs of tests from GNU, thank you Leo Liu.
3480 (Assert (eql (digit-char-p ?3) 3))
3481 (Assert (eql (digit-char-p ?a 11) 10))
3482 (Assert (eql (digit-char-p ?w 36) 32))
3483 (Assert (not (digit-char-p ?a)))
3484 (Check-Error args-out-of-range (digit-char-p ?a 37))
3485 (Assert (not (digit-char-p ?a 1)))
3486
3487 (Assert (equal (multiple-value-list (parse-integer " -123 ")) '(-123 7)))
3488 (Assert (equal (multiple-value-list
3489 (parse-integer "-efz" :radix 16 :junk-allowed t))
3490 '(-239 3)))
3491 (Assert (equal (multiple-value-list (parse-integer "zzef" :radix 16 :start 2))
3492 '(239 4)))
3493 (Assert (equal (multiple-value-list
3494 (parse-integer "0123456789" :radix 8 :junk-allowed t))
3495 '(342391 8)))
3496 (Assert (equal (multiple-value-list (parse-integer "" :junk-allowed t))
3497 '(nil 0)))
3498 (Assert (equal (multiple-value-list (parse-integer "abc" :junk-allowed t))
3499 '(nil 0)))
3500 (Check-Error invalid-argument (parse-integer "0123456789" :radix 8))
3501 (Check-Error invalid-argument (parse-integer "abc"))
3502 (Check-Error invalid-argument (parse-integer "efz" :radix 16))
3503
3504 ;; We don't allow a trailing decimal point, as the Lisp reader does.
3505 (Check-Error invalid-argument (parse-integer "12348."))
3506
3507 ;; In contravention of Common Lisp, we allow both 0 and 1 as values for RADIX,
3508 ;; useless as that is.
3509 (Assert (equal (multiple-value-list (parse-integer "00000" :radix 1)) '(0 5))
3510 "checking 1 is allowed as a value for RADIX")
3511 (Assert (equal (multiple-value-list
3512 (parse-integer "" :radix 0 :junk-allowed t))
3513 '(nil 0))
3514 "checking 0 is allowed as a value for RADIX")
3515
3516 (let ((binary-table
3517 (copy-char-table #s(char-table :type generic :default -1 :data ()))))
3518 (loop for fixnum from 00 to #xff
3519 do (put-char-table (int-char fixnum) fixnum binary-table))
3520 (Assert (eql most-positive-fixnum
3521 (parse-integer
3522 (concatenate 'string "\x3f"
3523 (make-string
3524 (/ (- (integer-length most-positive-fixnum)
3525 (integer-length #x3f)) 8)
3526 ?\xff))
3527 :radix-table binary-table :radix #x100))
3528 "checking parsing text using base 256 (big endian binary) works")
3529 (Assert (equal
3530 (multiple-value-list
3531 (parse-integer " \1\7\1\7 " :radix-table binary-table))
3532 '(1717 6))
3533 "checking whitespace treated as such when it is not < radix")
3534 (Assert (equal
3535 (multiple-value-list
3536 (parse-integer " \1\7\1\7 " :radix-table binary-table
3537 :junk-allowed t))
3538 '(1717 5))
3539 "checking whitespace treated as junk when it is not < radix")
3540 (Check-Error invalid-argument
3541 (parse-integer "1234" :radix-table binary-table))
3542 (Assert (equal
3543 (multiple-value-list
3544 (parse-integer "--" :radix-table binary-table :radix #x100))
3545 '(-45 2))
3546 "checking ?- always treated as minus sign initially")
3547 (Assert (equal
3548 (multiple-value-list
3549 (parse-integer "+20" :radix-table binary-table :radix #x100))
3550 '(2830896 3))
3551 "checking ?+ not dropped initially if it has integer weight")
3552 (Assert (eql #xff (digit-char-p ?ÿ #x100 binary-table))
3553 "checking `digit-char-p' behaves correctly with base 256")
3554 (Assert (eql ?\xff (digit-char #xff #x100 binary-table))
3555 "checking `digit-char' behaves correctly with base 256")
3556 (Assert (eql (parse-integer " " :radix-table binary-table :radix #x100)
3557 #x20)
3558 "checking whitespace not treated as such when it has fixnum weight")
3559 (Assert (null (digit-char-p ?0 nil binary-table))
3560 "checking `digit-char-p' reflects RADIX-TABLE, ?0")
3561 (Assert (null (digit-char-p ?9 nil binary-table))
3562 "checking `digit-char-p' reflects RADIX-TABLE, ?9")
3563 (Assert (null (digit-char-p ?a 16 binary-table))
3564 "checking `digit-char-p' reflects RADIX-TABLE, ?a")
3565 (Assert (eql ?ÿ (digit-char #xff #x100 binary-table))
3566 "checking `digit-char' reflects RADIX-TABLE, #xff")
3567 (Assert (eql ?a (digit-char #x61 #x100 binary-table))
3568 "checking `digit-char' reflects RADIX-TABLE, #x61")
3569 (Assert (null (digit-char #xff nil binary-table))
3570 "checking `digit-char' reflects RADIX-TABLE, #xff, base 10")
3571 (Assert (eql ?\x0a (digit-char 10 16 binary-table))
3572 "checking `digit-char' reflects RADIX-TABLE, 10, base 16")
3573 (Assert (eql ?\x09 (digit-char 9 nil binary-table))
3574 "checking `digit-char' reflects RADIX-TABLE, 9, base 10"))
3575
3454 ;;; end of lisp-tests.el 3576 ;;; end of lisp-tests.el