git.chise.org Git - chise/xemacs-chise.git-/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 (= (- 0 one) -1))
 247   (Assert (= (- 0 one one) -2))
 248   (Assert (= (+ one 1) 2))
 249   (dolist (zero '(0 0.0 ?\0))
 250     (Assert (= (+ 1 zero) 1))
 251     (Assert (= (+ zero 1) 1))
 252     (Assert (= (- zero) zero))
 253     (Assert (= (- zero) 0))
 254     (Assert (= (- zero zero) 0))
 255     (Assert (= (- zero one one) -2))))
 256
 257 (Assert (= (- 1.5 1) .5))
 258 (Assert (= (- 1 1.5) (- .5)))
 259
 260 (Assert (eq (1- most-negative-fixnum) most-positive-fixnum))
 261 (Assert (eq (- most-negative-fixnum 1) most-positive-fixnum))
 262
 263 ;; Test `/'
 264
 265 ;; Test division by zero errors
 266 (dolist (zero '(0 0.0 ?\0))
 267   (Check-Error arith-error (/ zero))
 268   (dolist (n1 `(42 42.0 ?\042 ,(Int-to-Marker 42)))
 269     (Check-Error arith-error (/ n1 zero))
 270     (dolist (n2 `(3 3.0 ?\03 ,(Int-to-Marker 3)))
 271       (Check-Error arith-error (/ n1 n2 zero)))))
 272
 273 ;; Other tests for `/'
 274 (Check-Error wrong-number-of-arguments (/))
 275 (let (x)
 276   (Assert (= (/ (setq x 2))   0))
 277   (Assert (= (/ (setq x 2.0)) 0.5)))
 278
 279 (dolist (six '(6 6.0 ?\06))
 280   (dolist (two '(2 2.0 ?\02))
 281     (dolist (three '(3 3.0 ?\03))
 282       (Assert (= (/ six two) three)))))
 283
 284 (dolist (three '(3 3.0 ?\03))
 285   (Assert (= (/ three 2.0) 1.5)))
 286 (dolist (two '(2 2.0 ?\02))
 287   (Assert (= (/ 3.0 two) 1.5)))
 288
 289 ;; Test `*'
 290 (Assert (= 1 (*)))
 291
 292 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
 293   (Assert (= 1 (* one))))
 294
 295 (dolist (two '(2 2.0 ?\02))
 296   (Assert (= 2 (* two))))
 297
 298 (dolist (six '(6 6.0 ?\06))
 299   (dolist (two '(2 2.0 ?\02))
 300     (dolist (three '(3 3.0 ?\03))
 301       (Assert (= (* three two) six)))))
 302
 303 (dolist (three '(3 3.0 ?\03))
 304   (dolist (two '(2 2.0 ?\02))
 305     (Assert (= (* 1.5 two) three))
 306     (dolist (five '(5 5.0 ?\05))
 307       (Assert (= 30 (* five two three))))))
 308
 309 ;; Test `+'
 310 (Assert (= 0 (+)))
 311
 312 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
 313   (Assert (= 1 (+ one))))
 314
 315 (dolist (two '(2 2.0 ?\02))
 316   (Assert (= 2 (+ two))))
 317
 318 (dolist (five '(5 5.0 ?\05))
 319   (dolist (two '(2 2.0 ?\02))
 320     (dolist (three '(3 3.0 ?\03))
 321       (Assert (= (+ three two) five))
 322       (Assert (= 10 (+ five two three))))))
 323
 324 ;; Test `max', `min'
 325 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
 326   (Assert (= one (max one)))
 327   (Assert (= one (max one one)))
 328   (Assert (= one (max one one one)))
 329   (Assert (= one (min one)))
 330   (Assert (= one (min one one)))
 331   (Assert (= one (min one one one)))
 332   (dolist (two `(2 2.0 ?\02 ,(Int-to-Marker 2)))
 333     (Assert (= one (min one two)))
 334     (Assert (= one (min one two two)))
 335     (Assert (= one (min two two one)))
 336     (Assert (= two (max one two)))
 337     (Assert (= two (max one two two)))
 338     (Assert (= two (max two two one)))))
 339
 340 ;; The byte compiler has special handling for these constructs:
 341 (let ((three 3) (five 5))
 342   (Assert (= (+ three five 1) 9))
 343   (Assert (= (+ 1 three five) 9))
 344   (Assert (= (+ three five -1) 7))
 345   (Assert (= (+ -1 three five) 7))
 346   (Assert (= (+ three 1) 4))
 347   (Assert (= (+ three -1) 2))
 348   (Assert (= (+ -1 three) 2))
 349   (Assert (= (+ -1 three) 2))
 350   (Assert (= (- three five 1) -3))
 351   (Assert (= (- 1 three five) -7))
 352   (Assert (= (- three five -1) -1))
 353   (Assert (= (- -1 three five) -9))
 354   (Assert (= (- three 1) 2))
 355   (Assert (= (- three 2 1) 0))
 356   (Assert (= (- 2 three 1) -2))
 357   (Assert (= (- three -1) 4))
 358   (Assert (= (- three 0) 3))
 359   (Assert (= (- three 0 five) -2))
 360   (Assert (= (- 0 three 0 five) -8))
 361   (Assert (= (- 0 three five) -8))
 362   (Assert (= (* three 2) 6))
 363   (Assert (= (* three -1 five) -15))
 364   (Assert (= (* three 1 five) 15))
 365   (Assert (= (* three 0 five) 0))
 366   (Assert (= (* three 2 five) 30))
 367   (Assert (= (/ three 1) 3))
 368   (Assert (= (/ three -1) -3))
 369   (Assert (= (/ (* five five) 2 2) 6))
 370   (Assert (= (/ 64 five 2) 6)))
 371
 372
 373 ;;-----------------------------------------------------
 374 ;; Logical bit-twiddling operations
 375 ;;-----------------------------------------------------
 376 (Assert (= (logxor)  0))
 377 (Assert (= (logior)  0))
 378 (Assert (= (logand) -1))
 379
 380 (Check-Error wrong-type-argument (logxor 3.0))
 381 (Check-Error wrong-type-argument (logior 3.0))
 382 (Check-Error wrong-type-argument (logand 3.0))
 383
 384 (dolist (three '(3 ?\03))
 385   (Assert (eq 3 (logand three)))
 386   (Assert (eq 3 (logxor three)))
 387   (Assert (eq 3 (logior three)))
 388   (Assert (eq 3 (logand three three)))
 389   (Assert (eq 0 (logxor three three)))
 390   (Assert (eq 3 (logior three three))))
 391
 392 (dolist (one `(1 ?\01 ,(Int-to-Marker 1)))
 393   (dolist (two '(2 ?\02))
 394     (Assert (eq 0 (logand one two)))
 395     (Assert (eq 3 (logior one two)))
 396     (Assert (eq 3 (logxor one two))))
 397   (dolist (three '(3 ?\03))
 398     (Assert (eq 1 (logand one three)))
 399     (Assert (eq 3 (logior one three)))
 400     (Assert (eq 2 (logxor one three)))))
 401
 402 ;;-----------------------------------------------------
 403 ;; Test `%', mod
 404 ;;-----------------------------------------------------
 405 (Check-Error wrong-number-of-arguments (%))
 406 (Check-Error wrong-number-of-arguments (% 1))
 407 (Check-Error wrong-number-of-arguments (% 1 2 3))
 408
 409 (Check-Error wrong-number-of-arguments (mod))
 410 (Check-Error wrong-number-of-arguments (mod 1))
 411 (Check-Error wrong-number-of-arguments (mod 1 2 3))
 412
 413 (Check-Error wrong-type-argument (% 10.0 2))
 414 (Check-Error wrong-type-argument (% 10 2.0))
 415
 416 (dotimes (j 30)
 417   (let ((x (- (random) (random))))
 418     (Assert (eq x (+ (% x 17) (* (/ x 17) 17))))
 419     (Assert (eq (- x) (+ (% (- x) 17) (* (/ (- x) 17) 17))))
 420     (Assert (eq (% x -17) (- (% (- x) 17))))
 421     ))
 422
 423 (macrolet
 424     ((division-test (seven)
 425     `(progn
 426        (Assert (eq (% ,seven      2)  1))
 427        (Assert (eq (% ,seven     -2)  1))
 428        (Assert (eq (% (- ,seven)  2) -1))
 429        (Assert (eq (% (- ,seven) -2) -1))
 430
 431        (Assert (eq (% ,seven      4)  3))
 432        (Assert (eq (% ,seven     -4)  3))
 433        (Assert (eq (% (- ,seven)  4) -3))
 434        (Assert (eq (% (- ,seven) -4) -3))
 435
 436        (Assert (eq (%  35 ,seven)     0))
 437        (Assert (eq (% -35 ,seven)     0))
 438        (Assert (eq (%  35 (- ,seven)) 0))
 439        (Assert (eq (% -35 (- ,seven)) 0))
 440
 441        (Assert (eq (mod ,seven      2)  1))
 442        (Assert (eq (mod ,seven     -2) -1))
 443        (Assert (eq (mod (- ,seven)  2)  1))
 444        (Assert (eq (mod (- ,seven) -2) -1))
 445
 446        (Assert (eq (mod ,seven      4)  3))
 447        (Assert (eq (mod ,seven     -4) -1))
 448        (Assert (eq (mod (- ,seven)  4)  1))
 449        (Assert (eq (mod (- ,seven) -4) -3))
 450
 451        (Assert (eq (mod  35 ,seven)     0))
 452        (Assert (eq (mod -35 ,seven)     0))
 453        (Assert (eq (mod  35 (- ,seven)) 0))
 454        (Assert (eq (mod -35 (- ,seven)) 0))
 455
 456        (Assert (= (mod ,seven      2.0)  1.0))
 457        (Assert (= (mod ,seven     -2.0) -1.0))
 458        (Assert (= (mod (- ,seven)  2.0)  1.0))
 459        (Assert (= (mod (- ,seven) -2.0) -1.0))
 460
 461        (Assert (= (mod ,seven      4.0)  3.0))
 462        (Assert (= (mod ,seven     -4.0) -1.0))
 463        (Assert (= (mod (- ,seven)  4.0)  1.0))
 464        (Assert (= (mod (- ,seven) -4.0) -3.0))
 465
 466        (Assert (eq (% 0 ,seven) 0))
 467        (Assert (eq (% 0 (- ,seven)) 0))
 468
 469        (Assert (eq (mod 0 ,seven) 0))
 470        (Assert (eq (mod 0 (- ,seven)) 0))
 471
 472        (Assert (= (mod 0.0 ,seven) 0.0))
 473        (Assert (= (mod 0.0 (- ,seven)) 0.0)))))
 474
 475   (division-test 7)
 476   (division-test ?\07)
 477   (division-test (Int-to-Marker 7)))
 478
 479
 480
 481 ;;-----------------------------------------------------
 482 ;; Arithmetic comparison operations
 483 ;;-----------------------------------------------------
 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 (Check-Error wrong-number-of-arguments (>=))
 489 (Check-Error wrong-number-of-arguments (/=))
 490
 491 ;; One argument always yields t
 492 (loop for x in `(1 1.0 ,(Int-to-Marker 1) ?z) do
 493   (Assert (eq t (=  x)))
 494   (Assert (eq t (<  x)))
 495   (Assert (eq t (>  x)))
 496   (Assert (eq t (>= x)))
 497   (Assert (eq t (<= x)))
 498   (Assert (eq t (/= x)))
 499   )
 500
 501 ;; Type checking
 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 (Check-Error wrong-type-argument (>  'foo 1))
 507 (Check-Error wrong-type-argument (/= 'foo 1))
 508
 509 ;; Meat
 510 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
 511   (dolist (two '(2 2.0 ?\02))
 512     (Assert (<  one two))
 513     (Assert (<= one two))
 514     (Assert (<= two two))
 515     (Assert (>  two one))
 516     (Assert (>= two one))
 517     (Assert (>= two two))
 518     (Assert (/= one two))
 519     (Assert (not (/= two two)))
 520     (Assert (not (< one one)))
 521     (Assert (not (> one one)))
 522     (Assert (<= one one two two))
 523     (Assert (not (< one one two two)))
 524     (Assert (>= two two one one))
 525     (Assert (not (> two two one one)))
 526     (Assert (= one one one))
 527     (Assert (not (= one one one two)))
 528     (Assert (not (/= one two one)))
 529     ))
 530
 531 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
 532   (dolist (two '(2 2.0 ?\02))
 533     (Assert (<  one two))
 534     (Assert (<= one two))
 535     (Assert (<= two two))
 536     (Assert (>  two one))
 537     (Assert (>= two one))
 538     (Assert (>= two two))
 539     (Assert (/= one two))
 540     (Assert (not (/= two two)))
 541     (Assert (not (< one one)))
 542     (Assert (not (> one one)))
 543     (Assert (<= one one two two))
 544     (Assert (not (< one one two two)))
 545     (Assert (>= two two one one))
 546     (Assert (not (> two two one one)))
 547     (Assert (= one one one))
 548     (Assert (not (= one one one two)))
 549     (Assert (not (/= one two one)))
 550     ))
 551
 552 ;; ad-hoc
 553 (Assert (< 1 2))
 554 (Assert (< 1 2 3 4 5 6))
 555 (Assert (not (< 1 1)))
 556 (Assert (not (< 2 1)))
 557
 558
 559 (Assert (not (< 1 1)))
 560 (Assert (< 1 2 3 4 5 6))
 561 (Assert (<= 1 2 3 4 5 6))
 562 (Assert (<= 1 2 3 4 5 6 6))
 563 (Assert (not (< 1 2 3 4 5 6 6)))
 564 (Assert (<= 1 1))
 565
 566 (Assert (not (eq (point) (point-marker))))
 567 (Assert (= 1 (Int-to-Marker 1)))
 568 (Assert (= (point) (point-marker)))
 569
 570 ;;-----------------------------------------------------
 571 ;; testing list-walker functions
 572 ;;-----------------------------------------------------
 573 (macrolet
 574     ((test-fun
 575       (fun)
 576       `(progn
 577          (Check-Error wrong-number-of-arguments (,fun))
 578          (Check-Error wrong-number-of-arguments (,fun nil))
 579          (Check-Error malformed-list (,fun nil 1))
 580          ,@(loop for n in '(1 2 2000)
 581              collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n))))))
 582      (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun)))))
 583
 584   (test-funs member old-member
 585              memq   old-memq
 586              assoc  old-assoc
 587              rassoc old-rassoc
 588              rassq  old-rassq
 589              delete old-delete
 590              delq   old-delq
 591              remassoc remassq remrassoc remrassq))
 592
 593 (let ((x '((1 . 2) 3 (4 . 5))))
 594   (Assert (eq (assoc  1 x) (car x)))
 595   (Assert (eq (assq   1 x) (car x)))
 596   (Assert (eq (rassoc 1 x) nil))
 597   (Assert (eq (rassq  1 x) nil))
 598   (Assert (eq (assoc  2 x) nil))
 599   (Assert (eq (assq   2 x) nil))
 600   (Assert (eq (rassoc 2 x) (car x)))
 601   (Assert (eq (rassq  2 x) (car x)))
 602   (Assert (eq (assoc  3 x) nil))
 603   (Assert (eq (assq   3 x) nil))
 604   (Assert (eq (rassoc 3 x) nil))
 605   (Assert (eq (rassq  3 x) nil))
 606   (Assert (eq (assoc  4 x) (caddr x)))
 607   (Assert (eq (assq   4 x) (caddr x)))
 608   (Assert (eq (rassoc 4 x) nil))
 609   (Assert (eq (rassq  4 x) nil))
 610   (Assert (eq (assoc  5 x) nil))
 611   (Assert (eq (assq   5 x) nil))
 612   (Assert (eq (rassoc 5 x) (caddr x)))
 613   (Assert (eq (rassq  5 x) (caddr x)))
 614   (Assert (eq (assoc  6 x) nil))
 615   (Assert (eq (assq   6 x) nil))
 616   (Assert (eq (rassoc 6 x) nil))
 617   (Assert (eq (rassq  6 x) nil)))
 618
 619 (let ((x '(("1" . "2") "3" ("4" . "5"))))
 620   (Assert (eq (assoc  "1" x) (car x)))
 621   (Assert (eq (assq   "1" x) nil))
 622   (Assert (eq (rassoc "1" x) nil))
 623   (Assert (eq (rassq  "1" x) nil))
 624   (Assert (eq (assoc  "2" x) nil))
 625   (Assert (eq (assq   "2" x) nil))
 626   (Assert (eq (rassoc "2" x) (car x)))
 627   (Assert (eq (rassq  "2" x) nil))
 628   (Assert (eq (assoc  "3" x) nil))
 629   (Assert (eq (assq   "3" x) nil))
 630   (Assert (eq (rassoc "3" x) nil))
 631   (Assert (eq (rassq  "3" x) nil))
 632   (Assert (eq (assoc  "4" x) (caddr x)))
 633   (Assert (eq (assq   "4" x) nil))
 634   (Assert (eq (rassoc "4" x) nil))
 635   (Assert (eq (rassq  "4" x) nil))
 636   (Assert (eq (assoc  "5" x) nil))
 637   (Assert (eq (assq   "5" x) nil))
 638   (Assert (eq (rassoc "5" x) (caddr x)))
 639   (Assert (eq (rassq  "5" x) nil))
 640   (Assert (eq (assoc  "6" x) nil))
 641   (Assert (eq (assq   "6" x) nil))
 642   (Assert (eq (rassoc "6" x) nil))
 643   (Assert (eq (rassq  "6" x) nil)))
 644
 645 (flet ((a () (list '(1 . 2) 3 '(4 . 5))))
 646   (Assert (let* ((x (a)) (y (remassoc  1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
 647   (Assert (let* ((x (a)) (y (remassq   1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
 648   (Assert (let* ((x (a)) (y (remrassoc 1 x))) (and (eq x y) (equal y (a)))))
 649   (Assert (let* ((x (a)) (y (remrassq  1 x))) (and (eq x y) (equal y (a)))))
 650
 651   (Assert (let* ((x (a)) (y (remassoc  2 x))) (and (eq x y) (equal y (a)))))
 652   (Assert (let* ((x (a)) (y (remassq   2 x))) (and (eq x y) (equal y (a)))))
 653   (Assert (let* ((x (a)) (y (remrassoc 2 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
 654   (Assert (let* ((x (a)) (y (remrassq  2 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
 655
 656   (Assert (let* ((x (a)) (y (remassoc  3 x))) (and (eq x y) (equal y (a)))))
 657   (Assert (let* ((x (a)) (y (remassq   3 x))) (and (eq x y) (equal y (a)))))
 658   (Assert (let* ((x (a)) (y (remrassoc 3 x))) (and (eq x y) (equal y (a)))))
 659   (Assert (let* ((x (a)) (y (remrassq  3 x))) (and (eq x y) (equal y (a)))))
 660
 661   (Assert (let* ((x (a)) (y (remassoc  4 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
 662   (Assert (let* ((x (a)) (y (remassq   4 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
 663   (Assert (let* ((x (a)) (y (remrassoc 4 x))) (and (eq x y) (equal y (a)))))
 664   (Assert (let* ((x (a)) (y (remrassq  4 x))) (and (eq x y) (equal y (a)))))
 665
 666   (Assert (let* ((x (a)) (y (remassoc  5 x))) (and (eq x y) (equal y (a)))))
 667   (Assert (let* ((x (a)) (y (remassq   5 x))) (and (eq x y) (equal y (a)))))
 668   (Assert (let* ((x (a)) (y (remrassoc 5 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
 669   (Assert (let* ((x (a)) (y (remrassq  5 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
 670
 671   (Assert (let* ((x (a)) (y (remassoc  6 x))) (and (eq x y) (equal y (a)))))
 672   (Assert (let* ((x (a)) (y (remassq   6 x))) (and (eq x y) (equal y (a)))))
 673   (Assert (let* ((x (a)) (y (remrassoc 6 x))) (and (eq x y) (equal y (a)))))
 674   (Assert (let* ((x (a)) (y (remrassq  6 x))) (and (eq x y) (equal y (a)))))
 675
 676   (Assert (let* ((x (a)) (y (delete     3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
 677   (Assert (let* ((x (a)) (y (delq       3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
 678   (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
 679   (Assert (let* ((x (a)) (y (old-delq   3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
 680
 681   (Assert (let* ((x (a)) (y (delete     '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
 682   (Assert (let* ((x (a)) (y (delq       '(1 . 2) x))) (and      (eq x y)  (equal y (a)))))
 683   (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
 684   (Assert (let* ((x (a)) (y (old-delq   '(1 . 2) x))) (and      (eq x y)  (equal y (a)))))
 685   )
 686
 687
 688
 689 (flet ((a () (list '("1" . "2") "3" '("4" . "5"))))
 690   (Assert (let* ((x (a)) (y (remassoc  "1" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
 691   (Assert (let* ((x (a)) (y (remassq   "1" x))) (and (eq x y) (equal y (a)))))
 692   (Assert (let* ((x (a)) (y (remrassoc "1" x))) (and (eq x y) (equal y (a)))))
 693   (Assert (let* ((x (a)) (y (remrassq  "1" x))) (and (eq x y) (equal y (a)))))
 694
 695   (Assert (let* ((x (a)) (y (remassoc  "2" x))) (and (eq x y) (equal y (a)))))
 696   (Assert (let* ((x (a)) (y (remassq   "2" x))) (and (eq x y) (equal y (a)))))
 697   (Assert (let* ((x (a)) (y (remrassoc "2" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
 698   (Assert (let* ((x (a)) (y (remrassq  "2" x))) (and (eq x y) (equal y (a)))))
 699
 700   (Assert (let* ((x (a)) (y (remassoc  "3" x))) (and (eq x y) (equal y (a)))))
 701   (Assert (let* ((x (a)) (y (remassq   "3" x))) (and (eq x y) (equal y (a)))))
 702   (Assert (let* ((x (a)) (y (remrassoc "3" x))) (and (eq x y) (equal y (a)))))
 703   (Assert (let* ((x (a)) (y (remrassq  "3" x))) (and (eq x y) (equal y (a)))))
 704
 705   (Assert (let* ((x (a)) (y (remassoc  "4" x))) (and (eq x y) (equal y '(("1" . "2") "3")))))
 706   (Assert (let* ((x (a)) (y (remassq   "4" x))) (and (eq x y) (equal y (a)))))
 707   (Assert (let* ((x (a)) (y (remrassoc "4" x))) (and (eq x y) (equal y (a)))))
 708   (Assert (let* ((x (a)) (y (remrassq  "4" x))) (and (eq x y) (equal y (a)))))
 709
 710   (Assert (let* ((x (a)) (y (remassoc  "5" x))) (and (eq x y) (equal y (a)))))
 711   (Assert (let* ((x (a)) (y (remassq   "5" x))) (and (eq x y) (equal y (a)))))
 712   (Assert (let* ((x (a)) (y (remrassoc "5" x))) (and (eq x y) (equal y '(("1" . "2") "3")))))
 713   (Assert (let* ((x (a)) (y (remrassq  "5" x))) (and (eq x y) (equal y (a)))))
 714
 715   (Assert (let* ((x (a)) (y (remassoc  "6" x))) (and (eq x y) (equal y (a)))))
 716   (Assert (let* ((x (a)) (y (remassq   "6" x))) (and (eq x y) (equal y (a)))))
 717   (Assert (let* ((x (a)) (y (remrassoc "6" x))) (and (eq x y) (equal y (a)))))
 718   (Assert (let* ((x (a)) (y (remrassq  "6" x))) (and (eq x y) (equal y (a))))))
 719
 720 ;;-----------------------------------------------------
 721 ;; function-max-args, function-min-args
 722 ;;-----------------------------------------------------
 723 (defmacro check-function-argcounts (fun min max)
 724   `(progn
 725      (Assert (eq (function-min-args ,fun) ,min))
 726      (Assert (eq (function-max-args ,fun) ,max))))
 727
 728 (check-function-argcounts 'prog1 1 nil)         ; special form
 729 (check-function-argcounts 'command-execute 1 3) ; normal subr
 730 (check-function-argcounts 'funcall 1 nil)       ; `MANY' subr
 731 (check-function-argcounts 'garbage-collect 0 0) ; no args subr
 732
 733 ;; Test interpreted and compiled functions
 734 (loop for (arglist min max) in
 735   '(((arg1 arg2 &rest args) 2 nil)
 736     ((arg1 arg2 &optional arg3 arg4) 2 4)
 737     ((arg1 arg2 &optional arg3 arg4 &rest args) 2 nil)
 738     (() 0 0))
 739   do
 740   (eval
 741    `(progn
 742       (defun test-fun ,arglist nil)
 743       (check-function-argcounts '(lambda ,arglist nil) ,min ,max)
 744       (check-function-argcounts (byte-compile '(lambda ,arglist nil)) ,min ,max))))
 745
 746 ;;-----------------------------------------------------
 747 ;; Detection of cyclic variable indirection loops
 748 ;;-----------------------------------------------------
 749 (fset 'test-sym1 'test-sym1)
 750 (Check-Error cyclic-function-indirection (test-sym1))
 751
 752 (fset 'test-sym1 'test-sym2)
 753 (fset 'test-sym2 'test-sym1)
 754 (Check-Error cyclic-function-indirection (test-sym1))
 755 (fmakunbound 'test-sym1) ; else macroexpand-internal infloops!
 756 (fmakunbound 'test-sym2)
 757
 758 ;;-----------------------------------------------------
 759 ;; Test `type-of'
 760 ;;-----------------------------------------------------
 761 (Assert (eq (type-of load-path) 'cons))
 762 (Assert (eq (type-of obarray) 'vector))
 763 (Assert (eq (type-of 42) 'integer))
 764 (Assert (eq (type-of ?z) 'character))
 765 (Assert (eq (type-of "42") 'string))
 766 (Assert (eq (type-of 'foo) 'symbol))
 767 (Assert (eq (type-of (selected-device)) 'device))
 768
 769 ;;-----------------------------------------------------
 770 ;; Test mapping functions
 771 ;;-----------------------------------------------------
 772 (Check-Error wrong-type-argument (mapcar #'identity (current-buffer)))
 773 (Assert (equal (mapcar #'identity load-path) load-path))
 774 (Assert (equal (mapcar #'identity '(1 2 3)) '(1 2 3)))
 775 (Assert (equal (mapcar #'identity "123") '(?1 ?2 ?3)))
 776 (Assert (equal (mapcar #'identity [1 2 3]) '(1 2 3)))
 777 (Assert (equal (mapcar #'identity #*010) '(0 1 0)))
 778
 779 (let ((z 0) (list (make-list 1000 1)))
 780   (mapc (lambda (x) (incf z x)) list)
 781   (Assert (eq 1000 z)))
 782
 783 (Check-Error wrong-type-argument (mapvector #'identity (current-buffer)))
 784 (Assert (equal (mapvector #'identity '(1 2 3)) [1 2 3]))
 785 (Assert (equal (mapvector #'identity "123") [?1 ?2 ?3]))
 786 (Assert (equal (mapvector #'identity [1 2 3]) [1 2 3]))
 787 (Assert (equal (mapvector #'identity #*010) [0 1 0]))
 788
 789 (Check-Error wrong-type-argument (mapconcat #'identity (current-buffer) "foo"))
 790 (Assert (equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3"))
 791 (Assert (equal (mapconcat #'identity ["1" "2" "3"]  "|") "1|2|3"))
 792
 793 ;; The following 2 functions used to crash XEmacs via mapcar1().
 794 ;; We don't test the actual values of the mapcar, since they're undefined.
 795 (Assert
 796  (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3))))
 797    (mapcar
 798     (lambda (y)
 799       "Devious evil mapping function"
 800       (when (eq (car y) 2) ; go out onto a limb
 801         (setcdr x nil)     ; cut it off behind us
 802         (garbage-collect)) ; are we riding a magic broomstick?
 803       (car y))             ; sorry, hard landing
 804     x)))
 805
 806 (Assert
 807  (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3))))
 808    (mapcar
 809     (lambda (y)
 810       "Devious evil mapping function"
 811       (when (eq (car y) 1)
 812         (setcdr (cdr x) 42)) ; drop a brick wall onto the freeway
 813       (car y))
 814     x)))
 815
 816 ;;-----------------------------------------------------
 817 ;; Test vector functions
 818 ;;-----------------------------------------------------
 819 (Assert (equal [1 2 3] [1 2 3]))
 820 (Assert (equal [] []))
 821 (Assert (not (equal [1 2 3] [])))
 822 (Assert (not (equal [1 2 3] [1 2 4])))
 823 (Assert (not (equal [0 2 3] [1 2 3])))
 824 (Assert (not (equal [1 2 3] [1 2 3 4])))
 825 (Assert (not (equal [1 2 3 4] [1 2 3])))
 826 (Assert (equal (vector 1 2 3) [1 2 3]))
 827 (Assert (equal (make-vector 3 1) [1 1 1]))
 828
 829 ;;-----------------------------------------------------
 830 ;; Test bit-vector functions
 831 ;;-----------------------------------------------------
 832 (Assert (equal #*010 #*010))
 833 (Assert (equal #* #*))
 834 (Assert (not (equal #*010 #*011)))
 835 (Assert (not (equal #*010 #*)))
 836 (Assert (not (equal #*110 #*010)))
 837 (Assert (not (equal #*010 #*0100)))
 838 (Assert (not (equal #*0101 #*010)))
 839 (Assert (equal (bit-vector 0 1 0) #*010))
 840 (Assert (equal (make-bit-vector 3 1) #*111))
 841 (Assert (equal (make-bit-vector 3 0) #*000))
 842
 843 ;;-----------------------------------------------------
 844 ;; Test buffer-local variables used as (ugh!) function parameters
 845 ;;-----------------------------------------------------
 846 (make-local-variable 'test-emacs-buffer-local-variable)
 847 (byte-compile
 848  (defun test-emacs-buffer-local-parameter (test-emacs-buffer-local-variable)
 849    (setq test-emacs-buffer-local-variable nil)))
 850 (test-emacs-buffer-local-parameter nil)
 851
 852 ;;-----------------------------------------------------
 853 ;; Test split-string
 854 ;;-----------------------------------------------------
 855 ;; Hrvoje didn't like these tests so I'm disabling them for now. -sb
 856 ;(Assert (equal (split-string "foo" "") '("" "f" "o" "o" "")))
 857 ;(Assert (equal (split-string "foo" "^") '("" "foo")))
 858 ;(Assert (equal (split-string "foo" "$") '("foo" "")))
 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 (Assert (equal (split-string "foo,,bar" ",+") '("foo" "bar")))
 867 (Assert (equal (split-string ",foo,,bar," ",+") '("" "foo" "bar" "")))
 868
 869 (Assert (not (string-match "\\(\\.\\=\\)" ".")))
 870 (Assert (string= "" (let ((str "test string"))
 871                       (if (string-match "^.*$" str)
 872                           (replace-match "\\U" t nil str)))))
 873 (with-temp-buffer
 874   (erase-buffer)
 875   (insert "test string")
 876   (re-search-backward "^.*$")
 877   (replace-match "\\U" t)
 878   (Assert (and (bobp) (eobp))))
 879
 880 ;;-----------------------------------------------------
 881 ;; Test near-text buffer functions.
 882 ;;-----------------------------------------------------
 883 (with-temp-buffer
 884   (erase-buffer)
 885   (Assert (eq (char-before) nil))
 886   (Assert (eq (char-before (point)) nil))
 887   (Assert (eq (char-before (point-marker)) nil))
 888   (Assert (eq (char-before (point) (current-buffer)) nil))
 889   (Assert (eq (char-before (point-marker) (current-buffer)) nil))
 890   (Assert (eq (char-after) nil))
 891   (Assert (eq (char-after (point)) nil))
 892   (Assert (eq (char-after (point-marker)) nil))
 893   (Assert (eq (char-after (point) (current-buffer)) nil))
 894   (Assert (eq (char-after (point-marker) (current-buffer)) nil))
 895   (Assert (eq (preceding-char) 0))
 896   (Assert (eq (preceding-char (current-buffer)) 0))
 897   (Assert (eq (following-char) 0))
 898   (Assert (eq (following-char (current-buffer)) 0))
 899   (insert "foobar")
 900   (Assert (eq (char-before) ?r))
 901   (Assert (eq (char-after) nil))
 902   (Assert (eq (preceding-char) ?r))
 903   (Assert (eq (following-char) 0))
 904   (goto-char (point-min))
 905   (Assert (eq (char-before) nil))
 906   (Assert (eq (char-after) ?f))
 907   (Assert (eq (preceding-char) 0))
 908   (Assert (eq (following-char) ?f))
 909   )
 910
 911 ;;-----------------------------------------------------
 912 ;; Test plist manipulation functions.
 913 ;;-----------------------------------------------------
 914 (let ((sym (make-symbol "test-symbol")))
 915   (Assert (eq t (get* sym t t)))
 916   (Assert (eq t (get  sym t t)))
 917   (Assert (eq t (getf nil t t)))
 918   (Assert (eq t (plist-get nil t t)))
 919   (put sym 'bar 'baz)
 920   (Assert (eq 'baz (get sym 'bar)))
 921   (Assert (eq 'baz (getf '(bar baz) 'bar)))
 922   (Assert (eq 'baz (getf (symbol-plist sym) 'bar)))
 923   (Assert (eq 2 (getf '(1 2) 1)))
 924   (Assert (eq 4 (put sym 3 4)))
 925   (Assert (eq 4 (get sym 3)))
 926   (Assert (eq t (remprop sym 3)))
 927   (Assert (eq nil (remprop sym 3)))
 928   (Assert (eq 5 (get sym 3 5)))
 929   )
 930
 931 (loop for obj in
 932   (list (make-symbol "test-symbol")
 933         "test-string"
 934         (make-extent nil nil nil)
 935         (make-face 'test-face))
 936   do
 937   (Assert (eq 2 (get obj ?1 2)))
 938   (Assert (eq 4 (put obj ?3 4)))
 939   (Assert (eq 4 (get obj ?3)))
 940   (when (or (stringp obj) (symbolp obj))
 941     (Assert (equal '(?3 4) (object-plist obj))))
 942   (Assert (eq t (remprop obj ?3)))
 943   (when (or (stringp obj) (symbolp obj))
 944     (Assert (eq '() (object-plist obj))))
 945   (Assert (eq nil (remprop obj ?3)))
 946   (when (or (stringp obj) (symbolp obj))
 947     (Assert (eq '() (object-plist obj))))
 948   (Assert (eq 5 (get obj ?3 5)))
 949   )
 950
 951 (Check-Error-Message
 952  error "Object type has no properties"
 953  (get 2 'property))
 954
 955 (Check-Error-Message
 956  error "Object type has no settable properties"
 957  (put (current-buffer) 'property 'value))
 958
 959 (Check-Error-Message
 960  error "Object type has no removable properties"
 961  (remprop ?3 'property))
 962
 963 (Check-Error-Message
 964  error "Object type has no properties"
 965  (object-plist (symbol-function 'car)))
 966
 967 (Check-Error-Message
 968  error "Can't remove property from object"
 969  (remprop (make-extent nil nil nil) 'detachable))
 970
 971 ;;-----------------------------------------------------
 972 ;; Test subseq
 973 ;;-----------------------------------------------------
 974 (Assert (equal (subseq nil 0) nil))
 975 (Assert (equal (subseq [1 2 3] 0) [1 2 3]))
 976 (Assert (equal (subseq [1 2 3] 1 -1) [2]))
 977 (Assert (equal (subseq "123" 0) "123"))
 978 (Assert (equal (subseq "1234" -3 -1) "23"))
 979 (Assert (equal (subseq #*0011 0) #*0011))
 980 (Assert (equal (subseq #*0011 -3 3) #*01))
 981 (Assert (equal (subseq '(1 2 3) 0) '(1 2 3)))
 982 (Assert (equal (subseq '(1 2 3 4) -3 nil) '(2 3 4)))
 983
 984 (Check-Error wrong-type-argument (subseq 3 2))
 985 (Check-Error args-out-of-range (subseq [1 2 3] -42))
 986 (Check-Error args-out-of-range (subseq [1 2 3] 0 42))
 987
 988 ;;-----------------------------------------------------
 989 ;; Time-related tests
 990 ;;-----------------------------------------------------
 991 (Assert (= (length (current-time-string)) 24))
 992
 993 ;;-----------------------------------------------------
 994 ;; format test
 995 ;;-----------------------------------------------------
 996 (Assert (string= (format "%d" 10) "10"))
 997 (Assert (string= (format "%o" 8) "10"))
 998 (Assert (string= (format "%x" 31) "1f"))
 999 (Assert (string= (format "%X" 31) "1F"))
1000 (Assert (string= (format "%e" 100) "1.000000e+02"))
1001 (Assert (string= (format "%E" 100) "1.000000E+02"))
1002 (Assert (string= (format "%f" 100) "100.000000"))
1003 (Assert (string= (format "%7.3f" 12.12345) " 12.123"))
1004 (Assert (string= (format "%07.3f" 12.12345) "012.123"))
1005 (Assert (string= (format "%-7.3f" 12.12345) "12.123 "))
1006 (Assert (string= (format "%-07.3f" 12.12345) "12.123 "))
1007 (Assert (string= (format "%g" 100.0) "100"))
1008 (Assert (string= (format "%g" 0.000001) "1e-06"))
1009 (Assert (string= (format "%g" 0.0001) "0.0001"))
1010 (Assert (string= (format "%G" 100.0) "100"))
1011 (Assert (string= (format "%G" 0.000001) "1E-06"))
1012 (Assert (string= (format "%G" 0.0001) "0.0001"))
1013
1014 (Assert (string= (format "%2$d%1$d" 10 20) "2010"))
1015 (Assert (string= (format "%-d" 10) "10"))
1016 (Assert (string= (format "%-4d" 10) "10  "))
1017 (Assert (string= (format "%+d" 10) "+10"))
1018 (Assert (string= (format "%+d" -10) "-10"))
1019 (Assert (string= (format "%+4d" 10) " +10"))
1020 (Assert (string= (format "%+4d" -10) " -10"))
1021 (Assert (string= (format "% d" 10) " 10"))
1022 (Assert (string= (format "% d" -10) "-10"))
1023 (Assert (string= (format "% 4d" 10) "  10"))
1024 (Assert (string= (format "% 4d" -10) " -10"))
1025 (Assert (string= (format "%0d" 10) "10"))
1026 (Assert (string= (format "%0d" -10) "-10"))
1027 (Assert (string= (format "%04d" 10) "0010"))
1028 (Assert (string= (format "%04d" -10) "-010"))
1029 (Assert (string= (format "%*d" 4 10) "  10"))
1030 (Assert (string= (format "%*d" 4 -10) " -10"))
1031 (Assert (string= (format "%*d" -4 10) "10  "))
1032 (Assert (string= (format "%*d" -4 -10) "-10 "))
1033 (Assert (string= (format "%#d" 10) "10"))
1034 (Assert (string= (format "%#o" 8) "010"))
1035 (Assert (string= (format "%#x" 16) "0x10"))
1036 (Assert (string= (format "%#e" 100) "1.000000e+02"))
1037 (Assert (string= (format "%#E" 100) "1.000000E+02"))
1038 (Assert (string= (format "%#f" 100) "100.000000"))
1039 (Assert (string= (format "%#g" 100.0) "100.000"))
1040 (Assert (string= (format "%#g" 0.000001) "1.00000e-06"))
1041 (Assert (string= (format "%#g" 0.0001) "0.000100000"))
1042 (Assert (string= (format "%#G" 100.0) "100.000"))
1043 (Assert (string= (format "%#G" 0.000001) "1.00000E-06"))
1044 (Assert (string= (format "%#G" 0.0001) "0.000100000"))
1045 (Assert (string= (format "%.1d" 10) "10"))
1046 (Assert (string= (format "%.4d" 10) "0010"))
1047 ;; Combination of `-', `+', ` ', `0', `#', `.', `*'
1048 (Assert (string= (format "%-04d" 10) "10  "))
1049 (Assert (string= (format "%-*d" 4 10) "10  "))
1050 ;; #### Correctness of this behavior is questionable.
1051 ;; It might be better to signal error.
1052 (Assert (string= (format "%-*d" -4 10) "10  "))
1053 ;; These behavior is not specified.
1054 ;; (format "%-+d" 10)
1055 ;; (format "%- d" 10)
1056 ;; (format "%-01d" 10)
1057 ;; (format "%-#4x" 10)
1058 ;; (format "%-.1d" 10)
1059
1060 (Assert (string= (format "%01.1d" 10) "10"))
1061 (Assert (string= (format "%03.1d" 10) " 10"))
1062 (Assert (string= (format "%01.3d" 10) "010"))
1063 (Assert (string= (format "%1.3d" 10) "010"))
1064 (Assert (string= (format "%3.1d" 10) " 10"))
1065
1066 ;;; The following two tests used to use 1000 instead of 100,
1067 ;;; but that merely found buffer overflow bugs in Solaris sprintf().
1068 (Assert (= 102 (length (format "%.100f" 3.14))))
1069 (Assert (= 100 (length (format "%100f" 3.14))))
1070
1071 ;;; Check for 64-bit cleanness on LP64 platforms.
1072 (Assert (= (read (format "%d"  most-positive-fixnum)) most-positive-fixnum))
1073 (Assert (= (read (format "%ld" most-positive-fixnum)) most-positive-fixnum))
1074 (Assert (= (read (format "%u"  most-positive-fixnum)) most-positive-fixnum))
1075 (Assert (= (read (format "%lu" most-positive-fixnum)) most-positive-fixnum))
1076 (Assert (= (read (format "%d"  most-negative-fixnum)) most-negative-fixnum))
1077 (Assert (= (read (format "%ld" most-negative-fixnum)) most-negative-fixnum))
1078
1079 ;;; "%u" is undocumented, and Emacs Lisp has no unsigned type.
1080 ;;; What to do if "%u" is used with a negative number?
1081 ;;; The most reasonable thing seems to be to print an un-read-able number.
1082 ;;; The printed value might be useful to a human, if not to Emacs Lisp.
1083 (Check-Error invalid-read-syntax (read (format "%u" most-negative-fixnum)))
1084 (Check-Error invalid-read-syntax (read (format "%u" -1)))
1085
1086 ;; Check all-completions ignore element start with space.
1087 (Assert (not (all-completions "" '((" hidden" . "object")))))
1088 (Assert (all-completions " " '((" hidden" . "object"))))