1(define-library (chibi pathname-test) 2 (export run-tests) 3 (import (scheme base) (chibi pathname) (chibi test)) 4 (begin 5 (define (run-tests) 6 (test-begin "pathname") 7 8 ;; tests from the dirname(3) manpage 9 10 (test "dirname(3)" "/usr" (path-directory "/usr/lib")) 11 (test "lib" (path-strip-directory "/usr/lib")) 12 13 (test "/" (path-directory "/usr/")) 14 (test "" (path-strip-directory "/usr/")) 15 16 (test "." (path-directory "usr")) 17 (test "usr" (path-strip-directory "usr")) 18 19 (test "/" (path-directory "/")) 20 (test "" (path-strip-directory "/")) 21 22 (test "." (path-directory ".")) 23 (test "." (path-strip-directory ".")) 24 25 (test "." (path-directory "..")) 26 (test ".." (path-strip-directory "..")) 27 28 ;; additional tests (should match GNU dirname/basename behavior) 29 30 (test "path-directory:border" 31 "/" (path-directory "//")) 32 (test "" (path-strip-directory "//")) 33 34 (test "." (path-directory "")) 35 (test "" (path-strip-directory "")) 36 37 (test "." (path-directory "../")) 38 (test "" (path-strip-directory "../")) 39 40 (test ".." (path-directory "../..")) 41 (test ".." (path-strip-directory "../..")) 42 43 (test "path-directory:extra" 44 "/usr/local" (path-directory "/usr/local/lib")) 45 (test "lib" (path-strip-directory "/usr/local/lib")) 46 47 (test "/usr" (path-directory "/usr/local/")) 48 (test "" (path-strip-directory "/usr/local/")) 49 50 (test "usr" (path-directory "usr/local")) 51 (test "local" (path-strip-directory "usr/local")) 52 53 (test "/" (path-directory "//usr")) 54 (test "usr" (path-strip-directory "//usr")) 55 56 (test "/" (path-directory "//usr/")) 57 (test "" (path-strip-directory "//usr/")) 58 59 (test "path-directory:small" 60 "/a" (path-directory "/a/b")) 61 (test "b" (path-strip-directory "/a/b")) 62 63 (test "a" (path-directory "a/b")) 64 (test "b" (path-strip-directory "a/b")) 65 66 (test "a" (path-directory "a/b/")) 67 (test "" (path-strip-directory "a/b/")) 68 69 (test "/a/b/c" (path-directory "/a/b/c/d")) 70 (test "d" (path-strip-directory "/a/b/c/d")) 71 72 (test "/a/b/c" (path-directory "/a/b/c/d/")) 73 (test "" (path-strip-directory "/a/b/c/d/")) 74 75 (test "a/b/c" (path-directory "a/b/c/d")) 76 (test "d" (path-strip-directory "a/b/c/d")) 77 78 (test "/a/b" (path-directory "/a/b/c.d")) 79 (test "c.d" (path-strip-directory "/a/b/c.d")) 80 81 (test "/a/b" (path-directory "/a/b/c.d/")) 82 (test "" (path-strip-directory "/a/b/c.d/")) 83 84 (test "/a/b/c" (path-directory "/a/b/c/.")) 85 (test "." (path-strip-directory "/a/b/c/.")) 86 87 (test "/a/b/c" (path-directory "/a/b/c/..")) 88 (test ".." (path-strip-directory "/a/b/c/..")) 89 90 (test "/a/b/." (path-directory "/a/b/./c")) 91 (test "c" (path-strip-directory "/a/b/./c")) 92 93 (test "/a/b/.." (path-directory "/a/b/../c")) 94 (test "c" (path-strip-directory "/a/b/../c")) 95 96 (test "/a/b" (path-directory "/a/b/c//")) 97 (test "" (path-strip-directory "/a/b/c//")) 98 99 (test "/a/b" (path-directory "/a/b//c///")) 100 (test "" (path-strip-directory "/a/b//c///")) 101 102 ;; extensions 103 104 (test "path-extension" "scm" (path-extension "foo.scm")) 105 (test "foo" (path-strip-extension "foo.scm")) 106 107 (test "c" (path-extension "foo.scm.c")) 108 (test "foo.scm" (path-strip-extension "foo.scm.c")) 109 110 (test "scm" (path-extension "/home/me/foo.scm")) 111 (test "/home/me/foo" (path-strip-extension "/home/me/foo.scm")) 112 113 (test "scm" (path-extension "foo..scm")) 114 (test "foo." (path-strip-extension "foo..scm")) 115 116 (test "s" (path-extension "foo.s")) 117 (test "foo" (path-strip-extension "foo.s")) 118 119 (test #f (path-extension "foo.")) 120 (test "foo." (path-strip-extension "foo.")) 121 122 (test #f (path-extension "foo.scm.")) 123 (test "foo.scm." (path-strip-extension "foo.scm.")) 124 125 (test #f (path-extension ".")) 126 (test "." (path-strip-extension ".")) 127 128 (test #f (path-extension "a.")) 129 (test "a." (path-strip-extension "a.")) 130 131 (test #f (path-extension "/.")) 132 (test "/." (path-strip-extension "/.")) 133 134 (test #f (path-extension "foo.scm/")) 135 (test "foo.scm/" (path-strip-extension "foo.scm/")) 136 137 (test "path-replace-extension" 138 "foo.c" (path-replace-extension "foo.scm" "c")) 139 (test "foo.c" (path-replace-extension "foo" "c")) 140 141 ;; absolute paths 142 143 (test-assert (path-absolute? "/")) 144 (test-assert (path-absolute? "//")) 145 (test-assert (path-absolute? "/usr")) 146 (test-assert (path-absolute? "/usr/")) 147 (test-assert (path-absolute? "/usr/.")) 148 (test-assert (path-absolute? "/usr/..")) 149 (test-assert (path-absolute? "/usr/./")) 150 (test-assert (path-absolute? "/usr/../")) 151 152 (test-assert (not (path-absolute? ""))) 153 (test-assert (not (path-absolute? "."))) 154 (test-assert (not (path-absolute? "usr"))) 155 (test-assert (not (path-absolute? "usr/"))) 156 157 ;; normalization & building 158 159 (test "path-normalize" "/a/b/c/d/e" (path-normalize "/a/b/c/d/./e")) 160 (test "/a/b/c/d/e" (path-normalize "/a/b//.///c//d/./e")) 161 (test "/a/b/c/d/e/" (path-normalize "/a/b//.///c//d/./e/")) 162 (test "/a/c/d/e" (path-normalize "/a/b/../c/d/e")) 163 (test "/a/b/c/e" (path-normalize "/a/b//.///c//d/../e")) 164 (test "/a/c/e" (path-normalize "/a/b//..///c//d/../e")) 165 (test "/a/b/c/d/e/" 166 (path-normalize "/a/b//./../c/d/../../b//c/d/e/f/..")) 167 (test "/a/b/c/" (path-normalize "/a/b/c/.")) 168 169 (test "path-normalize:border" "" (path-normalize "")) 170 (test "." (path-normalize ".")) 171 (test "/" (path-normalize "/")) 172 (test "/" (path-normalize "/.")) 173 174 (test "path-normalize:overflow" 175 "/" (path-normalize "/a/b/c/../../../../..")) 176 (test "../.." (path-normalize "a/b/c/../../../../..")) 177 (test "../../.." (path-normalize "../a/b/c/../../../../..")) 178 179 (test "" (path-strip-leading-parents "..")) 180 (test "" (path-strip-leading-parents "../")) 181 (test "a" (path-strip-leading-parents "../a")) 182 (test "a/b" (path-strip-leading-parents "../../a/b")) 183 (test "a/b" (path-strip-leading-parents "../../../a/b")) 184 (test "a/../b" (path-strip-leading-parents "../../../a/../b")) 185 186 (test "path-relative-to" "c" (path-relative-to "/a/b/c" "/a/b")) 187 (test "c" (path-relative-to "/a/b/c" "/a/b/")) 188 (test "." (path-relative-to "/a/b/" "/a/b/")) 189 (test "." (path-relative-to "/a/b/" "/a/b")) 190 (test "." (path-relative-to "/a/b" "/a/b/")) 191 (test "." (path-relative-to "/a/b" "/a/b")) 192 (test-not (path-relative-to "/d/a/b/c" "/a/b")) 193 194 (test "make-path" "a/b" (make-path "a" "b")) 195 (test "a/b" (make-path "a/" "b")) 196 (test "a/b/./c" (make-path "a" "b" "." "c")) 197 (test "a/b/../c" (make-path "a" "b" ".." "c")) 198 (test "a/b/c" (make-path "a" '("b" "c"))) 199 (test "/" (make-path "/" "")) 200 (test "/" (make-path "/" "/")) 201 (test "/." (make-path "/" ".")) 202 (test "/a" (make-path "/a" "")) 203 (test "/a" (make-path "/a" "/")) 204 (test "/a/." (make-path "/a" ".")) 205 206 (test-end)))) 207