(define-library (chibi pathname-test)
  (export run-tests)
  (import (scheme base) (chibi pathname) (chibi test))
  (begin
    (define (run-tests)
      (test-begin "pathname")

      ;; tests from the dirname(3) manpage

      (test "dirname(3)" "/usr" (path-directory "/usr/lib"))
      (test "lib"  (path-strip-directory "/usr/lib"))

      (test "/"    (path-directory "/usr/"))
      (test ""     (path-strip-directory "/usr/"))

      (test "."    (path-directory "usr"))
      (test "usr"  (path-strip-directory "usr"))

      (test "/"    (path-directory "/"))
      (test ""     (path-strip-directory "/"))

      (test "."    (path-directory "."))
      (test "."    (path-strip-directory "."))

      (test "."    (path-directory ".."))
      (test ".."   (path-strip-directory ".."))

      ;; additional tests (should match GNU dirname/basename behavior)

      (test "path-directory:border"
          "/"    (path-directory "//"))
      (test ""     (path-strip-directory "//"))

      (test "."    (path-directory ""))
      (test ""     (path-strip-directory ""))

      (test "."    (path-directory "../"))
      (test ""     (path-strip-directory "../"))

      (test ".."   (path-directory "../.."))
      (test ".."   (path-strip-directory "../.."))

      (test "path-directory:extra"
          "/usr/local" (path-directory "/usr/local/lib"))
      (test "lib" (path-strip-directory "/usr/local/lib"))

      (test "/usr" (path-directory "/usr/local/"))
      (test "" (path-strip-directory "/usr/local/"))

      (test "usr"    (path-directory "usr/local"))
      (test "local"  (path-strip-directory "usr/local"))

      (test "/" (path-directory "//usr"))
      (test "usr" (path-strip-directory "//usr"))

      (test "/" (path-directory "//usr/"))
      (test "" (path-strip-directory "//usr/"))

      (test "path-directory:small"
          "/a" (path-directory "/a/b"))
      (test "b" (path-strip-directory "/a/b"))

      (test "a" (path-directory "a/b"))
      (test "b" (path-strip-directory "a/b"))

      (test "a" (path-directory "a/b/"))
      (test "" (path-strip-directory "a/b/"))

      (test "/a/b/c" (path-directory "/a/b/c/d"))
      (test "d" (path-strip-directory "/a/b/c/d"))

      (test "/a/b/c" (path-directory "/a/b/c/d/"))
      (test "" (path-strip-directory "/a/b/c/d/"))

      (test "a/b/c"    (path-directory "a/b/c/d"))
      (test "d"  (path-strip-directory "a/b/c/d"))

      (test "/a/b" (path-directory "/a/b/c.d"))
      (test "c.d" (path-strip-directory "/a/b/c.d"))

      (test "/a/b" (path-directory "/a/b/c.d/"))
      (test "" (path-strip-directory "/a/b/c.d/"))

      (test "/a/b/c" (path-directory "/a/b/c/."))
      (test "." (path-strip-directory "/a/b/c/."))

      (test "/a/b/c" (path-directory "/a/b/c/.."))
      (test ".." (path-strip-directory "/a/b/c/.."))

      (test "/a/b/." (path-directory "/a/b/./c"))
      (test "c" (path-strip-directory "/a/b/./c"))

      (test "/a/b/.." (path-directory "/a/b/../c"))
      (test "c" (path-strip-directory "/a/b/../c"))

      (test "/a/b" (path-directory "/a/b/c//"))
      (test "" (path-strip-directory "/a/b/c//"))

      (test "/a/b" (path-directory "/a/b//c///"))
      (test "" (path-strip-directory "/a/b//c///"))

      ;; extensions

      (test "path-extension" "scm" (path-extension "foo.scm"))
      (test "foo" (path-strip-extension "foo.scm"))

      (test "c" (path-extension "foo.scm.c"))
      (test "foo.scm" (path-strip-extension "foo.scm.c"))

      (test "scm" (path-extension "/home/me/foo.scm"))
      (test "/home/me/foo" (path-strip-extension "/home/me/foo.scm"))

      (test "scm" (path-extension "foo..scm"))
      (test "foo." (path-strip-extension "foo..scm"))

      (test "s" (path-extension "foo.s"))
      (test "foo" (path-strip-extension "foo.s"))

      (test #f (path-extension "foo."))
      (test "foo." (path-strip-extension "foo."))

      (test #f (path-extension "foo.scm."))
      (test "foo.scm." (path-strip-extension "foo.scm."))

      (test #f (path-extension "."))
      (test "." (path-strip-extension "."))

      (test #f (path-extension "a."))
      (test "a." (path-strip-extension "a."))

      (test #f (path-extension "/."))
      (test "/." (path-strip-extension "/."))

      (test #f (path-extension "foo.scm/"))
      (test "foo.scm/" (path-strip-extension "foo.scm/"))

      (test "path-replace-extension"
          "foo.c" (path-replace-extension "foo.scm" "c"))
      (test "foo.c" (path-replace-extension "foo" "c"))

      ;; absolute paths

      (test-assert (path-absolute? "/"))
      (test-assert (path-absolute? "//"))
      (test-assert (path-absolute? "/usr"))
      (test-assert (path-absolute? "/usr/"))
      (test-assert (path-absolute? "/usr/."))
      (test-assert (path-absolute? "/usr/.."))
      (test-assert (path-absolute? "/usr/./"))
      (test-assert (path-absolute? "/usr/../"))

      (test-assert (not (path-absolute? "")))
      (test-assert (not (path-absolute? ".")))
      (test-assert (not (path-absolute? "usr")))
      (test-assert (not (path-absolute? "usr/")))

      ;; normalization & building

      (test "path-normalize" "/a/b/c/d/e" (path-normalize "/a/b/c/d/./e"))
      (test "/a/b/c/d/e" (path-normalize "/a/b//.///c//d/./e"))
      (test "/a/b/c/d/e/" (path-normalize "/a/b//.///c//d/./e/"))
      (test "/a/c/d/e" (path-normalize "/a/b/../c/d/e"))
      (test "/a/b/c/e" (path-normalize "/a/b//.///c//d/../e"))
      (test "/a/c/e" (path-normalize "/a/b//..///c//d/../e"))
      (test "/a/b/c/d/e/"
          (path-normalize "/a/b//./../c/d/../../b//c/d/e/f/.."))
      (test "/a/b/c/" (path-normalize "/a/b/c/."))

      (test "path-normalize:border" "" (path-normalize ""))
      (test "." (path-normalize "."))
      (test "/" (path-normalize "/"))
      (test "/" (path-normalize "/."))

      (test "path-normalize:overflow"
          "/" (path-normalize "/a/b/c/../../../../.."))
      (test "../.." (path-normalize "a/b/c/../../../../.."))
      (test "../../.." (path-normalize "../a/b/c/../../../../.."))

      (test "" (path-strip-leading-parents ".."))
      (test "" (path-strip-leading-parents "../"))
      (test "a" (path-strip-leading-parents "../a"))
      (test "a/b" (path-strip-leading-parents "../../a/b"))
      (test "a/b" (path-strip-leading-parents "../../../a/b"))
      (test "a/../b" (path-strip-leading-parents "../../../a/../b"))

      (test "path-relative-to" "c" (path-relative-to "/a/b/c" "/a/b"))
      (test "c" (path-relative-to "/a/b/c" "/a/b/"))
      (test "." (path-relative-to "/a/b/" "/a/b/"))
      (test "." (path-relative-to "/a/b/" "/a/b"))
      (test "." (path-relative-to "/a/b" "/a/b/"))
      (test "." (path-relative-to "/a/b" "/a/b"))
      (test-not (path-relative-to "/d/a/b/c" "/a/b"))

      (test "make-path" "a/b" (make-path "a" "b"))
      (test "a/b" (make-path "a/" "b"))
      (test "a/b/./c" (make-path "a" "b" "." "c"))
      (test "a/b/../c" (make-path "a" "b" ".." "c"))
      (test "a/b/c" (make-path "a" '("b" "c")))
      (test "/" (make-path "/" ""))
      (test "/" (make-path "/" "/"))
      (test "/." (make-path "/" "."))
      (test "/a" (make-path "/a" ""))
      (test "/a" (make-path "/a" "/"))
      (test "/a/." (make-path "/a" "."))

      (test-end))))