Author: yamakenz
Date: Wed Jul 11 01:43:43 2007
New Revision: 4698
Modified:
trunk/test/test-util.scm
Log:
* test/test-util.scm
- Add tests for sublist, sublist-rel, safe-car, safe-cdr, assq-cdr
Modified: trunk/test/test-util.scm
==============================================================================
--- trunk/test/test-util.scm (original)
+++ trunk/test/test-util.scm Wed Jul 11 01:43:43 2007
@@ -420,6 +420,227 @@
(assert-false (uim-bool '(apply proc-and '(#t #f #t))))
(assert-false (uim-bool '(apply proc-and '(#t #t #f))))
(assert-true (uim-bool '(apply proc-and '(#t #t #t)))))
+ ("test sublist"
+ ;; 0
+ (assert-equal '(1)
+ (uim '(sublist lst 0 0)))
+ (assert-equal '(1 "2")
+ (uim '(sublist lst 0 1)))
+ (assert-equal '(1 "2" three)
+ (uim '(sublist lst 0 2)))
+ (assert-equal '(1 "2" three (4))
+ (uim '(sublist lst 0 3)))
+ (assert-equal '(1 "2" three (4) 5)
+ (uim '(sublist lst 0 4)))
+ (assert-equal '(1 "2" three (4) 5 six "7" (8 8))
+ (uim '(sublist lst 0 7)))
+ (assert-equal '(1 "2" three (4) 5 six "7" (8 8) -9)
+ (uim '(sublist lst 0 8)))
+ (assert-error (lambda ()
+ (uim '(sublist lst 0 9))))
+ ;; 1
+ (assert-equal '()
+ (uim '(sublist lst 1 0)))
+ (assert-equal '("2")
+ (uim '(sublist lst 1 1)))
+ (assert-equal '("2" three)
+ (uim '(sublist lst 1 2)))
+ (assert-equal '("2" three (4))
+ (uim '(sublist lst 1 3)))
+ (assert-equal '("2" three (4) 5)
+ (uim '(sublist lst 1 4)))
+ (assert-equal '("2" three (4) 5 six "7" (8 8))
+ (uim '(sublist lst 1 7)))
+ (assert-equal '("2" three (4) 5 six "7" (8 8) -9)
+ (uim '(sublist lst 1 8)))
+ (assert-error (lambda ()
+ (uim '(sublist lst 1 9))))
+ ;; 2
+ (assert-error (lambda ()
+ (uim '(sublist lst 2 0))))
+ (assert-equal '()
+ (uim '(sublist lst 2 1)))
+ (assert-equal '(three)
+ (uim '(sublist lst 2 2)))
+ (assert-equal '(three (4))
+ (uim '(sublist lst 2 3)))
+ (assert-equal '(three (4) 5)
+ (uim '(sublist lst 2 4)))
+ (assert-equal '(three (4) 5 six "7" (8 8))
+ (uim '(sublist lst 2 7)))
+ (assert-equal '(three (4) 5 six "7" (8 8) -9)
+ (uim '(sublist lst 2 8)))
+ (assert-error (lambda ()
+ (uim '(sublist lst 2 9))))
+ ;; 3
+ (assert-error (lambda ()
+ (uim '(sublist lst 3 0))))
+ (assert-error (lambda ()
+ (uim '(sublist lst 3 1))))
+ (assert-equal '()
+ (uim '(sublist lst 3 2)))
+ (assert-equal '((4))
+ (uim '(sublist lst 3 3)))
+ (assert-equal '((4) 5)
+ (uim '(sublist lst 3 4)))
+ (assert-equal '((4) 5 six "7" (8 8))
+ (uim '(sublist lst 3 7)))
+ (assert-equal '((4) 5 six "7" (8 8) -9)
+ (uim '(sublist lst 3 8)))
+ (assert-error (lambda ()
+ (uim '(sublist lst 3 9))))
+ ;; 8
+ (assert-error (lambda ()
+ (uim '(sublist lst 8 0))))
+ (assert-error (lambda ()
+ (uim '(sublist lst 8 1))))
+ (assert-error (lambda ()
+ (uim '(sublist lst 8 2))))
+ (assert-error (lambda ()
+ (uim '(sublist lst 8 3))))
+ (assert-error (lambda ()
+ (uim '(sublist lst 8 4))))
+ (assert-equal '()
+ (uim '(sublist lst 8 7)))
+ (assert-equal '(-9)
+ (uim '(sublist lst 8 8)))
+ (assert-error (lambda ()
+ (uim '(sublist lst 8 9))))
+ ;; 9
+ (assert-error (lambda ()
+ (uim '(sublist lst 9 0))))
+ (assert-error (lambda ()
+ (uim '(sublist lst 9 1))))
+ (assert-error (lambda ()
+ (uim '(sublist lst 9 2))))
+ (assert-error (lambda ()
+ (uim '(sublist lst 9 3))))
+ (assert-error (lambda ()
+ (uim '(sublist lst 9 4))))
+ (assert-error (lambda ()
+ (uim '(sublist lst 9 7))))
+ (assert-equal '()
+ (uim '(sublist lst 9 8)))
+ (assert-error (lambda ()
+ (uim '(sublist lst 9 9)))))
+ ("test sublist-rel"
+ ;; 0
+ (assert-equal '(1)
+ (uim '(sublist-rel lst 0 0)))
+ (assert-equal '(1 "2")
+ (uim '(sublist-rel lst 0 1)))
+ (assert-equal '(1 "2" three)
+ (uim '(sublist-rel lst 0 2)))
+ (assert-equal '(1 "2" three (4))
+ (uim '(sublist-rel lst 0 3)))
+ (assert-equal '(1 "2" three (4) 5)
+ (uim '(sublist-rel lst 0 4)))
+ (assert-equal '(1 "2" three (4) 5 six "7" (8 8))
+ (uim '(sublist-rel lst 0 7)))
+ (assert-equal '(1 "2" three (4) 5 six "7" (8 8) -9)
+ (uim '(sublist-rel lst 0 8)))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 0 9))))
+ ;; 1
+ (assert-equal '("2")
+ (uim '(sublist-rel lst 1 0)))
+ (assert-equal '("2" three)
+ (uim '(sublist-rel lst 1 1)))
+ (assert-equal '("2" three (4))
+ (uim '(sublist-rel lst 1 2)))
+ (assert-equal '("2" three (4) 5)
+ (uim '(sublist-rel lst 1 3)))
+ (assert-equal '("2" three (4) 5 six)
+ (uim '(sublist-rel lst 1 4)))
+ (assert-equal '("2" three (4) 5 six "7" (8 8) -9)
+ (uim '(sublist-rel lst 1 7)))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 1 8))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 1 9))))
+ ;; 2
+ (assert-equal '(three)
+ (uim '(sublist-rel lst 2 0)))
+ (assert-equal '(three (4))
+ (uim '(sublist-rel lst 2 1)))
+ (assert-equal '(three (4) 5)
+ (uim '(sublist-rel lst 2 2)))
+ (assert-equal '(three (4) 5 six)
+ (uim '(sublist-rel lst 2 3)))
+ (assert-equal '(three (4) 5 six "7")
+ (uim '(sublist-rel lst 2 4)))
+ (assert-equal '(three (4) 5 six "7" (8 8) -9)
+ (uim '(sublist-rel lst 2 6)))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 2 7))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 2 8))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 2 9))))
+ ;; 3
+ (assert-equal '((4))
+ (uim '(sublist-rel lst 3 0)))
+ (assert-equal '((4) 5)
+ (uim '(sublist-rel lst 3 1)))
+ (assert-equal '((4) 5 six)
+ (uim '(sublist-rel lst 3 2)))
+ (assert-equal '((4) 5 six "7")
+ (uim '(sublist-rel lst 3 3)))
+ (assert-equal '((4) 5 six "7" (8 8))
+ (uim '(sublist-rel lst 3 4)))
+ (assert-equal '((4) 5 six "7" (8 8) -9)
+ (uim '(sublist-rel lst 3 5)))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 3 6))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 3 7))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 3 8))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 3 9))))
+ ;; 8
+ (assert-equal '(-9)
+ (uim '(sublist-rel lst 8 0)))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 8 1))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 8 2))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 8 3))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 8 4))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 8 5))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 8 6))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 8 7))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 8 8))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 8 9))))
+ ;; 9
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 9 0))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 9 1))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 9 2))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 9 3))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 9 4))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 9 5))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 9 6))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 9 7))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 9 8))))
+ (assert-error (lambda ()
+ (uim '(sublist-rel lst 9 9))))
+ )
("test list-head"
(assert-equal ()
(uim '(list-head lst 0)))
@@ -651,6 +872,37 @@
(uim '((compose car cdr reverse) test-list)))
(assert-equal 3
(uim '((compose car cdr cdr reverse) test-list))))
+ ("test safe-car"
+ (assert-equal 1
+ (uim '(safe-car '(1 2))))
+ (assert-equal 1
+ (uim '(safe-car '(1 . 2))))
+ (assert-false (uim '(safe-car '())))
+ (assert-false (uim '(safe-car 1))))
+ ("test safe-cdr"
+ (assert-equal '(2)
+ (uim '(safe-cdr '(1 2))))
+ (assert-equal 2
+ (uim '(safe-cdr '(1 . 2))))
+ (assert-false (uim '(safe-cdr '())))
+ (assert-false (uim '(safe-cdr 1))))
+ ("test assq-cdr"
+ (assert-equal '(2)
+ (uim '(assq-cdr 1 '((1 2)))))
+ (assert-equal 2
+ (uim '(assq-cdr 1 '((1 . 2)))))
+ (assert-false (uim '(assq-cdr 2 '((1 2)))))
+ (assert-false (uim '(assq-cdr 2 '((1 . 2)))))
+ (assert-equal '(2)
+ (uim '(assq-cdr 1 '((3 4) (1 2)))))
+ (assert-equal 2
+ (uim '(assq-cdr 1 '((3 . 4) (1 . 2)))))
+ (assert-equal '(4)
+ (uim '(assq-cdr 3 '((3 4) (1 2)))))
+ (assert-equal 4
+ (uim '(assq-cdr 3 '((3 . 4) (1 . 2)))))
+ (assert-false (uim '(assq-cdr 1 '())))
+ (assert-error (lambda () (uim '(assq-cdr 1 1)))))
("test clamp"
(assert-equal 0 (uim '(clamp -2 0 -1)))
(assert-equal 0 (uim '(clamp -1 0 -1)))
@@ -1412,7 +1664,16 @@
(five "5" 5))
(uim '(alist-delete 'three alist-sym eq?)))))
-(define-uim-test-case "test util Siod specific procedures"
+(define-uim-test-case "test util uim specific procedures"
+ ("test make-scm-pathname"
+ (assert-equal (uim '(string-append (load-path) "/"))
+ (uim '(make-scm-pathname "")))
+ (assert-equal (uim '(string-append (load-path) "/file"))
+ (uim '(make-scm-pathname "file")))
+ (assert-equal "/absolute/path/file"
+ (uim '(make-scm-pathname "/absolute/path/file")))
+ (assert-equal "/"
+ (uim '(make-scm-pathname "/"))))
("test interaction-environment"
(assert-true (uim-bool '(eval '(symbol-bound? 'filter-map)
(interaction-environment))))
