core/io/pathnames/pathnames-tests.factor

   1 USING: io.pathnames io.files.temp io.directories
   2 continuations math io.files.private kernel
   3 namespaces sequences system tools.test
   4 io.backend io.pathnames.private ;
   5 IN: io.pathnames.tests
   6
   7 { "passwd" } [ "/etc/passwd" file-name ] unit-test
   8 { "awk" } [ "/usr/libexec/awk/" file-name ] unit-test
   9 { "awk" } [ "/usr/libexec/awk///" file-name ] unit-test
  10 { "" } [ "" file-name ] unit-test
  11
  12 { "freetype6.dll" } [ "resource:freetype6.dll" file-name ] unit-test
  13 { "freetype6.dll" } [ "resource:/freetype6.dll" file-name ] unit-test
  14
  15 { "/usr/lib" } [ "/usr" "lib" append-path ] unit-test
  16 { "/usr/lib" } [ "/usr/" "lib" append-path ] unit-test
  17 { "/usr/lib" } [ "/usr" "./lib" append-path ] unit-test
  18 { "/usr/lib/" } [ "/usr" "./lib/" append-path ] unit-test
  19 { "/lib" } [ "/usr" "../lib" append-path ] unit-test
  20 { "/lib/" } [ "/usr" "../lib/" append-path ] unit-test
  21
  22 { "" } [ "" "." append-path ] unit-test
  23 [ "" ".." append-path ] must-fail
  24
  25 { "/" } [ "/" "./." append-path ] unit-test
  26 { "/" } [ "/" "././" append-path ] unit-test
  27 { "/a/b/lib" } [ "/a/b/c/d/e/f/" "../../../../lib" append-path ] unit-test
  28 { "/a/b/lib/" } [ "/a/b/c/d/e/f/" "../../../../lib/" append-path ] unit-test
  29
  30 [ "" "../lib/" append-path ] must-fail
  31 { "lib" } [ "" "lib" append-path ] unit-test
  32 { "lib" } [ "" "./lib" append-path ] unit-test
  33
  34 [ "foo/bar/." parent-directory ] must-fail
  35 [ "foo/bar/./" parent-directory ] must-fail
  36 [ "foo/bar/baz/.." parent-directory ] must-fail
  37 [ "foo/bar/baz/../" parent-directory ] must-fail
  38
  39 [ "." parent-directory ] must-fail
  40 [ "./" parent-directory ] must-fail
  41 [ ".." parent-directory ] must-fail
  42 [ "../" parent-directory ] must-fail
  43 [ "../../" parent-directory ] must-fail
  44 [ "foo/.." parent-directory ] must-fail
  45 [ "foo/../" parent-directory ] must-fail
  46 [ "" parent-directory ] must-fail
  47 { "." } [ "boot.x86.64.image" parent-directory ] unit-test
  48
  49 { "bar/foo" } [ "bar/baz" "..///foo" append-path ] unit-test
  50 { "bar/baz/foo" } [ "bar/baz" ".///foo" append-path ] unit-test
  51 { "bar/foo" } [ "bar/baz" "./..//foo" append-path ] unit-test
  52 { "bar/foo" } [ "bar/baz" "./../././././././///foo" append-path ] unit-test
  53
  54 { t } [ "resource:core" absolute-path? ] unit-test
  55 { f } [ "" absolute-path? ] unit-test
  56
  57 [ "touch-twice-test" temp-file delete-file ] ignore-errors
  58 { } [ 2 [ "touch-twice-test" temp-file touch-file ] times ] unit-test
  59
  60 ! aum's bug
  61 [
  62     "." current-directory set
  63     ".." "resource-path" set
  64     [ "../core/bootstrap/stage2.factor" ]
  65     [ "resource:core/bootstrap/stage2.factor" absolute-path ]
  66     unit-test
  67 ] with-scope
  68
  69 { t } [ cwd "misc" resource-path [ ] with-directory cwd = ] unit-test
  70
  71 ! Regression test for bug in file-extension
  72 { f } [ "/funny.directory/file-with-no-extension" file-extension ] unit-test
  73 { "" } [ "/funny.directory/file-with-no-extension." file-extension ] unit-test
  74
  75 ! Testing ~ special pathname
  76 { t } [ os windows? "~\\" "~/" ? absolute-path home = ] unit-test
  77 { t } [ "~/" home [ normalize-path ] same? ] unit-test
  78
  79 { t } [ "~" absolute-path home = ] unit-test
  80 { t } [ "~" home [ normalize-path ] same? ] unit-test
  81
  82 { t } [ "~" home [ "foo" append-path ] bi@ [ normalize-path ] same? ] unit-test
  83 { t } [ os windows? "~\\~/" "~/~/" ? "~" "~" append-path [ path-components ] same? ] unit-test