cgit.sxemacs.org Git - sxemacs/blob - tests/automated/lisp-tests.el

   1 ;; Copyright (C) 1998 Free Software Foundation, Inc.
   2
   3 ;; Author: Martin Buchholz <martin@xemacs.org>
   4 ;; Maintainer: Martin Buchholz <martin@xemacs.org>
   5 ;; Created: 1998
   6 ;; Keywords: tests
   7
   8 ;; This file is part of SXEmacs.
   9
  10 ;; SXEmacs is free software: you can redistribute it and/or modify it
  11 ;; under the terms of the GNU General Public License as published by the
  12 ;; Free Software Foundation, either version 3 of the License, or (at your
  13 ;; option) any later version.
  14
  15 ;; SXEmacs is distributed in the hope that it will be
  16 ;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Synched up with: Not in FSF.
  24
  25 ;;; Commentary:
  26
  27 ;;; Test basic Lisp engine functionality
  28 ;;; See test-harness.el for instructions on how to run these tests.
  29
  30 (eval-when-compile
  31   (condition-case nil
  32       (require 'test-harness)
  33     (file-error
  34      (push "." load-path)
  35      (when (and (boundp 'load-file-name) (stringp load-file-name))
  36        (push (file-name-directory load-file-name) load-path))
  37      (require 'test-harness))))
  38
  39 (Check-Error wrong-number-of-arguments (setq setq-test-foo))
  40 (Check-Error wrong-number-of-arguments (setq setq-test-foo 1 setq-test-bar))
  41 (Check-Error wrong-number-of-arguments (setq-default setq-test-foo))
  42 (Check-Error wrong-number-of-arguments (setq-default setq-test-foo 1 setq-test-bar))
  43 (Assert (eq (setq)         nil))
  44 (Assert (eq (setq-default) nil))
  45 (Assert (eq (setq         setq-test-foo 42) 42))
  46 (Assert (eq (setq-default setq-test-foo 42) 42))
  47 (Assert (eq (setq         setq-test-foo 42 setq-test-bar 99) 99))
  48 (Assert (eq (setq-default setq-test-foo 42 setq-test-bar 99) 99))
  49
  50 (macrolet ((test-setq (expected-result &rest body)
  51                       `(progn
  52                          (defun test-setq-fun () ,@body)
  53                          (Assert (eq ,expected-result (test-setq-fun)))
  54                          (byte-compile 'test-setq-fun)
  55                          (Assert (eq ,expected-result (test-setq-fun))))))
  56   (test-setq nil (setq))
  57   (test-setq nil (setq-default))
  58   (test-setq 42  (setq         test-setq-var 42))
  59   (test-setq 42  (setq-default test-setq-var 42))
  60   (test-setq 42  (setq         test-setq-bar 99 test-setq-var 42))
  61   (test-setq 42  (setq-default test-setq-bar 99 test-setq-var 42))
  62   )
  63
  64 ;; Following test dies on recent libc's with MALLOC_PERTURB_=69
  65 (Check-Error wrong-type-argument (length (current-buffer)))
  66
  67 (let ((my-vector [1 2 3 4])
  68       (my-bit-vector (bit-vector 1 0 1 0))
  69       (my-string "1234")
  70       (my-list '(1 2 3 4)))
  71
  72   ;;(Assert (fooooo)) ;; Generate Other failure
  73   ;;(Assert (eq 1 2)) ;; Generate Assertion failure
  74
  75   (dolist (sequence (list my-vector my-bit-vector my-string my-list))
  76     (Assert (sequencep sequence))
  77     (Assert (eq 4 (length sequence))))
  78
  79   (dolist (array (list my-vector my-bit-vector my-string))
  80     (Assert (arrayp array)))
  81
  82   (Assert (eq (elt my-vector 0) 1))
  83   (Assert (eq (elt my-bit-vector 0) 1))
  84   (Assert (eq (elt my-string 0) ?1))
  85   (Assert (eq (elt my-list 0) 1))
  86
  87   (fillarray my-vector 5)
  88   (fillarray my-bit-vector 1)
  89   (fillarray my-string ?5)
  90
  91   (dolist (array (list my-vector my-bit-vector))
  92     (Assert (eq 4 (length array))))
  93
  94   (Assert (eq (elt my-vector 0) 5))
  95   (Assert (eq (elt my-bit-vector 0) 1))
  96   (Assert (eq (elt my-string 0) ?5))
  97
  98   (Assert (eq (elt my-vector 3) 5))
  99   (Assert (eq (elt my-bit-vector 3) 1))
 100   (Assert (eq (elt my-string 3) ?5))
 101
 102   (fillarray my-bit-vector 0)
 103   (Assert (eq 4 (length my-bit-vector)))
 104   (Assert (eq (elt my-bit-vector 2) 0))
 105   )
 106
 107 (defun make-circular-list (length)
 108   "Create evil emacs-crashing circular list of length LENGTH"
 109   (let ((circular-list
 110          (make-list
 111           length
 112           'you-are-trapped-in-a-twisty-maze-of-cons-cells-all-alike)))
 113     (setcdr (last circular-list) circular-list)
 114     circular-list))
 115
 116 ;;-----------------------------------------------------
 117 ;; Test `nconc'
 118 ;;-----------------------------------------------------
 119 (defun make-list-012 () (list 0 1 2))
 120
 121 (Check-Error wrong-type-argument (nconc 'foo nil))
 122
 123 (dolist (length '(1 2 3 4 1000 2000))
 124   (Check-Error circular-list (nconc (make-circular-list length) 'foo))
 125   (Check-Error circular-list (nconc '(1 . 2) (make-circular-list length) 'foo))
 126   (Check-Error circular-list (nconc '(1 . 2) '(3 . 4) (make-circular-list length) 'foo)))
 127
 128 (Assert (eq (nconc) nil))
 129 (Assert (eq (nconc nil) nil))
 130 (Assert (eq (nconc nil nil) nil))
 131 (Assert (eq (nconc nil nil nil) nil))
 132
 133 (let ((x (make-list-012))) (Assert (eq (nconc nil x) x)))
 134 (let ((x (make-list-012))) (Assert (eq (nconc x nil) x)))
 135 (let ((x (make-list-012))) (Assert (eq (nconc nil x nil) x)))
 136 (let ((x (make-list-012))) (Assert (eq (nconc x) x)))
 137 (let ((x (make-list-012))) (Assert (eq (nconc x (make-circular-list 3)) x)))
 138
 139 (Assert-Equal (nconc '(1 . 2) '(3 . 4) '(5 . 6)) '(1 3 5 . 6))
 140
 141 (let ((y (nconc (make-list-012) nil (list 3 4 5) nil)))
 142   (Assert (eq (length y) 6))
 143   (Assert (eq (nth 3 y) 3)))
 144
 145 ;;-----------------------------------------------------
 146 ;; Test `last'
 147 ;;-----------------------------------------------------
 148 (Check-Error wrong-type-argument (last 'foo))
 149 (Check-Error wrong-number-of-arguments (last))
 150 (Check-Error wrong-number-of-arguments (last '(1 2) 1 1))
 151 (Check-Error circular-list (last (make-circular-list 1)))
 152 (Check-Error circular-list (last (make-circular-list 2000)))
 153 (let ((x (list 0 1 2 3)))
 154   (Assert (eq (last nil) nil))
 155   (Assert (eq (last x 0) nil))
 156   (Assert (eq (last x  ) (cdddr x)))
 157   (Assert (eq (last x 1) (cdddr x)))
 158   (Assert (eq (last x 2) (cddr x)))
 159   (Assert (eq (last x 3) (cdr x)))
 160   (Assert (eq (last x 4) x))
 161   (Assert (eq (last x 9) x))
 162   (Assert (eq (last '(1 . 2) 0) 2))
 163   )
 164
 165 ;;-----------------------------------------------------
 166 ;; Test `butlast' and `nbutlast'
 167 ;;-----------------------------------------------------
 168 (Check-Error wrong-type-argument (butlast  'foo))
 169 (Check-Error wrong-type-argument (nbutlast 'foo))
 170 (Check-Error wrong-number-of-arguments (butlast))
 171 (Check-Error wrong-number-of-arguments (nbutlast))
 172 (Check-Error wrong-number-of-arguments (butlast  '(1 2) 1 1))
 173 (Check-Error wrong-number-of-arguments (nbutlast '(1 2) 1 1))
 174 (Check-Error circular-list (butlast  (make-circular-list 1)))
 175 (Check-Error circular-list (nbutlast (make-circular-list 1)))
 176 (Check-Error circular-list (butlast  (make-circular-list 2000)))
 177 (Check-Error circular-list (nbutlast (make-circular-list 2000)))
 178
 179 (let* ((x (list 0 1 2 3))
 180        (y (butlast x))
 181        (z (nbutlast x)))
 182   (Assert (eq z x))
 183   (Assert (not (eq y x)))
 184   (Assert-Equal y '(0 1 2))
 185   (Assert-Equal z y))
 186
 187 (let* ((x (list 0 1 2 3 4))
 188        (y (butlast x 2))
 189        (z (nbutlast x 2)))
 190   (Assert (eq z x))
 191   (Assert (not (eq y x)))
 192   (Assert-Equal y '(0 1 2))
 193   (Assert-Equal z y))
 194
 195 (let* ((x (list 0 1 2 3))
 196        (y (butlast x 0))
 197        (z (nbutlast x 0)))
 198   (Assert (eq z x))
 199   (Assert (not (eq y x)))
 200   (Assert-Equal y '(0 1 2 3))
 201   (Assert-Equal z y))
 202
 203 (Assert (eq (butlast  '(x)) nil))
 204 (Assert (eq (nbutlast '(x)) nil))
 205 (Assert (eq (butlast  '()) nil))
 206 (Assert (eq (nbutlast '()) nil))
 207
 208 ;;-----------------------------------------------------
 209 ;; Test `copy-list'
 210 ;;-----------------------------------------------------
 211 (Check-Error wrong-type-argument (copy-list 'foo))
 212 (Check-Error wrong-number-of-arguments (copy-list))
 213 (Check-Error wrong-number-of-arguments (copy-list '(1 2) 1))
 214 (Check-Error circular-list (copy-list (make-circular-list 1)))
 215 (Check-Error circular-list (copy-list (make-circular-list 2000)))
 216 (Assert (eq '() (copy-list '())))
 217 (dolist (x '((1) (1 2) (1 2 3) (1 2 . 3)))
 218   (let ((y (copy-list x)))
 219     (Assert (and (equal x y) (not (eq x y))))))
 220
 221 ;;-----------------------------------------------------
 222 ;; Arithmetic operations
 223 ;;-----------------------------------------------------
 224
 225 ;; Test `+'
 226 (Assert (eq (+ 1 1) 2))
 227 (Assert (= (+ 1.0 1.0) 2.0))
 228 (Assert (= (+ 1.0 3.0 0.0) 4.0))
 229 (Assert (= (+ 1 1.0) 2.0))
 230 (Assert (= (+ 1.0 1) 2.0))
 231 (Assert (= (+ 1.0 1 1) 3.0))
 232 (Assert (= (+ 1 1 1.0) 3.0))
 233 (when (featurep 'bigz)
 234   ;; of course the original test does not make sense when having big integers
 235   (Assert (bigzp (1+ most-positive-fixnum)))
 236   (Assert (bigzp (+ most-positive-fixnum 1))))
 237 (unless (featurep 'bigz)
 238   (Assert (eq (1+ most-positive-fixnum) most-negative-fixnum))
 239   (Assert (eq (+ most-positive-fixnum 1) most-negative-fixnum)))
 240
 241 ;; Test `-'
 242 (Check-Error wrong-number-of-arguments (-))
 243 (Assert (eq (- 0) 0))
 244 (Assert (eq (- 1) -1))
 245 (dolist (one `(1 1.0 ?\1 ,(Int-to-Marker 1)))
 246   (Assert (= (+ 1 one) 2))
 247   (Assert (= (+ one) 1))
 248   (Assert (= (+ one) one))
 249   (Assert (= (- one) -1))
 250   (Assert (= (- one one) 0))
 251   (Assert (= (- one one one) -1))
 252   (Assert (= (- 0 one) -1))
 253   (Assert (= (- 0 one one) -2))
 254   (Assert (= (+ one 1) 2))
 255   (dolist (zero '(0 0.0 ?\0))
 256     (Assert (= (+ 1 zero) 1))
 257     (Assert (= (+ zero 1) 1))
 258     (Assert (= (- zero) zero))
 259     (Assert (= (- zero) 0))
 260     (Assert (= (- zero zero) 0))
 261     (Assert (= (- zero one one) -2))))
 262
 263 (Assert (= (- 1.5 1) .5))
 264 (Assert (= (- 1 1.5) (- .5)))
 265
 266 (when (featurep 'bigz)
 267   (Assert (bigzp (1- most-negative-fixnum)))
 268   (Assert (bigzp (- most-negative-fixnum 1))))
 269 (unless (featurep 'bigz)
 270   (Assert (eq (1- most-negative-fixnum) most-positive-fixnum))
 271   (Assert (eq (- most-negative-fixnum 1) most-positive-fixnum)))
 272
 273 ;; Test `/'
 274
 275 ;; ;; Test division by zero errors
 276 ;; (dolist (zero '(0 0.0 ?\0))
 277 ;;   (Check-Error arith-error (/ zero))
 278 ;;   (dolist (n1 `(42 42.0 ?\042 ,(Int-to-Marker 42)))
 279 ;;     (Check-Error arith-error (/ n1 zero))
 280 ;;     (dolist (n2 `(3 3.0 ?\03 ,(Int-to-Marker 3)))
 281 ;;       (Check-Error arith-error (/ n1 n2 zero)))))
 282
 283 ;; Other tests for `/'
 284 (Check-Error wrong-number-of-arguments (/))
 285 (let (x)
 286   (if (and (featurep 'bigq) common-lisp-slash)
 287       (Assert (= (/ (setq x 2)) 1/2))
 288     (Assert (= (/ (setq x 2)) 0)))
 289   (Assert (= (/ (setq x 2.0)) 0.5)))
 290
 291 (dolist (six '(6 6.0 ?\06))
 292   (dolist (two '(2 2.0 ?\02))
 293     (dolist (three '(3 3.0 ?\03))
 294       (Assert (= (/ six two) three)))))
 295
 296 (dolist (three '(3 3.0 ?\03))
 297   (Assert (= (/ three 2.0) 1.5)))
 298 (dolist (two '(2 2.0 ?\02))
 299   (Assert (= (/ 3.0 two) 1.5)))
 300
 301 ;; Test `*'
 302 (Assert (= 1 (*)))
 303
 304 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
 305   (Assert (= 1 (* one))))
 306
 307 (dolist (two '(2 2.0 ?\02))
 308   (Assert (= 2 (* two))))
 309
 310 (dolist (six '(6 6.0 ?\06))
 311   (dolist (two '(2 2.0 ?\02))
 312     (dolist (three '(3 3.0 ?\03))
 313       (Assert (= (* three two) six)))))
 314
 315 (dolist (three '(3 3.0 ?\03))
 316   (dolist (two '(2 2.0 ?\02))
 317     (Assert (= (* 1.5 two) three))
 318     (dolist (five '(5 5.0 ?\05))
 319       (Assert (= 30 (* five two three))))))
 320
 321 ;; Test `+'
 322 (Assert (= 0 (+)))
 323
 324 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
 325   (Assert (= 1 (+ one))))
 326
 327 (dolist (two '(2 2.0 ?\02))
 328   (Assert (= 2 (+ two))))
 329
 330 (dolist (five '(5 5.0 ?\05))
 331   (dolist (two '(2 2.0 ?\02))
 332     (dolist (three '(3 3.0 ?\03))
 333       (Assert (= (+ three two) five))
 334       (Assert (= 10 (+ five two three))))))
 335
 336 ;; Test `max', `min'
 337 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
 338   (Assert (= one (max one)))
 339   (Assert (= one (max one one)))
 340   (Assert (= one (max one one one)))
 341   (Assert (= one (min one)))
 342   (Assert (= one (min one one)))
 343   (Assert (= one (min one one one)))
 344   (dolist (two `(2 2.0 ?\02 ,(Int-to-Marker 2)))
 345     (Assert (= one (min one two)))
 346     (Assert (= one (min one two two)))
 347     (Assert (= one (min two two one)))
 348     (Assert (= two (max one two)))
 349     (Assert (= two (max one two two)))
 350     (Assert (= two (max two two one)))))
 351
 352 ;; The byte compiler has special handling for these constructs:
 353 (let ((three 3) (five 5))
 354   (Assert (= (+ three five 1) 9))
 355   (Assert (= (+ 1 three five) 9))
 356   (Assert (= (+ three five -1) 7))
 357   (Assert (= (+ -1 three five) 7))
 358   (Assert (= (+ three 1) 4))
 359   (Assert (= (+ three -1) 2))
 360   (Assert (= (+ -1 three) 2))
 361   (Assert (= (+ -1 three) 2))
 362   (Assert (= (- three five 1) -3))
 363   (Assert (= (- 1 three five) -7))
 364   (Assert (= (- three five -1) -1))
 365   (Assert (= (- -1 three five) -9))
 366   (Assert (= (- three 1) 2))
 367   (Assert (= (- three 2 1) 0))
 368   (Assert (= (- 2 three 1) -2))
 369   (Assert (= (- three -1) 4))
 370   (Assert (= (- three 0) 3))
 371   (Assert (= (- three 0 five) -2))
 372   (Assert (= (- 0 three 0 five) -8))
 373   (Assert (= (- 0 three five) -8))
 374   (Assert (= (* three 2) 6))
 375   (Assert (= (* three -1 five) -15))
 376   (Assert (= (* three 1 five) 15))
 377   (Assert (= (* three 0 five) 0))
 378   (Assert (= (* three 2 five) 30))
 379   (Assert (= (/ three 1) 3))
 380   (Assert (= (/ three -1) -3))
 381   (if (and (featurep 'bigq) common-lisp-slash)
 382       (Assert (= (/ (* five five) 2 2) 25/4))
 383     (Assert (= (/ (* five five) 2 2) 6)))
 384   (if (and (featurep 'bigq) common-lisp-slash)
 385       (Assert (= (/ 64 five 2) 32/5))
 386     (Assert (= (/ 64 five 2) 6))))
 387
 388
 389 ;;-----------------------------------------------------
 390 ;; Logical bit-twiddling operations
 391 ;;-----------------------------------------------------
 392 (Assert (= (logxor)  0))
 393 (Assert (= (logior)  0))
 394 (Assert (= (logand) -1))
 395
 396 (Check-Error wrong-type-argument (logxor 3.0))
 397 (Check-Error wrong-type-argument (logior 3.0))
 398 (Check-Error wrong-type-argument (logand 3.0))
 399
 400 (dolist (three '(3 ?\03))
 401   (Assert (eq 3 (logand three)))
 402   (Assert (eq 3 (logxor three)))
 403   (Assert (eq 3 (logior three)))
 404   (Assert (eq 3 (logand three three)))
 405   (Assert (eq 0 (logxor three three)))
 406   (Assert (eq 3 (logior three three))))
 407
 408 (dolist (one `(1 ?\01 ,(Int-to-Marker 1)))
 409   (dolist (two '(2 ?\02))
 410     (Assert (eq 0 (logand one two)))
 411     (Assert (eq 3 (logior one two)))
 412     (Assert (eq 3 (logxor one two))))
 413   (dolist (three '(3 ?\03))
 414     (Assert (eq 1 (logand one three)))
 415     (Assert (eq 3 (logior one three)))
 416     (Assert (eq 2 (logxor one three)))))
 417
 418 ;;-----------------------------------------------------
 419 ;; Test `%', mod
 420 ;;-----------------------------------------------------
 421 (Check-Error wrong-number-of-arguments (%))
 422 (Check-Error wrong-number-of-arguments (% 1))
 423 (Check-Error wrong-number-of-arguments (% 1 2 3))
 424
 425 (Check-Error wrong-number-of-arguments (mod))
 426 (Check-Error wrong-number-of-arguments (mod 1))
 427 (Check-Error wrong-number-of-arguments (mod 1 2 3))
 428
 429 (when (featurep 'number-types)
 430   (Assert (= (% 10.0 2) 0.0))
 431   (Assert (= (mod 10.0 4) 2.0))
 432   (Assert (= (% 10 2.0) 0.0))
 433   (Assert (= (mod 10 4.0) 2.0)))
 434 (unless (featurep 'number-types)
 435   (Check-Error wrong-type-argument (% 10.0 2))
 436   (Check-Error wrong-type-argument (% 10 2.0)))
 437
 438 (when (featurep 'bigz)
 439   ;; we test this in ent-tests.el
 440   )
 441 (unless (featurep 'bigz)
 442   (dotimes (j 30)
 443     (let ((x (- (random) (random))))
 444       (eval `(Assert (eq ,x (+ (% ,x 17) (* (/ ,x 17) 17)))))
 445       (eval `(Assert (eq ,(- x) (+ (% ,(- x) 17) (* (/ ,(- x) 17) 17)))))
 446       (eval `(Assert (eq (% ,x -17) (- (% ,(- x) 17))))))))
 447
 448 (macrolet
 449     ((division-test (seven)
 450     `(progn
 451        (Assert (eq (% ,seven      2)  1))
 452        (Assert (eq (% ,seven     -2)  1))
 453        (Assert (eq (% (- ,seven)  2) -1))
 454        (Assert (eq (% (- ,seven) -2) -1))
 455
 456        (Assert (eq (% ,seven      4)  3))
 457        (Assert (eq (% ,seven     -4)  3))
 458        (Assert (eq (% (- ,seven)  4) -3))
 459        (Assert (eq (% (- ,seven) -4) -3))
 460
 461        (Assert (eq (%  35 ,seven)     0))
 462        (Assert (eq (% -35 ,seven)     0))
 463        (Assert (eq (%  35 (- ,seven)) 0))
 464        (Assert (eq (% -35 (- ,seven)) 0))
 465
 466        (Assert (eq (mod ,seven      2)  1))
 467        (Assert (eq (mod ,seven     -2) -1))
 468        (Assert (eq (mod (- ,seven)  2)  1))
 469        (Assert (eq (mod (- ,seven) -2) -1))
 470
 471        (Assert (eq (mod ,seven      4)  3))
 472        (Assert (eq (mod ,seven     -4) -1))
 473        (Assert (eq (mod (- ,seven)  4)  1))
 474        (Assert (eq (mod (- ,seven) -4) -3))
 475
 476        (Assert (eq (mod  35 ,seven)     0))
 477        (Assert (eq (mod -35 ,seven)     0))
 478        (Assert (eq (mod  35 (- ,seven)) 0))
 479        (Assert (eq (mod -35 (- ,seven)) 0))
 480
 481        (Assert (= (mod ,seven      2.0)  1.0))
 482        (Assert (= (mod ,seven     -2.0) -1.0))
 483        (Assert (= (mod (- ,seven)  2.0)  1.0))
 484        (Assert (= (mod (- ,seven) -2.0) -1.0))
 485
 486        (Assert (= (mod ,seven      4.0)  3.0))
 487        (Assert (= (mod ,seven     -4.0) -1.0))
 488        (Assert (= (mod (- ,seven)  4.0)  1.0))
 489        (Assert (= (mod (- ,seven) -4.0) -3.0))
 490
 491        (Assert (eq (% 0 ,seven) 0))
 492        (Assert (eq (% 0 (- ,seven)) 0))
 493
 494        (Assert (eq (mod 0 ,seven) 0))
 495        (Assert (eq (mod 0 (- ,seven)) 0))
 496
 497        (Assert (= (mod 0.0 ,seven) 0.0))
 498        (Assert (= (mod 0.0 (- ,seven)) 0.0)))))
 499
 500   (division-test 7)
 501   (division-test ?\07)
 502   (division-test (Int-to-Marker 7)))
 503
 504
 505
 506 ;;-----------------------------------------------------
 507 ;; Arithmetic comparison operations
 508 ;;-----------------------------------------------------
 509 (Check-Error wrong-number-of-arguments (=))
 510 (Check-Error wrong-number-of-arguments (<))
 511 (Check-Error wrong-number-of-arguments (>))
 512 (Check-Error wrong-number-of-arguments (<=))
 513 (Check-Error wrong-number-of-arguments (>=))
 514 (Check-Error wrong-number-of-arguments (/=))
 515
 516 ;; One argument always yields t
 517 (loop for x in `(1 1.0 ,(Int-to-Marker 1) ?z) do
 518   (Assert (eq t (=  x)))
 519   (Assert (eq t (<  x)))
 520   (Assert (eq t (>  x)))
 521   (Assert (eq t (>= x)))
 522   (Assert (eq t (<= x)))
 523   (Assert (eq t (/= x)))
 524   )
 525
 526 (when (featurep 'number-type)
 527   (let ((nums))
 528     (and (featurep 'bigz)
 529          (setq nums (cons (factorial 20) nums)))
 530     (and (featurep 'bigq)
 531          (setq nums (cons (// (factorial 20) 71) nums)))
 532     (and (featurep 'bigfr)
 533          (setq nums (cons (exp 2) nums)))
 534     (and (featurep 'bigc)
 535          (setq nums (cons (sqrt -3) nums)))
 536     (loop for x in num do
 537       (Assert (eq t (=  x)))
 538       (Assert (eq t (<  x)))
 539       (Assert (eq t (>  x)))
 540       (Assert (eq t (>= x)))
 541       (Assert (eq t (<= x)))
 542       (Assert (eq t (/= x)))
 543       )))
 544
 545 ;; Type checking
 546 (Check-Error relation-error (=  'foo 1))
 547 (Check-Error relation-error (<= 'foo 1))
 548 (Check-Error relation-error (>= 'foo 1))
 549 (Check-Error relation-error (<  'foo 1))
 550 (Check-Error relation-error (>  'foo 1))
 551 (Check-Error relation-error (/= 'foo 1))
 552
 553 ;; Meat
 554 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
 555   (dolist (two '(2 2.0 ?\02))
 556     (Assert (<  one two))
 557     (Assert (<= one two))
 558     (Assert (<= two two))
 559     (Assert (>  two one))
 560     (Assert (>= two one))
 561     (Assert (>= two two))
 562     (Assert (/= one two))
 563     (Assert (not (/= two two)))
 564     (Assert (not (< one one)))
 565     (Assert (not (> one one)))
 566     (Assert (<= one one two two))
 567     (Assert (not (< one one two two)))
 568     (Assert (>= two two one one))
 569     (Assert (not (> two two one one)))
 570     (Assert (= one one one))
 571     (Assert (not (= one one one two)))
 572     (Assert (not (/= one two one)))
 573     ))
 574
 575 ;; ad-hoc
 576 (Assert (< 1 2))
 577 (Assert (< 1 2 3 4 5 6))
 578 (Assert (not (< 1 1)))
 579 (Assert (not (< 2 1)))
 580
 581
 582 (Assert (not (< 1 1)))
 583 (Assert (< 1 2 3 4 5 6))
 584 (Assert (<= 1 2 3 4 5 6))
 585 (Assert (<= 1 2 3 4 5 6 6))
 586 (Assert (not (< 1 2 3 4 5 6 6)))
 587 (Assert (<= 1 1))
 588
 589 (Assert (not (eq (point) (point-marker))))
 590 (Assert (= 1 (Int-to-Marker 1)))
 591 (Assert (= (point) (point-marker)))
 592
 593 ;;-----------------------------------------------------
 594 ;; testing list-walker functions
 595 ;;-----------------------------------------------------
 596 (macrolet
 597     ((test-fun
 598       (fun)
 599       `(progn
 600          (Check-Error wrong-number-of-arguments (,fun))
 601          (Check-Error wrong-number-of-arguments (,fun nil))
 602          (Check-Error malformed-list (,fun nil 1))
 603          ,@(loop for n in '(1 2 2000)
 604              collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n))))))
 605      (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun)))))
 606
 607   (test-funs member old-member
 608              memq   old-memq
 609              assoc  old-assoc
 610              rassoc old-rassoc
 611              rassq  old-rassq
 612              delete old-delete
 613              delq   old-delq
 614              remassoc remassq remrassoc remrassq))
 615
 616 (let ((x '((1 . 2) 3 (4 . 5))))
 617   (Assert (eq (assoc  1 x) (car x)))
 618   (Assert (eq (assq   1 x) (car x)))
 619   (Assert (eq (rassoc 1 x) nil))
 620   (Assert (eq (rassq  1 x) nil))
 621   (Assert (eq (assoc  2 x) nil))
 622   (Assert (eq (assq   2 x) nil))
 623   (Assert (eq (rassoc 2 x) (car x)))
 624   (Assert (eq (rassq  2 x) (car x)))
 625   (Assert (eq (assoc  3 x) nil))
 626   (Assert (eq (assq   3 x) nil))
 627   (Assert (eq (rassoc 3 x) nil))
 628   (Assert (eq (rassq  3 x) nil))
 629   (Assert (eq (assoc  4 x) (caddr x)))
 630   (Assert (eq (assq   4 x) (caddr x)))
 631   (Assert (eq (rassoc 4 x) nil))
 632   (Assert (eq (rassq  4 x) nil))
 633   (Assert (eq (assoc  5 x) nil))
 634   (Assert (eq (assq   5 x) nil))
 635   (Assert (eq (rassoc 5 x) (caddr x)))
 636   (Assert (eq (rassq  5 x) (caddr x)))
 637   (Assert (eq (assoc  6 x) nil))
 638   (Assert (eq (assq   6 x) nil))
 639   (Assert (eq (rassoc 6 x) nil))
 640   (Assert (eq (rassq  6 x) nil)))
 641
 642 (let ((x '(("1" . "2") "3" ("4" . "5"))))
 643   (Assert (eq (assoc  "1" x) (car x)))
 644   (Assert (eq (assq   "1" x) nil))
 645   (Assert (eq (rassoc "1" x) nil))
 646   (Assert (eq (rassq  "1" x) nil))
 647   (Assert (eq (assoc  "2" x) nil))
 648   (Assert (eq (assq   "2" x) nil))
 649   (Assert (eq (rassoc "2" x) (car x)))
 650   (Assert (eq (rassq  "2" x) nil))
 651   (Assert (eq (assoc  "3" x) nil))
 652   (Assert (eq (assq   "3" x) nil))
 653   (Assert (eq (rassoc "3" x) nil))
 654   (Assert (eq (rassq  "3" x) nil))
 655   (Assert (eq (assoc  "4" x) (caddr x)))
 656   (Assert (eq (assq   "4" x) nil))
 657   (Assert (eq (rassoc "4" x) nil))
 658   (Assert (eq (rassq  "4" x) nil))
 659   (Assert (eq (assoc  "5" x) nil))
 660   (Assert (eq (assq   "5" x) nil))
 661   (Assert (eq (rassoc "5" x) (caddr x)))
 662   (Assert (eq (rassq  "5" x) nil))
 663   (Assert (eq (assoc  "6" x) nil))
 664   (Assert (eq (assq   "6" x) nil))
 665   (Assert (eq (rassoc "6" x) nil))
 666   (Assert (eq (rassq  "6" x) nil)))
 667
 668 (flet ((a () (list '(1 . 2) 3 '(4 . 5))))
 669   (Assert (let* ((x (a)) (y (remassoc  1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
 670   (Assert (let* ((x (a)) (y (remassq   1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
 671   (Assert (let* ((x (a)) (y (remrassoc 1 x))) (and (eq x y) (equal y (a)))))
 672   (Assert (let* ((x (a)) (y (remrassq  1 x))) (and (eq x y) (equal y (a)))))
 673
 674   (Assert (let* ((x (a)) (y (remassoc  2 x))) (and (eq x y) (equal y (a)))))
 675   (Assert (let* ((x (a)) (y (remassq   2 x))) (and (eq x y) (equal y (a)))))
 676   (Assert (let* ((x (a)) (y (remrassoc 2 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
 677   (Assert (let* ((x (a)) (y (remrassq  2 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
 678
 679   (Assert (let* ((x (a)) (y (remassoc  3 x))) (and (eq x y) (equal y (a)))))
 680   (Assert (let* ((x (a)) (y (remassq   3 x))) (and (eq x y) (equal y (a)))))
 681   (Assert (let* ((x (a)) (y (remrassoc 3 x))) (and (eq x y) (equal y (a)))))
 682   (Assert (let* ((x (a)) (y (remrassq  3 x))) (and (eq x y) (equal y (a)))))
 683
 684   (Assert (let* ((x (a)) (y (remassoc  4 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
 685   (Assert (let* ((x (a)) (y (remassq   4 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
 686   (Assert (let* ((x (a)) (y (remrassoc 4 x))) (and (eq x y) (equal y (a)))))
 687   (Assert (let* ((x (a)) (y (remrassq  4 x))) (and (eq x y) (equal y (a)))))
 688
 689   (Assert (let* ((x (a)) (y (remassoc  5 x))) (and (eq x y) (equal y (a)))))
 690   (Assert (let* ((x (a)) (y (remassq   5 x))) (and (eq x y) (equal y (a)))))
 691   (Assert (let* ((x (a)) (y (remrassoc 5 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
 692   (Assert (let* ((x (a)) (y (remrassq  5 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
 693
 694   (Assert (let* ((x (a)) (y (remassoc  6 x))) (and (eq x y) (equal y (a)))))
 695   (Assert (let* ((x (a)) (y (remassq   6 x))) (and (eq x y) (equal y (a)))))
 696   (Assert (let* ((x (a)) (y (remrassoc 6 x))) (and (eq x y) (equal y (a)))))
 697   (Assert (let* ((x (a)) (y (remrassq  6 x))) (and (eq x y) (equal y (a)))))
 698
 699   (Assert (let* ((x (a)) (y (delete     3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
 700   (Assert (let* ((x (a)) (y (delq       3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
 701   (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
 702   (Assert (let* ((x (a)) (y (old-delq   3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
 703
 704   (Assert (let* ((x (a)) (y (delete     '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
 705   (Assert (let* ((x (a)) (y (delq       '(1 . 2) x))) (and      (eq x y)  (equal y (a)))))
 706   (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
 707   (Assert (let* ((x (a)) (y (old-delq   '(1 . 2) x))) (and      (eq x y)  (equal y (a)))))
 708   )
 709
 710
 711
 712 (flet ((a () (list '("1" . "2") "3" '("4" . "5"))))
 713   (Assert (let* ((x (a)) (y (remassoc  "1" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
 714   (Assert (let* ((x (a)) (y (remassq   "1" x))) (and (eq x y) (equal y (a)))))
 715   (Assert (let* ((x (a)) (y (remrassoc "1" x))) (and (eq x y) (equal y (a)))))
 716   (Assert (let* ((x (a)) (y (remrassq  "1" x))) (and (eq x y) (equal y (a)))))
 717
 718   (Assert (let* ((x (a)) (y (remassoc  "2" x))) (and (eq x y) (equal y (a)))))
 719   (Assert (let* ((x (a)) (y (remassq   "2" x))) (and (eq x y) (equal y (a)))))
 720   (Assert (let* ((x (a)) (y (remrassoc "2" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
 721   (Assert (let* ((x (a)) (y (remrassq  "2" x))) (and (eq x y) (equal y (a)))))
 722
 723   (Assert (let* ((x (a)) (y (remassoc  "3" x))) (and (eq x y) (equal y (a)))))
 724   (Assert (let* ((x (a)) (y (remassq   "3" x))) (and (eq x y) (equal y (a)))))
 725   (Assert (let* ((x (a)) (y (remrassoc "3" x))) (and (eq x y) (equal y (a)))))
 726   (Assert (let* ((x (a)) (y (remrassq  "3" x))) (and (eq x y) (equal y (a)))))
 727
 728   (Assert (let* ((x (a)) (y (remassoc  "4" x))) (and (eq x y) (equal y '(("1" . "2") "3")))))
 729   (Assert (let* ((x (a)) (y (remassq   "4" x))) (and (eq x y) (equal y (a)))))
 730   (Assert (let* ((x (a)) (y (remrassoc "4" x))) (and (eq x y) (equal y (a)))))
 731   (Assert (let* ((x (a)) (y (remrassq  "4" x))) (and (eq x y) (equal y (a)))))
 732
 733   (Assert (let* ((x (a)) (y (remassoc  "5" x))) (and (eq x y) (equal y (a)))))
 734   (Assert (let* ((x (a)) (y (remassq   "5" x))) (and (eq x y) (equal y (a)))))
 735   (Assert (let* ((x (a)) (y (remrassoc "5" x))) (and (eq x y) (equal y '(("1" . "2") "3")))))
 736   (Assert (let* ((x (a)) (y (remrassq  "5" x))) (and (eq x y) (equal y (a)))))
 737
 738   (Assert (let* ((x (a)) (y (remassoc  "6" x))) (and (eq x y) (equal y (a)))))
 739   (Assert (let* ((x (a)) (y (remassq   "6" x))) (and (eq x y) (equal y (a)))))
 740   (Assert (let* ((x (a)) (y (remrassoc "6" x))) (and (eq x y) (equal y (a)))))
 741   (Assert (let* ((x (a)) (y (remrassq  "6" x))) (and (eq x y) (equal y (a))))))
 742
 743 ;;-----------------------------------------------------
 744 ;; function-max-args, function-min-args
 745 ;;-----------------------------------------------------
 746 (defmacro check-function-argcounts (fun min max)
 747   `(progn
 748      (Assert (eq (function-min-args ,fun) ,min))
 749      (Assert (eq (function-max-args ,fun) ,max))))
 750
 751 (check-function-argcounts 'prog1 1 nil)         ; special form
 752 (check-function-argcounts 'command-execute 1 3) ; normal subr
 753 (check-function-argcounts 'funcall 1 nil)       ; `MANY' subr
 754 (check-function-argcounts 'garbage-collect 0 0) ; no args subr
 755
 756 ;; Test interpreted and compiled functions
 757 (loop for (arglist min max) in
 758   '(((arg1 arg2 &rest args) 2 nil)
 759     ((arg1 arg2 &optional arg3 arg4) 2 4)
 760     ((arg1 arg2 &optional arg3 arg4 &rest args) 2 nil)
 761     (() 0 0))
 762   do
 763   (eval
 764    `(progn
 765       (defun test-fun ,arglist nil)
 766       (check-function-argcounts '(lambda ,arglist nil) ,min ,max)
 767       (check-function-argcounts (byte-compile '(lambda ,arglist nil)) ,min ,max))))
 768
 769 ;;-----------------------------------------------------
 770 ;; Detection of cyclic variable indirection loops
 771 ;;-----------------------------------------------------
 772 (fset 'test-sym1 'test-sym1)
 773 (Check-Error cyclic-function-indirection (test-sym1))
 774
 775 (fset 'test-sym1 'test-sym2)
 776 (fset 'test-sym2 'test-sym1)
 777 (Check-Error cyclic-function-indirection (test-sym1))
 778 (fmakunbound 'test-sym1) ; else macroexpand-internal infloops!
 779 (fmakunbound 'test-sym2)
 780
 781 ;;-----------------------------------------------------
 782 ;; Test `type-of'
 783 ;;-----------------------------------------------------
 784 (Assert (eq (type-of load-path) 'cons))
 785 (Assert (eq (type-of obarray) 'vector))
 786 (Assert (eq (type-of 42) 'integer))
 787 (Assert (eq (type-of ?z) 'character))
 788 (Assert (eq (type-of "42") 'string))
 789 (Assert (eq (type-of 'foo) 'symbol))
 790 (Assert (eq (type-of (selected-device)) 'device))
 791
 792 ;;-----------------------------------------------------
 793 ;; Test mapping functions
 794 ;;-----------------------------------------------------
 795 (Check-Error wrong-type-argument (mapcar #'identity (current-buffer)))
 796 (Assert-Equal (mapcar #'identity load-path) load-path)
 797 (Assert-Equal (mapcar #'identity '(1 2 3)) '(1 2 3))
 798 (Assert-Equal (mapcar #'identity "123") '(?1 ?2 ?3))
 799 (Assert-Equal (mapcar #'identity [1 2 3]) '(1 2 3))
 800 (Assert-Equal (mapcar #'identity #*010) '(0 1 0))
 801
 802 (let ((z 0) (list (make-list 1000 1)))
 803   (mapc (lambda (x) (incf z x)) list)
 804   (Assert (eq 1000 z)))
 805
 806 (Check-Error wrong-type-argument (mapvector #'identity (current-buffer)))
 807 (Assert-Equal (mapvector #'identity '(1 2 3)) [1 2 3])
 808 (Assert-Equal (mapvector #'identity "123") [?1 ?2 ?3])
 809 (Assert-Equal (mapvector #'identity [1 2 3]) [1 2 3])
 810 (Assert-Equal (mapvector #'identity #*010) [0 1 0])
 811
 812 (Check-Error wrong-type-argument (mapconcat #'identity (current-buffer) "foo"))
 813 (Assert-Equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3")
 814 (Assert-Equal (mapconcat #'identity ["1" "2" "3"]  "|") "1|2|3")
 815
 816 ;; The following 2 functions used to crash XEmacs via mapcar1().
 817 ;; We don't test the actual values of the mapcar, since they're undefined.
 818 (Assert
 819  (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3))))
 820    (mapcar
 821     (lambda (y)
 822       "Devious evil mapping function"
 823       (when (eq (car y) 2) ; go out onto a limb
 824         (setcdr x nil)     ; cut it off behind us
 825         (garbage-collect)) ; are we riding a magic broomstick?
 826       (car y))             ; sorry, hard landing
 827     x)))
 828
 829 (Assert
 830  (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3))))
 831    (mapcar
 832     (lambda (y)
 833       "Devious evil mapping function"
 834       (when (eq (car y) 1)
 835         (setcdr (cdr x) 42)) ; drop a brick wall onto the freeway
 836       (car y))
 837     x)))
 838
 839 ;;-----------------------------------------------------
 840 ;; Test vector functions
 841 ;;-----------------------------------------------------
 842 (Assert-Equal [1 2 3] [1 2 3])
 843 (Assert-Equal [] [])
 844 (Assert-Not-Equal [1 2 3] [])
 845 (Assert-Not-Equal [1 2 3] [1 2 4])
 846 (Assert-Not-Equal [0 2 3] [1 2 3])
 847 (Assert-Not-Equal [1 2 3] [1 2 3 4])
 848 (Assert-Not-Equal [1 2 3 4] [1 2 3])
 849 (Assert-Equal (vector 1 2 3) [1 2 3])
 850 (Assert-Equal (make-vector 3 1) [1 1 1])
 851
 852 ;;-----------------------------------------------------
 853 ;; Test bit-vector functions
 854 ;;-----------------------------------------------------
 855 (Assert-Equal #*010 #*010)
 856 (Assert-Equal #* #*)
 857 (Assert-Not-Equal #*010 #*011)
 858 (Assert-Not-Equal #*010 #*)
 859 (Assert-Not-Equal #*110 #*010)
 860 (Assert-Not-Equal #*010 #*0100)
 861 (Assert-Not-Equal #*0101 #*010)
 862 (Assert-Equal (bit-vector 0 1 0) #*010)
 863 (Assert-Equal (make-bit-vector 3 1) #*111)
 864 (Assert-Equal (make-bit-vector 3 0) #*000)
 865
 866 ;;-----------------------------------------------------
 867 ;; Test buffer-local variables used as (ugh!) function parameters
 868 ;;-----------------------------------------------------
 869 (make-local-variable 'test-emacs-buffer-local-variable)
 870 (byte-compile
 871  (defun test-emacs-buffer-local-parameter (test-emacs-buffer-local-variable)
 872    (setq test-emacs-buffer-local-variable nil)))
 873 (test-emacs-buffer-local-parameter nil)
 874
 875 ;;-----------------------------------------------------
 876 ;; Test split-string
 877 ;;-----------------------------------------------------
 878 ;; Hrvoje didn't like these tests so I'm disabling them for now. -sb
 879 ;(Assert-Equal (split-string "foo" "") '("" "f" "o" "o" ""))
 880 ;(Assert-Equal (split-string "foo" "^") '("" "foo"))
 881 ;(Assert-Equal (split-string "foo" "$") '("foo" ""))
 882 (Assert-Equal (split-string "foo,bar" ",") '("foo" "bar"))
 883 (Assert-Equal (split-string ",foo,bar," ",") '("" "foo" "bar" ""))
 884 (Assert-Equal (split-string ",foo,bar," "^,") '("" "foo,bar,"))
 885 (Assert-Equal (split-string ",foo,bar," ",$") '(",foo,bar" ""))
 886 (Assert-Equal (split-string ",foo,,bar," ",") '("" "foo" "" "bar" ""))
 887 (Assert-Equal (split-string "foo,,,bar" ",") '("foo" "" "" "bar"))
 888 (Assert-Equal (split-string "foo,,bar,," ",") '("foo" "" "bar" "" ""))
 889 (Assert-Equal (split-string "foo,,bar" ",+") '("foo" "bar"))
 890 (Assert-Equal (split-string ",foo,,bar," ",+") '("" "foo" "bar" ""))
 891
 892 (Assert (not (string-match "\\(\\.\\=\\)" ".")))
 893 (Assert (string= "" (let ((str "test string"))
 894                       (if (string-match "^.*$" str)
 895                           (replace-match "\\U" t nil str)))))
 896 (with-temp-buffer
 897   (erase-buffer)
 898   (insert "test string")
 899   (re-search-backward "^.*$")
 900   (replace-match "\\U" t)
 901   (Assert (and (bobp) (eobp))))
 902
 903 ;;-----------------------------------------------------
 904 ;; Test near-text buffer functions.
 905 ;;-----------------------------------------------------
 906 (with-temp-buffer
 907   (erase-buffer)
 908   (Assert (eq (char-before) nil))
 909   (Assert (eq (char-before (point)) nil))
 910   (Assert (eq (char-before (point-marker)) nil))
 911   (Assert (eq (char-before (point) (current-buffer)) nil))
 912   (Assert (eq (char-before (point-marker) (current-buffer)) nil))
 913   (Assert (eq (char-after) nil))
 914   (Assert (eq (char-after (point)) nil))
 915   (Assert (eq (char-after (point-marker)) nil))
 916   (Assert (eq (char-after (point) (current-buffer)) nil))
 917   (Assert (eq (char-after (point-marker) (current-buffer)) nil))
 918   (Assert (eq (preceding-char) 0))
 919   (Assert (eq (preceding-char (current-buffer)) 0))
 920   (Assert (eq (following-char) 0))
 921   (Assert (eq (following-char (current-buffer)) 0))
 922   (insert "foobar")
 923   (Assert (eq (char-before) ?r))
 924   (Assert (eq (char-after) nil))
 925   (Assert (eq (preceding-char) ?r))
 926   (Assert (eq (following-char) 0))
 927   (goto-char (point-min))
 928   (Assert (eq (char-before) nil))
 929   (Assert (eq (char-after) ?f))
 930   (Assert (eq (preceding-char) 0))
 931   (Assert (eq (following-char) ?f))
 932   )
 933
 934 ;;-----------------------------------------------------
 935 ;; Test plist manipulation functions.
 936 ;;-----------------------------------------------------
 937 (let ((sym (make-symbol "test-symbol")))
 938   (Assert (eq t (get* sym t t)))
 939   (Assert (eq t (get  sym t t)))
 940   (Assert (eq t (getf nil t t)))
 941   (Assert (eq t (plist-get nil t t)))
 942   (put sym 'bar 'baz)
 943   (Assert (eq 'baz (get sym 'bar)))
 944   (Assert (eq 'baz (getf '(bar baz) 'bar)))
 945   (Assert (eq 'baz (getf (symbol-plist sym) 'bar)))
 946   (Assert (eq 2 (getf '(1 2) 1)))
 947   (Assert (eq 4 (put sym 3 4)))
 948   (Assert (eq 4 (get sym 3)))
 949   (Assert (eq t (remprop sym 3)))
 950   (Assert (eq nil (remprop sym 3)))
 951   (Assert (eq 5 (get sym 3 5)))
 952   )
 953
 954 (loop for obj in
 955   (list (make-symbol "test-symbol")
 956         "test-string"
 957         (make-extent nil nil nil)
 958         (make-face 'test-face))
 959   do
 960   (Assert (eq 2 (get obj ?1 2)))
 961   (Assert (eq 4 (put obj ?3 4)))
 962   (Assert (eq 4 (get obj ?3)))
 963   (when (or (stringp obj) (symbolp obj))
 964     (Assert-Equal '(?3 4) (object-plist obj)))
 965   (Assert (eq t (remprop obj ?3)))
 966   (when (or (stringp obj) (symbolp obj))
 967     (Assert (eq '() (object-plist obj))))
 968   (Assert (eq nil (remprop obj ?3)))
 969   (when (or (stringp obj) (symbolp obj))
 970     (Assert (eq '() (object-plist obj))))
 971   (Assert (eq 5 (get obj ?3 5)))
 972   )
 973
 974 (Check-Error-Message
 975  error "Object type has no properties"
 976  (get 2 'property))
 977
 978 (Check-Error-Message
 979  error "Object type has no settable properties"
 980  (put (current-buffer) 'property 'value))
 981
 982 (Check-Error-Message
 983  error "Object type has no removable properties"
 984  (remprop ?3 'property))
 985
 986 (Check-Error-Message
 987  error "Object type has no properties"
 988  (object-plist (symbol-function 'car)))
 989
 990 (Check-Error-Message
 991  error "Can't remove property from object"
 992  (remprop (make-extent nil nil nil) 'detachable))
 993
 994 ;;-----------------------------------------------------
 995 ;; Test subseq
 996 ;;-----------------------------------------------------
 997 (Assert-Equal (subseq nil 0) nil)
 998 (Assert-Equal (subseq [1 2 3] 0) [1 2 3])
 999 (Assert-Equal (subseq [1 2 3] 1 -1) [2])
1000 (Assert-Equal (subseq "123" 0) "123")
1001 (Assert-Equal (subseq "1234" -3 -1) "23")
1002 (Assert-Equal (subseq #*0011 0) #*0011)
1003 (Assert-Equal (subseq #*0011 -3 3) #*01)
1004 (Assert-Equal (subseq '(1 2 3) 0) '(1 2 3))
1005 (Assert-Equal (subseq '(1 2 3 4) -3 nil) '(2 3 4))
1006
1007 (Check-Error wrong-type-argument (subseq 3 2))
1008 (Check-Error args-out-of-range (subseq [1 2 3] -42))
1009 (Check-Error args-out-of-range (subseq [1 2 3] 0 42))
1010
1011 ;;-----------------------------------------------------
1012 ;; Time-related tests
1013 ;;-----------------------------------------------------
1014 (Assert (= (length (current-time-string)) 24))
1015
1016 ;;-----------------------------------------------------
1017 ;; format test
1018 ;;-----------------------------------------------------
1019 (Assert (string= (format "%d" 10) "10"))
1020 (Assert (string= (format "%o" 8) "10"))
1021 (Assert (string= (format "%x" 31) "1f"))
1022 (Assert (string= (format "%X" 31) "1F"))
1023 (Assert (string= (format "%e" 100) "1.000000e+02"))
1024 (Assert (string= (format "%E" 100) "1.000000E+02"))
1025 (Assert (string= (format "%f" 100) "100.000000"))
1026 (Assert (string= (format "%7.3f" 12.12345) " 12.123"))
1027 (Assert (string= (format "%07.3f" 12.12345) "012.123"))
1028 (Assert (string= (format "%-7.3f" 12.12345) "12.123 "))
1029 (Assert (string= (format "%-07.3f" 12.12345) "12.123 "))
1030 (Assert (string= (format "%g" 100.0) "100"))
1031 (Assert (string= (format "%g" 0.000001) "1e-06"))
1032 (Assert (string= (format "%g" 0.0001) "0.0001"))
1033 (Assert (string= (format "%G" 100.0) "100"))
1034 (Assert (string= (format "%G" 0.000001) "1E-06"))
1035 (Assert (string= (format "%G" 0.0001) "0.0001"))
1036
1037 (Assert (string= (format "%2$d%1$d" 10 20) "2010"))
1038 (Assert (string= (format "%-d" 10) "10"))
1039 (Assert (string= (format "%-4d" 10) "10  "))
1040 (Assert (string= (format "%+d" 10) "+10"))
1041 (Assert (string= (format "%+d" -10) "-10"))
1042 (Assert (string= (format "%+4d" 10) " +10"))
1043 (Assert (string= (format "%+4d" -10) " -10"))
1044 (Assert (string= (format "% d" 10) " 10"))
1045 (Assert (string= (format "% d" -10) "-10"))
1046 (Assert (string= (format "% 4d" 10) "  10"))
1047 (Assert (string= (format "% 4d" -10) " -10"))
1048 (Assert (string= (format "%0d" 10) "10"))
1049 (Assert (string= (format "%0d" -10) "-10"))
1050 (Assert (string= (format "%04d" 10) "0010"))
1051 (Assert (string= (format "%04d" -10) "-010"))
1052 (Assert (string= (format "%*d" 4 10) "  10"))
1053 (Assert (string= (format "%*d" 4 -10) " -10"))
1054 (Assert (string= (format "%*d" -4 10) "10  "))
1055 (Assert (string= (format "%*d" -4 -10) "-10 "))
1056 (Assert (string= (format "%#d" 10) "10"))
1057 (Assert (string= (format "%#o" 8) "0o10"))
1058 (Assert (string= (format "%#x" 16) "0x10"))
1059 (Assert (string= (format "%#e" 100) "1.000000e+02"))
1060 (Assert (string= (format "%#E" 100) "1.000000E+02"))
1061 (Assert (string= (format "%#f" 100) "100.000000"))
1062 (Assert (string= (format "%#g" 100.0) "100.000"))
1063 (Assert (string= (format "%#g" 0.000001) "1.00000e-06"))
1064 (Assert (string= (format "%#g" 0.0001) "0.000100000"))
1065 (Assert (string= (format "%#G" 100.0) "100.000"))
1066 (Assert (string= (format "%#G" 0.000001) "1.00000E-06"))
1067 (Assert (string= (format "%#G" 0.0001) "0.000100000"))
1068 (Assert (string= (format "%.1d" 10) "10"))
1069 (Assert (string= (format "%.4d" 10) "0010"))
1070 ;; Combination of `-', `+', ` ', `0', `#', `.', `*'
1071 (Assert (string= (format "%-04d" 10) "10  "))
1072 (Assert (string= (format "%-*d" 4 10) "10  "))
1073 ;; #### Correctness of this behavior is questionable.
1074 ;; It might be better to signal error.
1075 (Assert (string= (format "%-*d" -4 10) "10  "))
1076 ;; These behavior is not specified.
1077 ;; (format "%-+d" 10)
1078 ;; (format "%- d" 10)
1079 ;; (format "%-01d" 10)
1080 ;; (format "%-#4x" 10)
1081 ;; (format "%-.1d" 10)
1082
1083 (Assert (string= (format "%01.1d" 10) "10"))
1084 (Assert (string= (format "%03.1d" 10) " 10"))
1085 (Assert (string= (format "%01.3d" 10) "010"))
1086 (Assert (string= (format "%1.3d" 10) "010"))
1087 (Assert (string= (format "%3.1d" 10) " 10"))
1088
1089 ;;; The following two tests used to use 1000 instead of 100,
1090 ;;; but that merely found buffer overflow bugs in Solaris sprintf().
1091 (Assert (= 102 (length (format "%.100f" 3.14))))
1092 (Assert (= 100 (length (format "%100f" 3.14))))
1093
1094 ;;; Check for 64-bit cleanness on LP64 platforms.
1095 (Assert (= (read (format "%d"  most-positive-fixnum)) most-positive-fixnum))
1096 (Assert (= (read (format "%ld" most-positive-fixnum)) most-positive-fixnum))
1097 (Assert (= (read (format "%d"  most-negative-fixnum)) most-negative-fixnum))
1098 (Assert (= (read (format "%ld" most-negative-fixnum)) most-negative-fixnum))
1099
1100 ;;; "%u" was undocumented, and support for it has been dropped
1101 (Check-Error-Message error "Invalid converter character"
1102                      (format "%u"  most-positive-fixnum))
1103 (Check-Error-Message error "Invalid converter character"
1104                      (format "%u" most-negative-fixnum))
1105
1106 ;; Check all-completions ignore element start with space.
1107 (Assert (not (all-completions "" '((" hidden" . "object")))))
1108 (Assert (all-completions " " '((" hidden" . "object"))))