2008-12-14 23:38:14 -05:00
|
|
|
USING: io.pathnames io.files.temp io.directories
|
|
|
|
continuations math io.files.private kernel
|
|
|
|
namespaces tools.test ;
|
2008-12-14 21:03:00 -05:00
|
|
|
IN: io.pathnames.tests
|
|
|
|
|
|
|
|
[ "passwd" ] [ "/etc/passwd" file-name ] unit-test
|
|
|
|
[ "awk" ] [ "/usr/libexec/awk/" file-name ] unit-test
|
|
|
|
[ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test
|
|
|
|
[ "" ] [ "" file-name ] unit-test
|
|
|
|
|
|
|
|
[ "freetype6.dll" ] [ "resource:freetype6.dll" file-name ] unit-test
|
|
|
|
[ "freetype6.dll" ] [ "resource:/freetype6.dll" file-name ] unit-test
|
|
|
|
|
|
|
|
[ "/usr/lib" ] [ "/usr" "lib" append-path ] unit-test
|
|
|
|
[ "/usr/lib" ] [ "/usr/" "lib" append-path ] unit-test
|
|
|
|
[ "/usr/lib" ] [ "/usr" "./lib" append-path ] unit-test
|
|
|
|
[ "/usr/lib/" ] [ "/usr" "./lib/" append-path ] unit-test
|
|
|
|
[ "/lib" ] [ "/usr" "../lib" append-path ] unit-test
|
|
|
|
[ "/lib/" ] [ "/usr" "../lib/" append-path ] unit-test
|
|
|
|
|
|
|
|
[ "" ] [ "" "." append-path ] unit-test
|
|
|
|
[ "" ".." append-path ] must-fail
|
|
|
|
|
|
|
|
[ "/" ] [ "/" "./." append-path ] unit-test
|
|
|
|
[ "/" ] [ "/" "././" append-path ] unit-test
|
|
|
|
[ "/a/b/lib" ] [ "/a/b/c/d/e/f/" "../../../../lib" append-path ] unit-test
|
|
|
|
[ "/a/b/lib/" ] [ "/a/b/c/d/e/f/" "../../../../lib/" append-path ] unit-test
|
|
|
|
|
|
|
|
[ "" "../lib/" append-path ] must-fail
|
|
|
|
[ "lib" ] [ "" "lib" append-path ] unit-test
|
|
|
|
[ "lib" ] [ "" "./lib" append-path ] unit-test
|
|
|
|
|
|
|
|
[ "foo/bar/." parent-directory ] must-fail
|
|
|
|
[ "foo/bar/./" parent-directory ] must-fail
|
|
|
|
[ "foo/bar/baz/.." parent-directory ] must-fail
|
|
|
|
[ "foo/bar/baz/../" parent-directory ] must-fail
|
|
|
|
|
|
|
|
[ "." parent-directory ] must-fail
|
|
|
|
[ "./" parent-directory ] must-fail
|
|
|
|
[ ".." parent-directory ] must-fail
|
|
|
|
[ "../" parent-directory ] must-fail
|
|
|
|
[ "../../" parent-directory ] must-fail
|
|
|
|
[ "foo/.." parent-directory ] must-fail
|
|
|
|
[ "foo/../" parent-directory ] must-fail
|
|
|
|
[ "" parent-directory ] must-fail
|
|
|
|
[ "." ] [ "boot.x86.64.image" parent-directory ] unit-test
|
|
|
|
|
|
|
|
[ "bar/foo" ] [ "bar/baz" "..///foo" append-path ] unit-test
|
|
|
|
[ "bar/baz/foo" ] [ "bar/baz" ".///foo" append-path ] unit-test
|
|
|
|
[ "bar/foo" ] [ "bar/baz" "./..//foo" append-path ] unit-test
|
|
|
|
[ "bar/foo" ] [ "bar/baz" "./../././././././///foo" append-path ] unit-test
|
|
|
|
|
|
|
|
[ t ] [ "resource:core" absolute-path? ] unit-test
|
|
|
|
[ f ] [ "" absolute-path? ] unit-test
|
|
|
|
|
|
|
|
[ "touch-twice-test" temp-file delete-file ] ignore-errors
|
|
|
|
[ ] [ 2 [ "touch-twice-test" temp-file touch-file ] times ] unit-test
|
|
|
|
|
|
|
|
! aum's bug
|
|
|
|
[
|
|
|
|
"." current-directory set
|
|
|
|
".." "resource-path" set
|
|
|
|
[ "../core/bootstrap/stage2.factor" ]
|
|
|
|
[ "resource:core/bootstrap/stage2.factor" (normalize-path) ]
|
|
|
|
unit-test
|
|
|
|
] with-scope
|
|
|
|
|
|
|
|
[ t ] [ cwd "misc" resource-path [ ] with-directory cwd = ] unit-test
|