X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=tests%2Fautomated%2Flisp-tests.el;h=b2b6077858a3d64840530adef390fc419165fb14;hp=134907071427e5d0e1325c230bc601ba15e6d54d;hb=efdb31fd4c8db81d2414c32d491f1bf994263c74;hpb=976b002b16336930724ae22476014583ad022e7d diff --git a/tests/automated/lisp-tests.el b/tests/automated/lisp-tests.el index 1349070..b2b6077 100644 --- a/tests/automated/lisp-tests.el +++ b/tests/automated/lisp-tests.el @@ -229,6 +229,8 @@ (Assert (= (+ 1.0 1) 2.0)) (Assert (= (+ 1.0 1 1) 3.0)) (Assert (= (+ 1 1 1.0) 3.0)) +(Assert (eq (1+ most-positive-fixnum) most-negative-fixnum)) +(Assert (eq (+ most-positive-fixnum 1) most-negative-fixnum)) ;; Test `-' (Check-Error wrong-number-of-arguments (-)) @@ -241,6 +243,8 @@ (Assert (= (- one) -1)) (Assert (= (- one one) 0)) (Assert (= (- one one one) -1)) + (Assert (= (- 0 one) -1)) + (Assert (= (- 0 one one) -2)) (Assert (= (+ one 1) 2)) (dolist (zero '(0 0.0 ?\0)) (Assert (= (+ 1 zero) 1)) @@ -253,6 +257,9 @@ (Assert (= (- 1.5 1) .5)) (Assert (= (- 1 1.5) (- .5))) +(Assert (eq (1- most-negative-fixnum) most-positive-fixnum)) +(Assert (eq (- most-negative-fixnum 1) most-positive-fixnum)) + ;; Test `/' ;; Test division by zero errors @@ -330,6 +337,39 @@ (Assert (= two (max one two two))) (Assert (= two (max two two one))))) +;; The byte compiler has special handling for these constructs: +(let ((three 3) (five 5)) + (Assert (= (+ three five 1) 9)) + (Assert (= (+ 1 three five) 9)) + (Assert (= (+ three five -1) 7)) + (Assert (= (+ -1 three five) 7)) + (Assert (= (+ three 1) 4)) + (Assert (= (+ three -1) 2)) + (Assert (= (+ -1 three) 2)) + (Assert (= (+ -1 three) 2)) + (Assert (= (- three five 1) -3)) + (Assert (= (- 1 three five) -7)) + (Assert (= (- three five -1) -1)) + (Assert (= (- -1 three five) -9)) + (Assert (= (- three 1) 2)) + (Assert (= (- three 2 1) 0)) + (Assert (= (- 2 three 1) -2)) + (Assert (= (- three -1) 4)) + (Assert (= (- three 0) 3)) + (Assert (= (- three 0 five) -2)) + (Assert (= (- 0 three 0 five) -8)) + (Assert (= (- 0 three five) -8)) + (Assert (= (* three 2) 6)) + (Assert (= (* three -1 five) -15)) + (Assert (= (* three 1 five) 15)) + (Assert (= (* three 0 five) 0)) + (Assert (= (* three 2 five) 30)) + (Assert (= (/ three 1) 3)) + (Assert (= (/ three -1) -3)) + (Assert (= (/ (* five five) 2 2) 6)) + (Assert (= (/ 64 five 2) 6))) + + ;;----------------------------------------------------- ;; Logical bit-twiddling operations ;;----------------------------------------------------- @@ -750,6 +790,29 @@ (Assert (equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3")) (Assert (equal (mapconcat #'identity ["1" "2" "3"] "|") "1|2|3")) +;; The following 2 functions used to crash XEmacs via mapcar1(). +;; We don't test the actual values of the mapcar, since they're undefined. +(Assert + (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3)))) + (mapcar + (lambda (y) + "Devious evil mapping function" + (when (eq (car y) 2) ; go out onto a limb + (setcdr x nil) ; cut it off behind us + (garbage-collect)) ; are we riding a magic broomstick? + (car y)) ; sorry, hard landing + x))) + +(Assert + (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3)))) + (mapcar + (lambda (y) + "Devious evil mapping function" + (when (eq (car y) 1) + (setcdr (cdr x) 42)) ; drop a brick wall onto the freeway + (car y)) + x))) + ;;----------------------------------------------------- ;; Test vector functions ;;----------------------------------------------------- @@ -785,3 +848,241 @@ (defun test-emacs-buffer-local-parameter (test-emacs-buffer-local-variable) (setq test-emacs-buffer-local-variable nil))) (test-emacs-buffer-local-parameter nil) + +;;----------------------------------------------------- +;; Test split-string +;;----------------------------------------------------- +;; Hrvoje didn't like these tests so I'm disabling them for now. -sb +;(Assert (equal (split-string "foo" "") '("" "f" "o" "o" ""))) +;(Assert (equal (split-string "foo" "^") '("" "foo"))) +;(Assert (equal (split-string "foo" "$") '("foo" ""))) +(Assert (equal (split-string "foo,bar" ",") '("foo" "bar"))) +(Assert (equal (split-string ",foo,bar," ",") '("" "foo" "bar" ""))) +(Assert (equal (split-string ",foo,bar," "^,") '("" "foo,bar,"))) +(Assert (equal (split-string ",foo,bar," ",$") '(",foo,bar" ""))) +(Assert (equal (split-string ",foo,,bar," ",") '("" "foo" "" "bar" ""))) +(Assert (equal (split-string "foo,,,bar" ",") '("foo" "" "" "bar"))) +(Assert (equal (split-string "foo,,bar,," ",") '("foo" "" "bar" "" ""))) +(Assert (equal (split-string "foo,,bar" ",+") '("foo" "bar"))) +(Assert (equal (split-string ",foo,,bar," ",+") '("" "foo" "bar" ""))) + +(Assert (not (string-match "\\(\\.\\=\\)" "."))) +(Assert (string= "" (let ((str "test string")) + (if (string-match "^.*$" str) + (replace-match "\\U" t nil str))))) +(with-temp-buffer + (erase-buffer) + (insert "test string") + (re-search-backward "^.*$") + (replace-match "\\U" t) + (Assert (and (bobp) (eobp)))) + +;;----------------------------------------------------- +;; Test near-text buffer functions. +;;----------------------------------------------------- +(with-temp-buffer + (erase-buffer) + (Assert (eq (char-before) nil)) + (Assert (eq (char-before (point)) nil)) + (Assert (eq (char-before (point-marker)) nil)) + (Assert (eq (char-before (point) (current-buffer)) nil)) + (Assert (eq (char-before (point-marker) (current-buffer)) nil)) + (Assert (eq (char-after) nil)) + (Assert (eq (char-after (point)) nil)) + (Assert (eq (char-after (point-marker)) nil)) + (Assert (eq (char-after (point) (current-buffer)) nil)) + (Assert (eq (char-after (point-marker) (current-buffer)) nil)) + (Assert (eq (preceding-char) 0)) + (Assert (eq (preceding-char (current-buffer)) 0)) + (Assert (eq (following-char) 0)) + (Assert (eq (following-char (current-buffer)) 0)) + (insert "foobar") + (Assert (eq (char-before) ?r)) + (Assert (eq (char-after) nil)) + (Assert (eq (preceding-char) ?r)) + (Assert (eq (following-char) 0)) + (goto-char (point-min)) + (Assert (eq (char-before) nil)) + (Assert (eq (char-after) ?f)) + (Assert (eq (preceding-char) 0)) + (Assert (eq (following-char) ?f)) + ) + +;;----------------------------------------------------- +;; Test plist manipulation functions. +;;----------------------------------------------------- +(let ((sym (make-symbol "test-symbol"))) + (Assert (eq t (get* sym t t))) + (Assert (eq t (get sym t t))) + (Assert (eq t (getf nil t t))) + (Assert (eq t (plist-get nil t t))) + (put sym 'bar 'baz) + (Assert (eq 'baz (get sym 'bar))) + (Assert (eq 'baz (getf '(bar baz) 'bar))) + (Assert (eq 'baz (getf (symbol-plist sym) 'bar))) + (Assert (eq 2 (getf '(1 2) 1))) + (Assert (eq 4 (put sym 3 4))) + (Assert (eq 4 (get sym 3))) + (Assert (eq t (remprop sym 3))) + (Assert (eq nil (remprop sym 3))) + (Assert (eq 5 (get sym 3 5))) + ) + +(loop for obj in + (list (make-symbol "test-symbol") + "test-string" + (make-extent nil nil nil) + (make-face 'test-face)) + do + (Assert (eq 2 (get obj ?1 2))) + (Assert (eq 4 (put obj ?3 4))) + (Assert (eq 4 (get obj ?3))) + (when (or (stringp obj) (symbolp obj)) + (Assert (equal '(?3 4) (object-plist obj)))) + (Assert (eq t (remprop obj ?3))) + (when (or (stringp obj) (symbolp obj)) + (Assert (eq '() (object-plist obj)))) + (Assert (eq nil (remprop obj ?3))) + (when (or (stringp obj) (symbolp obj)) + (Assert (eq '() (object-plist obj)))) + (Assert (eq 5 (get obj ?3 5))) + ) + +(Check-Error-Message + error "Object type has no properties" + (get 2 'property)) + +(Check-Error-Message + error "Object type has no settable properties" + (put (current-buffer) 'property 'value)) + +(Check-Error-Message + error "Object type has no removable properties" + (remprop ?3 'property)) + +(Check-Error-Message + error "Object type has no properties" + (object-plist (symbol-function 'car))) + +(Check-Error-Message + error "Can't remove property from object" + (remprop (make-extent nil nil nil) 'detachable)) + +;;----------------------------------------------------- +;; Test subseq +;;----------------------------------------------------- +(Assert (equal (subseq nil 0) nil)) +(Assert (equal (subseq [1 2 3] 0) [1 2 3])) +(Assert (equal (subseq [1 2 3] 1 -1) [2])) +(Assert (equal (subseq "123" 0) "123")) +(Assert (equal (subseq "1234" -3 -1) "23")) +(Assert (equal (subseq #*0011 0) #*0011)) +(Assert (equal (subseq #*0011 -3 3) #*01)) +(Assert (equal (subseq '(1 2 3) 0) '(1 2 3))) +(Assert (equal (subseq '(1 2 3 4) -3 nil) '(2 3 4))) + +(Check-Error wrong-type-argument (subseq 3 2)) +(Check-Error args-out-of-range (subseq [1 2 3] -42)) +(Check-Error args-out-of-range (subseq [1 2 3] 0 42)) + +;;----------------------------------------------------- +;; Time-related tests +;;----------------------------------------------------- +(Assert (= (length (current-time-string)) 24)) + +;;----------------------------------------------------- +;; format test +;;----------------------------------------------------- +(Assert (string= (format "%d" 10) "10")) +(Assert (string= (format "%o" 8) "10")) +(Assert (string= (format "%x" 31) "1f")) +(Assert (string= (format "%X" 31) "1F")) +(Assert (string= (format "%e" 100) "1.000000e+02")) +(Assert (string= (format "%E" 100) "1.000000E+02")) +(Assert (string= (format "%f" 100) "100.000000")) +(Assert (string= (format "%7.3f" 12.12345) " 12.123")) +(Assert (string= (format "%07.3f" 12.12345) "012.123")) +(Assert (string= (format "%-7.3f" 12.12345) "12.123 ")) +(Assert (string= (format "%-07.3f" 12.12345) "12.123 ")) +(Assert (string= (format "%g" 100.0) "100")) +(Assert (string= (format "%g" 0.000001) "1e-06")) +(Assert (string= (format "%g" 0.0001) "0.0001")) +(Assert (string= (format "%G" 100.0) "100")) +(Assert (string= (format "%G" 0.000001) "1E-06")) +(Assert (string= (format "%G" 0.0001) "0.0001")) + +(Assert (string= (format "%2$d%1$d" 10 20) "2010")) +(Assert (string= (format "%-d" 10) "10")) +(Assert (string= (format "%-4d" 10) "10 ")) +(Assert (string= (format "%+d" 10) "+10")) +(Assert (string= (format "%+d" -10) "-10")) +(Assert (string= (format "%+4d" 10) " +10")) +(Assert (string= (format "%+4d" -10) " -10")) +(Assert (string= (format "% d" 10) " 10")) +(Assert (string= (format "% d" -10) "-10")) +(Assert (string= (format "% 4d" 10) " 10")) +(Assert (string= (format "% 4d" -10) " -10")) +(Assert (string= (format "%0d" 10) "10")) +(Assert (string= (format "%0d" -10) "-10")) +(Assert (string= (format "%04d" 10) "0010")) +(Assert (string= (format "%04d" -10) "-010")) +(Assert (string= (format "%*d" 4 10) " 10")) +(Assert (string= (format "%*d" 4 -10) " -10")) +(Assert (string= (format "%*d" -4 10) "10 ")) +(Assert (string= (format "%*d" -4 -10) "-10 ")) +(Assert (string= (format "%#d" 10) "10")) +(Assert (string= (format "%#o" 8) "010")) +(Assert (string= (format "%#x" 16) "0x10")) +(Assert (string= (format "%#e" 100) "1.000000e+02")) +(Assert (string= (format "%#E" 100) "1.000000E+02")) +(Assert (string= (format "%#f" 100) "100.000000")) +(Assert (string= (format "%#g" 100.0) "100.000")) +(Assert (string= (format "%#g" 0.000001) "1.00000e-06")) +(Assert (string= (format "%#g" 0.0001) "0.000100000")) +(Assert (string= (format "%#G" 100.0) "100.000")) +(Assert (string= (format "%#G" 0.000001) "1.00000E-06")) +(Assert (string= (format "%#G" 0.0001) "0.000100000")) +(Assert (string= (format "%.1d" 10) "10")) +(Assert (string= (format "%.4d" 10) "0010")) +;; Combination of `-', `+', ` ', `0', `#', `.', `*' +(Assert (string= (format "%-04d" 10) "10 ")) +(Assert (string= (format "%-*d" 4 10) "10 ")) +;; #### Correctness of this behavior is questionable. +;; It might be better to signal error. +(Assert (string= (format "%-*d" -4 10) "10 ")) +;; These behavior is not specified. +;; (format "%-+d" 10) +;; (format "%- d" 10) +;; (format "%-01d" 10) +;; (format "%-#4x" 10) +;; (format "%-.1d" 10) + +(Assert (string= (format "%01.1d" 10) "10")) +(Assert (string= (format "%03.1d" 10) " 10")) +(Assert (string= (format "%01.3d" 10) "010")) +(Assert (string= (format "%1.3d" 10) "010")) +(Assert (string= (format "%3.1d" 10) " 10")) + +;;; The following two tests used to use 1000 instead of 100, +;;; but that merely found buffer overflow bugs in Solaris sprintf(). +(Assert (= 102 (length (format "%.100f" 3.14)))) +(Assert (= 100 (length (format "%100f" 3.14)))) + +;;; Check for 64-bit cleanness on LP64 platforms. +(Assert (= (read (format "%d" most-positive-fixnum)) most-positive-fixnum)) +(Assert (= (read (format "%ld" most-positive-fixnum)) most-positive-fixnum)) +(Assert (= (read (format "%u" most-positive-fixnum)) most-positive-fixnum)) +(Assert (= (read (format "%lu" most-positive-fixnum)) most-positive-fixnum)) +(Assert (= (read (format "%d" most-negative-fixnum)) most-negative-fixnum)) +(Assert (= (read (format "%ld" most-negative-fixnum)) most-negative-fixnum)) + +;;; "%u" is undocumented, and Emacs Lisp has no unsigned type. +;;; What to do if "%u" is used with a negative number? +;;; The most reasonable thing seems to be to print an un-read-able number. +;;; The printed value might be useful to a human, if not to Emacs Lisp. +(Check-Error invalid-read-syntax (read (format "%u" most-negative-fixnum))) +(Check-Error invalid-read-syntax (read (format "%u" -1))) + +;; Check all-completions ignore element start with space. +(Assert (not (all-completions "" '((" hidden" . "object"))))) +(Assert (all-completions " " '((" hidden" . "object"))))