Mercurial > hg > xemacs-beta

comparison tests/automated/lisp-tests.el @ 2056:ab71063baf27

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2004-05-03 15:08:41 by james] Add failing-case parameter to Assert and use it in lisp-tests.
author james
date Mon, 03 May 2004 15:08:51 +0000
parents 9c872f33ecbe
children c0dad8c0e80d
comparison
equal deleted inserted replaced
2055:512c8189d646 2056:ab71063baf27
264 (Assert (= (- one one one) -1)) 264 (Assert (= (- one one one) -1))
265 (Assert (= (- 0 one) -1)) 265 (Assert (= (- 0 one) -1))
266 (Assert (= (- 0 one one) -2)) 266 (Assert (= (- 0 one one) -2))
267 (Assert (= (+ one 1) 2)) 267 (Assert (= (+ one 1) 2))
268 (dolist (zero '(0 0.0 ?\0)) 268 (dolist (zero '(0 0.0 ?\0))
269 (Assert (= (+ 1 zero) 1)) 269 (Assert (= (+ 1 zero) 1) zero)
270 (Assert (= (+ zero 1) 1)) 270 (Assert (= (+ zero 1) 1) zero)
271 (Assert (= (- zero) zero)) 271 (Assert (= (- zero) zero) zero)
272 (Assert (= (- zero) 0)) 272 (Assert (= (- zero) 0) zero)
273 (Assert (= (- zero zero) 0)) 273 (Assert (= (- zero zero) 0) zero)
274 (Assert (= (- zero one one) -2)))) 274 (Assert (= (- zero one one) -2) zero)))
275 275
276 (Assert (= (- 1.5 1) .5)) 276 (Assert (= (- 1.5 1) .5))
277 (Assert (= (- 1 1.5) (- .5))) 277 (Assert (= (- 1 1.5) (- .5)))
278 278
279 (if (featurep 'bignum) 279 (if (featurep 'bignum)
316 (Assert (= (/ (setq x 2.0)) 0.5))) 316 (Assert (= (/ (setq x 2.0)) 0.5)))
317 317
318 (dolist (six '(6 6.0 ?\06)) 318 (dolist (six '(6 6.0 ?\06))
319 (dolist (two '(2 2.0 ?\02)) 319 (dolist (two '(2 2.0 ?\02))
320 (dolist (three '(3 3.0 ?\03)) 320 (dolist (three '(3 3.0 ?\03))
321 (Assert (= (/ six two) three))))) 321 (Assert (= (/ six two) three) (list six two three)))))
322 322
323 (dolist (three '(3 3.0 ?\03)) 323 (dolist (three '(3 3.0 ?\03))
324 (Assert (= (/ three 2.0) 1.5))) 324 (Assert (= (/ three 2.0) 1.5) three))
325 (dolist (two '(2 2.0 ?\02)) 325 (dolist (two '(2 2.0 ?\02))
326 (Assert (= (/ 3.0 two) 1.5))) 326 (Assert (= (/ 3.0 two) 1.5) two))
327 327
328 (when (featurep 'bignum) 328 (when (featurep 'bignum)
329 (let* ((million 1000000) 329 (let* ((million 1000000)
330 (billion (* million 1000)) ;; American, not British, billion 330 (billion (* million 1000)) ;; American, not British, billion
331 (trillion (* billion 1000))) 331 (trillion (* billion 1000)))
349 349
350 ;; Test `*' 350 ;; Test `*'
351 (Assert (= 1 (*))) 351 (Assert (= 1 (*)))
352 352
353 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1))) 353 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
354 (Assert (= 1 (* one)))) 354 (Assert (= 1 (* one)) one))
355 355
356 (dolist (two '(2 2.0 ?\02)) 356 (dolist (two '(2 2.0 ?\02))
357 (Assert (= 2 (* two)))) 357 (Assert (= 2 (* two)) two))
358 358
359 (dolist (six '(6 6.0 ?\06)) 359 (dolist (six '(6 6.0 ?\06))
360 (dolist (two '(2 2.0 ?\02)) 360 (dolist (two '(2 2.0 ?\02))
361 (dolist (three '(3 3.0 ?\03)) 361 (dolist (three '(3 3.0 ?\03))
362 (Assert (= (* three two) six))))) 362 (Assert (= (* three two) six) (list three two six)))))
363 363
364 (dolist (three '(3 3.0 ?\03)) 364 (dolist (three '(3 3.0 ?\03))
365 (dolist (two '(2 2.0 ?\02)) 365 (dolist (two '(2 2.0 ?\02))
366 (Assert (= (* 1.5 two) three)) 366 (Assert (= (* 1.5 two) three) (list two three))
367 (dolist (five '(5 5.0 ?\05)) 367 (dolist (five '(5 5.0 ?\05))
368 (Assert (= 30 (* five two three)))))) 368 (Assert (= 30 (* five two three)) (list five two three)))))
369 369
370 (when (featurep 'bignum) 370 (when (featurep 'bignum)
371 (let ((64K 65536)) 371 (let ((64K 65536))
372 (Assert (= (* 64K 64K) (read "4294967296"))) 372 (Assert (= (* 64K 64K) (read "4294967296")))
373 (Assert (= (* (- 64K) 64K) (read "-4294967296"))) 373 (Assert (= (* (- 64K) 64K) (read "-4294967296")))
382 382
383 ;; Test `+' 383 ;; Test `+'
384 (Assert (= 0 (+))) 384 (Assert (= 0 (+)))
385 385
386 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1))) 386 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
387 (Assert (= 1 (+ one)))) 387 (Assert (= 1 (+ one)) one))
388 388
389 (dolist (two '(2 2.0 ?\02)) 389 (dolist (two '(2 2.0 ?\02))
390 (Assert (= 2 (+ two)))) 390 (Assert (= 2 (+ two)) two))
391 391
392 (dolist (five '(5 5.0 ?\05)) 392 (dolist (five '(5 5.0 ?\05))
393 (dolist (two '(2 2.0 ?\02)) 393 (dolist (two '(2 2.0 ?\02))
394 (dolist (three '(3 3.0 ?\03)) 394 (dolist (three '(3 3.0 ?\03))
395 (Assert (= (+ three two) five)) 395 (Assert (= (+ three two) five) (list three two five))
396 (Assert (= 10 (+ five two three)))))) 396 (Assert (= 10 (+ five two three)) (list five two three)))))
397 397
398 ;; Test `max', `min' 398 ;; Test `max', `min'
399 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1))) 399 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
400 (Assert (= one (max one))) 400 (Assert (= one (max one)) one)
401 (Assert (= one (max one one))) 401 (Assert (= one (max one one)) one)
402 (Assert (= one (max one one one))) 402 (Assert (= one (max one one one)) one)
403 (Assert (= one (min one))) 403 (Assert (= one (min one)) one)
404 (Assert (= one (min one one))) 404 (Assert (= one (min one one)) one)
405 (Assert (= one (min one one one))) 405 (Assert (= one (min one one one)) one)
406 (dolist (two `(2 2.0 ?\02 ,(Int-to-Marker 2))) 406 (dolist (two `(2 2.0 ?\02 ,(Int-to-Marker 2)))
407 (Assert (= one (min one two))) 407 (Assert (= one (min one two)) (list one two))
408 (Assert (= one (min one two two))) 408 (Assert (= one (min one two two)) (list one two))
409 (Assert (= one (min two two one))) 409 (Assert (= one (min two two one)) (list one two))
410 (Assert (= two (max one two))) 410 (Assert (= two (max one two)) (list one two))
411 (Assert (= two (max one two two))) 411 (Assert (= two (max one two two)) (list one two))
412 (Assert (= two (max two two one))))) 412 (Assert (= two (max two two one)) (list one two))))
413 413
414 (when (featurep 'bignum) 414 (when (featurep 'bignum)
415 (let ((big (1+ most-positive-fixnum)) 415 (let ((big (1+ most-positive-fixnum))
416 (small (1- most-negative-fixnum))) 416 (small (1- most-negative-fixnum)))
417 (Assert (= big (max 1 1000000.0 most-positive-fixnum big))) 417 (Assert (= big (max 1 1000000.0 most-positive-fixnum big)))
468 (Check-Error wrong-type-argument (logxor 3.0)) 468 (Check-Error wrong-type-argument (logxor 3.0))
469 (Check-Error wrong-type-argument (logior 3.0)) 469 (Check-Error wrong-type-argument (logior 3.0))
470 (Check-Error wrong-type-argument (logand 3.0)) 470 (Check-Error wrong-type-argument (logand 3.0))
471 471
472 (dolist (three '(3 ?\03)) 472 (dolist (three '(3 ?\03))
473 (Assert (eq 3 (logand three))) 473 (Assert (eq 3 (logand three)) three)
474 (Assert (eq 3 (logxor three))) 474 (Assert (eq 3 (logxor three)) three)
475 (Assert (eq 3 (logior three))) 475 (Assert (eq 3 (logior three)) three)
476 (Assert (eq 3 (logand three three))) 476 (Assert (eq 3 (logand three three)) three)
477 (Assert (eq 0 (logxor three three))) 477 (Assert (eq 0 (logxor three three)) three)
478 (Assert (eq 3 (logior three three)))) 478 (Assert (eq 3 (logior three three))) three)
479 479
480 (dolist (one `(1 ?\01 ,(Int-to-Marker 1))) 480 (dolist (one `(1 ?\01 ,(Int-to-Marker 1)))
481 (dolist (two '(2 ?\02)) 481 (dolist (two '(2 ?\02))
482 (Assert (eq 0 (logand one two))) 482 (Assert (eq 0 (logand one two)) (list one two))
483 (Assert (eq 3 (logior one two))) 483 (Assert (eq 3 (logior one two)) (list one two))
484 (Assert (eq 3 (logxor one two)))) 484 (Assert (eq 3 (logxor one two)) (list one two)))
485 (dolist (three '(3 ?\03)) 485 (dolist (three '(3 ?\03))
486 (Assert (eq 1 (logand one three))) 486 (Assert (eq 1 (logand one three)) (list one three))
487 (Assert (eq 3 (logior one three))) 487 (Assert (eq 3 (logior one three)) (list one three))
488 (Assert (eq 2 (logxor one three))))) 488 (Assert (eq 2 (logxor one three)) (list one three))))
489 489
490 ;;----------------------------------------------------- 490 ;;-----------------------------------------------------
491 ;; Test `%', mod 491 ;; Test `%', mod
492 ;;----------------------------------------------------- 492 ;;-----------------------------------------------------
493 (Check-Error wrong-number-of-arguments (%)) 493 (Check-Error wrong-number-of-arguments (%))
499 (Check-Error wrong-number-of-arguments (mod 1 2 3)) 499 (Check-Error wrong-number-of-arguments (mod 1 2 3))
500 500
501 (Check-Error wrong-type-argument (% 10.0 2)) 501 (Check-Error wrong-type-argument (% 10.0 2))
502 (Check-Error wrong-type-argument (% 10 2.0)) 502 (Check-Error wrong-type-argument (% 10 2.0))
503 503
504 (dotimes (j 30) 504 (flet ((test1 (x) (Assert (eql x (+ (% x 17) (* (/ x 17) 17))) x))
505 (let ((x (- (random) (random)))) 505 (test2 (x) (Assert (eql (- x) (+ (% (- x) 17) (* (/ (- x) 17) 17))) x))
506 (Assert (eq x (+ (% x 17) (* (/ x 17) 17)))) 506 (test3 (x) (Assert (eql x (+ (% (- x) 17) (* (/ (- x) 17) 17))) x))
507 (Assert (eq (- x) (+ (% (- x) 17) (* (/ (- x) 17) 17)))) 507 (test4 (x) (Assert (eql (% x -17) (- (% (- x) 17))) x)))
508 (Assert (eq (% x -17) (- (% (- x) 17)))) 508 (test1 most-negative-fixnum)
509 )) 509 (if (featurep 'bignum)
510 (test2 most-negative-fixnum)
511 (test3 most-negative-fixnum))
512 (test4 most-negative-fixnum)
513 (test1 most-positive-fixnum)
514 (test2 most-positive-fixnum)
515 (test4 most-positive-fixnum)
516 (dotimes (j 30)
517 (let ((x (random)))
518 (if (eq x most-negative-fixnum) (setq x (1+ x)))
519 (if (eq x most-positive-fixnum) (setq x (1- x)))
520 (test1 x)
521 (test2 x)
522 (test4 x))))
510 523
511 (macrolet 524 (macrolet
512 ((division-test (seven) 525 ((division-test (seven)
513 `(progn 526 `(progn
514 (Assert (eq (% ,seven 2) 1)) 527 (Assert (eq (% ,seven 2) 1))
582 (Check-Error wrong-number-of-arguments (>=)) 595 (Check-Error wrong-number-of-arguments (>=))
583 (Check-Error wrong-number-of-arguments (/=)) 596 (Check-Error wrong-number-of-arguments (/=))
584 597
585 ;; One argument always yields t 598 ;; One argument always yields t
586 (loop for x in `(1 1.0 ,(Int-to-Marker 1) ?z) do 599 (loop for x in `(1 1.0 ,(Int-to-Marker 1) ?z) do
587 (Assert (eq t (= x))) 600 (Assert (eq t (= x)) x)
588 (Assert (eq t (< x))) 601 (Assert (eq t (< x)) x)
589 (Assert (eq t (> x))) 602 (Assert (eq t (> x)) x)
590 (Assert (eq t (>= x))) 603 (Assert (eq t (>= x)) x)
591 (Assert (eq t (<= x))) 604 (Assert (eq t (<= x)) x)
592 (Assert (eq t (/= x))) 605 (Assert (eq t (/= x)) x)
593 ) 606 )
594 607
595 ;; Type checking 608 ;; Type checking
596 (Check-Error wrong-type-argument (= 'foo 1)) 609 (Check-Error wrong-type-argument (= 'foo 1))
597 (Check-Error wrong-type-argument (<= 'foo 1)) 610 (Check-Error wrong-type-argument (<= 'foo 1))
601 (Check-Error wrong-type-argument (/= 'foo 1)) 614 (Check-Error wrong-type-argument (/= 'foo 1))
602 615
603 ;; Meat 616 ;; Meat
604 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01)) 617 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
605 (dolist (two '(2 2.0 ?\02)) 618 (dolist (two '(2 2.0 ?\02))
606 (Assert (< one two)) 619 (Assert (< one two) (list one two))
607 (Assert (<= one two)) 620 (Assert (<= one two) (list one two))
608 (Assert (<= two two)) 621 (Assert (<= two two) two)
609 (Assert (> two one)) 622 (Assert (> two one) (list one two))
610 (Assert (>= two one)) 623 (Assert (>= two one) (list one two))
611 (Assert (>= two two)) 624 (Assert (>= two two) two)
612 (Assert (/= one two)) 625 (Assert (/= one two) (list one two))
613 (Assert (not (/= two two))) 626 (Assert (not (/= two two)) two)
614 (Assert (not (< one one))) 627 (Assert (not (< one one)) one)
615 (Assert (not (> one one))) 628 (Assert (not (> one one)) one)
616 (Assert (<= one one two two)) 629 (Assert (<= one one two two) (list one two))
617 (Assert (not (< one one two two))) 630 (Assert (not (< one one two two)) (list one two))
618 (Assert (>= two two one one)) 631 (Assert (>= two two one one) (list one two))
619 (Assert (not (> two two one one))) 632 (Assert (not (> two two one one)) (list one two))
620 (Assert (= one one one)) 633 (Assert (= one one one) one)
621 (Assert (not (= one one one two))) 634 (Assert (not (= one one one two)) (list one two))
622 (Assert (not (/= one two one))) 635 (Assert (not (/= one two one)) (list one two))
623 )) 636 ))
624 637
625 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01)) 638 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
626 (dolist (two '(2 2.0 ?\02)) 639 (dolist (two '(2 2.0 ?\02))
627 (Assert (< one two)) 640 (Assert (< one two) (list one two))
628 (Assert (<= one two)) 641 (Assert (<= one two) (list one two))
629 (Assert (<= two two)) 642 (Assert (<= two two) two)
630 (Assert (> two one)) 643 (Assert (> two one) (list one two))
631 (Assert (>= two one)) 644 (Assert (>= two one) (list one two))
632 (Assert (>= two two)) 645 (Assert (>= two two) two)
633 (Assert (/= one two)) 646 (Assert (/= one two) (list one two))
634 (Assert (not (/= two two))) 647 (Assert (not (/= two two)) two)
635 (Assert (not (< one one))) 648 (Assert (not (< one one)) one)
636 (Assert (not (> one one))) 649 (Assert (not (> one one)) one)
637 (Assert (<= one one two two)) 650 (Assert (<= one one two two) (list one two))
638 (Assert (not (< one one two two))) 651 (Assert (not (< one one two two)) (list one two))
639 (Assert (>= two two one one)) 652 (Assert (>= two two one one) (list one two))
640 (Assert (not (> two two one one))) 653 (Assert (not (> two two one one)) (list one two))
641 (Assert (= one one one)) 654 (Assert (= one one one) one)
642 (Assert (not (= one one one two))) 655 (Assert (not (= one one one two)) (list one two))
643 (Assert (not (/= one two one))) 656 (Assert (not (/= one two one)) (list one two))
644 )) 657 ))
645 658
646 ;; ad-hoc 659 ;; ad-hoc
647 (Assert (< 1 2)) 660 (Assert (< 1 2))
648 (Assert (< 1 2 3 4 5 6)) 661 (Assert (< 1 2 3 4 5 6))
1106 (list (make-symbol "test-symbol") 1119 (list (make-symbol "test-symbol")
1107 "test-string" 1120 "test-string"
1108 (make-extent nil nil nil) 1121 (make-extent nil nil nil)
1109 (make-face 'test-face)) 1122 (make-face 'test-face))
1110 do 1123 do
1111 (Assert (eq 2 (get obj ?1 2))) 1124 (Assert (eq 2 (get obj ?1 2)) obj)
1112 (Assert (eq 4 (put obj ?3 4))) 1125 (Assert (eq 4 (put obj ?3 4)) obj)
1113 (Assert (eq 4 (get obj ?3))) 1126 (Assert (eq 4 (get obj ?3)) obj)
1114 (when (or (stringp obj) (symbolp obj)) 1127 (when (or (stringp obj) (symbolp obj))
1115 (Assert (equal '(?3 4) (object-plist obj)))) 1128 (Assert (equal '(?3 4) (object-plist obj)) obj))
1116 (Assert (eq t (remprop obj ?3))) 1129 (Assert (eq t (remprop obj ?3)) obj)
1117 (when (or (stringp obj) (symbolp obj)) 1130 (when (or (stringp obj) (symbolp obj))
1118 (Assert (eq '() (object-plist obj)))) 1131 (Assert (eq '() (object-plist obj)) obj))
1119 (Assert (eq nil (remprop obj ?3))) 1132 (Assert (eq nil (remprop obj ?3)) obj)
1120 (when (or (stringp obj) (symbolp obj)) 1133 (when (or (stringp obj) (symbolp obj))
1121 (Assert (eq '() (object-plist obj)))) 1134 (Assert (eq '() (object-plist obj)) obj))
1122 (Assert (eq 5 (get obj ?3 5))) 1135 (Assert (eq 5 (get obj ?3 5)) obj)
1123 ) 1136 )
1124 1137
1125 (Check-Error-Message 1138 (Check-Error-Message
1126 error "Object type has no properties" 1139 error "Object type has no properties"
1127 (get 2 'property)) 1140 (get 2 'property))