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=5893d174a004ba172cd3bdbee601a6ff6fb7c0c5;hb=efdb31fd4c8db81d2414c32d491f1bf994263c74;hpb=716cfba952c1dc0d2cf5c968971f3780ba728a89 diff --git a/tests/automated/lisp-tests.el b/tests/automated/lisp-tests.el index 5893d17..b2b6077 100644 --- a/tests/automated/lisp-tests.el +++ b/tests/automated/lisp-tests.el @@ -243,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)) @@ -335,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 ;;----------------------------------------------------- @@ -757,7 +792,7 @@ ;; 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 +(Assert (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3)))) (mapcar (lambda (y) @@ -768,7 +803,7 @@ (car y)) ; sorry, hard landing x))) -(Assert +(Assert (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3)))) (mapcar (lambda (y) @@ -831,6 +866,17 @@ (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. ;;----------------------------------------------------- @@ -875,4 +921,168 @@ (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"))))