XEmacs 21.2.47 (Zephir).
[chise/xemacs-chise.git.1] / tests / automated / lisp-tests.el
index 5893d17..b2b6077 100644 (file)
   (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))
     (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
 ;;-----------------------------------------------------
 
 ;; 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)
       (car y))             ; sorry, hard landing
     x)))
 
-(Assert 
+(Assert
  (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3))))
    (mapcar
     (lambda (y)
 (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.
 ;;-----------------------------------------------------
   (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"))))