Lines Matching defs:test
30 ;; $XFree86: xc/programs/xedit/lisp/test/stream.lsp,v 1.3 2002/12/06 03:25:29 paulo Exp $
37 (defun do-format-test (error-test expect arguments
46 (if error-test
58 (defun format-test (expect &rest arguments)
59 (do-format-test nil expect arguments))
62 (do-format-test t nil arguments))
66 (defun compare-test (test expect function arguments
77 (or (funcall test result expect)
85 (defun compare-eval (test expect form
96 (or (funcall test result expect)
104 (defun error-test (function &rest arguments &aux result (error t))
125 (defun eq-test (expect function &rest arguments)
126 (compare-test #'eq expect function arguments))
128 (defun eql-test (expect function &rest arguments)
129 (compare-test #'eql expect function arguments))
131 (defun equal-test (expect function &rest arguments)
132 (compare-test #'equal expect function arguments))
134 (defun equalp-test (expect function &rest arguments)
135 (compare-test #'equalp expect function arguments))
149 (defun bool-test (expect function &rest arguments
190 (format-test "A" "~C" #\A)
191 (format-test " " "~C" #\Space)
192 (format-test "A" "~:C" #\A)
193 (format-test "Space" "~:C" #\Space)
194 (format-test "#\\A" "~@C" #\A)
195 (format-test "#\\Space" "~@C" #\Space)
196 (format-test " " "~A" #\Space)
197 (let ((*print-escape* t)) (format-test " " "~A" #\Space))
198 (format-test "#\\Space" "~S" #\Space)
199 (let ((*print-escape* nil)) (format-test "#\\Space" "~S" #\Space))
202 (format-test "
204 (format-test "
210 (format-test "" "~&")
211 (format-test "
215 (format-test " " "~|")
219 (format-test "~~~" "~3~")
222 (format-test "1101" "~,,' ,4:B" 13)
223 (format-test "1 0001" "~,,' ,4:B" 17)
224 (format-test "1101 0000 0101" "~14,,' ,4:B" 3333)
225 (format-test "1 22" "~3,,,' ,2:R" 17)
226 (format-test "6|55|35" "~,,'|,2:D" #xFFFF)
227 (format-test "1,000,000" "~,,,3:D" 1000000)
228 (format-test "one hundred and twenty-three thousand, four hundred and fifty-six"
230 (format-test "six hundred and fifty-four thousand, three hundred twenty-first"
232 (format-test "MCCXXXIV" "~@R" 1234)
233 (format-test "MCCXXXXVIIII" "~@:R" 1249)
234 (format-test "3039" "~X" 12345)
235 (format-test "30071" "~O" 12345)
236 (format-test "9IX" "~36R" 12345)
237 (format-test "11000000111001" "~B" 12345)
238 (format-test "The answer is 5." "The answer is ~D." 5)
239 (format-test "The answer is 5." "The answer is ~3D." 5)
240 (format-test "The answer is 005." "The answer is ~3,'0D." 5)
241 (format-test "1111 1010 1100 1110" "~,,' ,4:B" #xFACE)
242 (format-test "1 1100 1110" "~,,' ,4:B" #x1CE)
243 (format-test "1111 1010 1100 1110" "~19,,' ,4:B" #xFACE)
244 (format-test " 1 1100 1110" "~19,,' ,4:B" #x1CE)
247 #+xedit (format-test "6.38" "~4,2F" 6.375d0)
248 (format-test "10.0" "~,1F" 9.995d0)
250 #+xedit (format-test " 6.38E+2" "~8,2E" 637.5)
262 (format-test (car r)
277 (format-test (car r)
298 (format-test (car r) "Scale factor ~2D: | ~12,6,2,VE|" k k 3.14159)
315 (format-test (car r) "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G"
318 (format-test " 1." "~4,0f" 0.5)
319 (format-test " 0." "~4,0f" 0.4)
323 (format-test "3 items found.""~D item~:P found." n)
324 (format-test "three dogs are here." "~R dog~:[s are~; is~] here." n (= n 1))
325 (format-test "three dogs are here." "~R dog~:*~[s are~; is~:;s are~] here." n)
326 (format-test "Here are three puppies.""Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n)
327 (format-test "7 tries/1 win" "~D tr~:@P/~D win~:P" 7 1)
328 (format-test "1 try/0 wins" "~D tr~:@P/~D win~:P" 1 0)
329 (format-test "1 try/3 wins" "~D tr~:@P/~D win~:P" 1 3)
332 (format-test " foo" "~8Tfoo")
333 #+xedit (format-test " foo" "~8,3Tfoo")
334 (format-test " foo" "~8,3@Tfoo")
335 (format-test " foo" "~1,3@Tfoo")
338 (format-test "2" "~*~D" 1 2 3 4)
339 (format-test "4" "~3*~D" 1 2 3 4)
340 (format-test "2" "~3*~2:*~D" 1 2 3 4)
341 (format-test "4 3 2 1 2 3 4" "~3@*~D ~2@*~D ~1@*~D ~0@*~D ~D ~D ~D" 1 2 3 4)
344 (format-test "<Foo 5> 7" "~? ~D" "<~A ~D>" '("Foo" 5) 7)
345 (format-test "<Foo 5> 7" "~? ~D" "<~A ~D>" '("Foo" 5 14) 7)
346 (format-test "<Foo 5> 7" "~@? ~D" "<~A ~D>" "Foo" 5 7)
347 (format-test "<Foo 5> 14" "~@? ~D" "<~A ~D>" "Foo" 5 14 7)
355 (format-test "XIV xiv" "~@R ~(~@R~)" 14 14)
356 (format-test "Zero errors detected." "~@(~R~) error~:P detected." 0)
357 (format-test "One error detected." "~@(~R~) error~:P detected." 1)
358 (format-test "Twenty-three errors detected." "~@(~R~) error~:P detected." 23)
361 (format-test "Persian Cat" "~[Siamese~;Manx~;Persian~] Cat" 2)
362 (format-test " Cat" "~[Siamese~;Manx~;Persian~] Cat" 3)
363 (format-test "Siamese Cat" "~[Siamese~;Manx~;Persian~] Cat" 0)
365 (format-test " print length = 5"
368 (format-test "Items: none." foo)
369 (format-test "Items: FOO." foo 'foo)
370 (format-test "Items: FOO and BAR." foo 'foo 'bar)
371 (format-test "Items: FOO, BAR, and BAZ." foo 'foo 'bar 'baz)
372 (format-test "Items: FOO, BAR, BAZ, and QUUX." foo 'foo 'bar 'baz 'quux)
375 (format-test "The winners are: FRED HARRY JILL."
377 (format-test "Pairs: <A,1> <B,2> <C,3>." "Pairs:~{ <~S,~S>~}." '(a 1 b 2 c 3))
378 (format-test "Pairs: <A,1> <B,2> <C,3>."
380 (format-test "Pairs: <A,1> <B,2> <C,3>."
384 (format-test "foo bar" "~10<foo~;bar~>")
385 (format-test " foo bar" "~10:<foo~;bar~>")
386 (format-test " foo bar " "~10:@<foo~;bar~>")
387 (format-test " foobar" "~10<foobar~>")
388 (format-test " foobar" "~10:<foobar~>")
389 (format-test "foobar " "~10@<foobar~>")
390 (format-test " foobar " "~10:@<foobar~>")
394 (format-test "Done." donestr)
395 (format-test "Done. 3 warnings." donestr 3)
396 (format-test "Done. 1 warning. 5 errors." donestr 1 5)
397 (format-test "/HOT .../HAMBURGER/ICE .../FRENCH ..."
399 (format-test "/HOT .../HAMBURGER .../ICE .../FRENCH"
401 (format-test "/HOT .../HAMBURGER"
404 (format-test "Twenty-three" tellstr 23)
405 (format-test " Losers." tellstr nil "losers")
406 (format-test "Twenty-three losers." tellstr 23 "losers")
407 (format-test " FOO" "~15<~S~;~^~S~;~^~S~>" 'foo)
408 (format-test "FOO BAR" "~15<~S~;~^~S~;~^~S~>" 'foo 'bar)
409 (format-test "FOO BAR BAZ" "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz)
413 (equal-test #P"/public/games/chess.db"
416 (equal-test #P"/etc/passwd" #'list* #P"/etc/passwd")
419 (eq-test path #'pathname path)
420 (eq-test nil #'pathname-host path)
421 (eq-test nil #'pathname-device path)
422 (equal-test '(:absolute "public" "games") #'pathname-directory path)
423 (equal-test "chess" #'pathname-name path)
424 (equal-test "db" #'pathname-type path)
425 (eq-test nil #'pathname-version path)
426 (equal-test #P"/tmp/foo.txt" #'make-pathname :defaults "/tmp/foo.txt")
428 #+xedit (equal-test #P"/tmp/foo.txt" #'pathname "///tmp///foo.txt")
430 ;; (equal-test #P"///tmp///foo.txt" #'pathname "///tmp///foo.txt")
434 (equal-test #P"/tmp/foo.txt" #'merge-pathnames "/tmp/foo" "/tmp/foo.txt")
435 (equal-test #P"/tmp/foo.txt" #'merge-pathnames "foo" "/tmp/foo.txt")
436 (equal-test #P"/tmp/foo/bar.txt" #'merge-pathnames "foo/bar" "/tmp/foo.txt")
440 (equal-test "/tmp/foo/bar.txt" #'namestring path)
441 (equal-test "" #'host-namestring path)
442 (equal-test "/tmp/foo/" #'directory-namestring path)
443 (equal-test "bar.txt" #'file-namestring path)
444 (equal-test "/tmp/foo/bar.txt" #'enough-namestring path)
445 (equal-test "foo/bar.txt" #'enough-namestring path "/tmp/")
446 (equal-test "bar.txt" #'enough-namestring path "/tmp/foo/")
447 (equal-test "foo/bar.txt" #'enough-namestring path "/tmp/foo")
457 (eq-test t #'streamp is)
458 (eq-test t #'input-stream-p is)
459 (eq-test nil #'output-stream-p is)
460 (eq-test 'foo #'read is)
461 (eq-test t #'close is)
463 (eq-test 'foo #'read is)
464 (eq-test t #'close is)
466 (eq-test nil #'read is nil)
467 (eq-test 'end-of-string #'read is nil 'end-of-string)
469 (error-test #'read is)
470 (error-test #'read is nil)
471 (error-test #'read is nil 'end-of-string)
472 (eq-test t #'streamp is)
473 (eq-test nil #'input-stream-p is)
474 (eq-test nil #'streamp "test")
475 (error-test #'input-stream-p "test")
479 (setq test nil)
482 ((not (characterp c)) test)
483 (setq test (append test (list c)))))
486 (eql-test #\a #'read-char is)
487 (eql-test #\b #'read-char is)
488 (eql-test #\c #'read-char is)
489 (error-test #'read-char is)
490 (eq-test nil #'read-char is nil)
491 (eq-test :end-of-string #'read-char is nil :end-of-string)
492 (eq-test t #'close is)
496 (setq test nil)
499 ((not (characterp c)) test)
500 (setq test (append test (list c)))))
503 (eql-test #\a #'read-char-no-hang is)
504 (eql-test #\b #'read-char-no-hang is)
505 (eql-test #\c #'read-char-no-hang is)
506 (error-test #'read-char-no-hang is)
507 (eq-test nil #'read-char-no-hang is nil)
508 (eq-test :end-of-string #'read-char-no-hang is nil :end-of-string)
509 (eq-test t #'close is)
522 (equal-test "dog" #'write-line "dog" is)
524 (eql-test #\d #'read-char-no-hang is)
525 (eql-test #\o #'read-char-no-hang is)
526 (eql-test #\g #'read-char-no-hang is)
527 (eql-test #\Newline #'read-char-no-hang is)
528 (eq-test nil #'read-char-no-hang is)
529 (eq-test nil #'read-char-no-hang is)
530 (equal-test "mouse" #'write-line "mouse" is)
532 (eql-test #\m #'read-char-no-hang is)
533 (eql-test #\o #'read-char-no-hang is)
534 (eql-test #\u #'read-char-no-hang is)
535 (eql-test #\s #'read-char-no-hang is)
536 (eql-test #\e #'read-char-no-hang is)
537 (eql-test #\Newline #'read-char-no-hang is)
538 (eq-test nil #'read-char-no-hang is)
539 (eq-test t #'close is)
540 (error-test #'read-char-no-hang is)
541 (error-test #'read-char-no-hang is nil)
542 (error-test #'read-char-no-hang is nil t)
550 (error-test #'read-from-string "")
551 (eq-test nil #'read-from-string "" nil)
552 (eq-test 'end-of-file #'read-from-string "" nil 'end-of-file)
559 (error-test #'read-line is)
568 (equal-test '(1 2 3 4) #'write '(1 2 3 4) :stream os)
569 (equal-test "(1 2 3 4)" #'get-output-stream-string os)
570 (eq-test t #'streamp os)
571 (eq-test t #'output-stream-p os)
572 (eq-test nil #'input-stream-p os)
573 (equal-test '(:foo :bar) #'write '(:foo :bar) :case :downcase :stream os)
574 (equal-test "(:foo :bar)" #'get-output-stream-string os)
575 (equal-test '(:foo :bar) #'write '(:foo :bar) :case :capitalize :stream os)
576 (equal-test "(:Foo :Bar)" #'get-output-stream-string os)
577 (equal-test '(:foo :bar) #'write '(:foo :bar) :case :upcase :stream os)
578 (equal-test "(:FOO :BAR)" #'get-output-stream-string os)
579 (equal-test '(foo bar baz) #'write '(foo bar baz) :length 2 :stream os)
580 (equal-test "(FOO BAR ...)" #'get-output-stream-string os)
581 (equal-test '(foo (bar) baz) #'write '(foo (bar) baz) :level 1 :stream os)
582 (equal-test "(FOO # BAZ)" #'get-output-stream-string os)
584 (eq-test circle #'write circle :circle t :stream os)
585 (equal-test "#1=(1 #1#)" #'get-output-stream-string os)
586 (eql-test #\Space #'write #\Space :stream os)
587 (equal-test "#\\Space" #'get-output-stream-string os)
588 (eql-test #\Space #'write #\Space :escape nil :stream os)
589 (equal-test " " #'get-output-stream-string os)
590 (eq-test t #'close os)
591 (eq-test nil #'output-stream-p os)
592 (error-test #'output-stream-p "test")
593 (error-test #'write 'foo :stream "bar")
597 (equal-test "some text" #'write-string "some text" os)
598 (eq-test t #'fresh-line os)
599 (eq-test nil #'fresh-line os)
600 (equal-test "more text" #'write-string "more text" os)
601 (equal-test "some text
603 (equal-test nil #'fresh-line os)
604 (equal-test nil #'fresh-line os)
605 (equal-test "" #'get-output-stream-string os)
607 (error-test #'fresh-line 1)
616 (eq-test object #'prin1 object p-os)
617 (eq-test object #'write object :stream w-os :escape t)
618 (equal-test (get-output-stream-string p-os)
622 (error-test #'prin1 1 1)
632 (eq-test object #'princ object p-os)
633 (eq-test object #'write object :stream w-os :escape nil)
634 (equal-test (get-output-stream-string p-os)
638 (error-test #'princ 1 1)
650 (eq-test object #'print object p-os)
652 (eq-test nil #'terpri w-os)
653 (eq-test object #'write object :stream w-os :escape t)
654 (eql-test #\Space #'write-char #\Space w-os))
655 (equal-test (get-output-stream-string p-os)
659 (error-test #'print 1 1)
663 (equal-test "some text" #'write-string "some text" os)
664 (eq-test nil #'terpri os)
665 (eq-test nil #'terpri os)
666 (equal-test "more text" #'write-string "more text" os)
667 (equal-test "some text
670 (equal-test nil #'terpri os)
671 (equal-test nil #'terpri os)
672 (equal-test "
676 (error-test #'terpri 1)
684 (error-test #'write-char 1)
688 (equal-test "text" #'write-line "text" os)
689 (equal-test "text
691 (eql-test #\< #'write-char #\< os)
692 (equal-test "text" #'write-line "text" os :start 1 :end 3)
693 (eql-test #\> #'write-char #\> os)
694 (equal-test "<ex
696 (error-test #'write-line 1)
701 (equal-test "text" #'write-string "text" os)
702 (equal-test "text" #'get-output-stream-string os)
703 (eql-test #\< #'write-char #\< os)
704 (equal-test "text" #'write-string "text" os :start 1 :end 3)
705 (eql-test #\> #'write-char #\> os)
706 (equal-test "<ex>" #'get-output-stream-string os)
707 (error-test #'write-string #\a)
714 (equal-test "some text" #'write-line "some text" file)
716 (equal-test "delete-me.text" #'file-namestring (truename name))
718 (equal-test "other text" #'write-line "other text" file)
720 (equal-test "delete-me.text" #'file-namestring (truename name))
722 #+xedit (eq-test t #'delete-file name)
723 #+clisp (bool-test t #'delete-file name)
728 (bool-test t #'delete-file backup)
729 (eq-test nil #'delete-file name)
730 (eq-test nil #'directory name)
731 (eq-test nil #'directory backup)
732 ;; test append
738 (equal-test "line 1" #'read-line s)
739 (equal-test "line 2" #'read-line s)
740 (eq-test 'eof #'read-line s nil 'eof)
742 (bool-test t #'delete-file name)
743 ;; test overwrite
749 (equal-test "some-text" #'read-line s)
750 (eq-test 'eof #'read-line s nil 'eof))
751 ;; test check for file existence
752 (eq-test nil #'open name :direction :output :if-exists nil)
753 (error-test #'open name :direction :output :if-exists :error)
754 (bool-test t #'delete-file name)
755 ;; test check for no file existence
756 (eq-test nil #'open name :direction :output :if-does-not-exist nil)
757 (error-test #'open name :direction :output :if-does-not-exist :error)
758 #+xedit ;; test io -- not sure if this is the expected behaviour
764 (equal-test "foo" #'read-line s)
765 (equal-test "bar" #'read-line s)
766 (eq-test 'eof #'read-line s nil 'eof)
769 (equal-test "foo" #'read-line s)
770 (equal-test "bar" #'read-line s)
771 (equal-test "baz" #'read-line s)
772 (eq-test 'eof #'read-line s nil 'eof))
773 (bool-test t #'delete-file name)
779 (eq-test t #'pathnamep (setq p (probe-file "delete-me.text")))
780 (bool-test t #'delete-file p)
781 (eq-test nil #'probe-file "delete-me.text")
785 (bool-test nil #'probe-file "delete-me.text")
790 (eq-test t #'close file)
792 (eql-test 3 #'length result)
793 (eq-test t #'pathnamep (first result))
794 (eq-test t #'pathnamep (second result))
795 (eq-test t #'pathnamep (third result))
796 (equal-test (third result) #'truename "bar.foo")
797 (eq-test nil #'directory name)
798 (eq-test nil #'directory (second result))
799 (equal-test (list (third result)) #'directory (third result))
800 (error-test #'truename name)
801 (error-test #'truename (second result))
802 (eq-test nil #'probe-file name)
803 (bool-test t #'probe-file (first result))
804 (eq-test nil #'probe-file (second result))
805 (bool-test t #'probe-file (third result))
806 (bool-test t #'delete-file "bar.foo")
807 (eq-test nil #'delete-file (third result))
808 (eq-test nil #'delete-file (second result))