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