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