(module file mzscheme
(require "../file.ss"
(planet "test.ss" ("schematics" "schemeunit.plt" 1))
(planet "test.ss" ("dherman" "test.plt" 1)))
(provide file-test)
(define-syntax in-tmp-dir
(syntax-rules ()
[(_ . body)
(in-new-directory "Planet-scripting-tests" . body)]))
(define file-test
(make-test-suite "file.ss"
(make-test-case "path-wrt-path"
(assert-equal? (path-wrt-path "/home/ryan" "subdir")
(build-path "/" "home" "ryan" "subdir"))
(assert-equal? (path-wrt-path "/home/ryan" "/tmp")
(build-path "/" "tmp")))
(make-test-case "replace-file-extension"
(assert-equal? (replace-file-extension "foo.txt" "jpg")
(string->path "foo.jpg"))
(assert-equal? (replace-file-extension "/home/foo.txt" "jpg")
(string->path "/home/foo.jpg")))
(make-test-case "pathlike-append"
(assert-equal? (pathlike-append "here/"
"and"
(string->path "there"))
(string->path "here/andthere")))
(make-test-case "touch"
(in-tmp-dir
(touch "foo.tmp")
(assert-true (file-exists? "foo.tmp"))
(assert-equal? (file-size "foo.tmp") 0)))
(make-test-case "check-file-exists"
(in-tmp-dir
(touch "foo.tmp")
(check-file-exists 'testing "foo.tmp")
(assert-exn exn:fail:filesystem?
(lambda () (check-file-exists 'testing "bar.tmp")))))
(make-test-case "directory-list/sorted"
(in-tmp-dir
(touch "b")
(touch "a")
(assert-equal? (map path->string (directory-list/sorted))
'("a" "b"))))
(make-test-case "directory-list/paths and directory-list/absolute"
(in-tmp-dir
(make-directory "TestingDLP")
(touch (build-path "TestingDLP" "a"))
(touch (build-path "TestingDLP" "b"))
(assert-equal?
(directory-list/paths "TestingDLP")
(list (build-path "TestingDLP" "a")
(build-path "TestingDLP" "b")))
(assert-equal?
(directory-list/absolute "TestingDLP")
(list (build-path (current-directory) "TestingDLP" "a")
(build-path (current-directory) "TestingDLP" "b")))))
(make-test-case "newer?"
(in-tmp-dir
(with-output-to-file "old" (lambda () (newline)))
(sleep 1)
(with-output-to-file "new" (lambda () (newline)))
(assert-true (file-exists? "old"))
(assert-true (file-exists? "new"))
(assert-true (newer? "new" "old") "new is newer")
(assert-false (newer? "old" "new") "old is not newer")
(assert-true (newer? "new" "not-there")
"new is newer than anything not there")
(assert-false (newer? "not-there" "old")
"not-there is not newer than something old")))
))
)