core/io/files/files-tests.factor

   1 IN: io.files.tests
   2 USING: tools.test io.files io.files.private io threads kernel
   3 continuations io.encodings.ascii sequences
   4 strings accessors io.encodings.utf8 math destructors
   5 namespaces ;
   6
   7 \ exists? must-infer
   8 \ (exists?) must-infer
   9 \ file-info must-infer
  10 \ link-info must-infer
  11
  12 [ ] [ "blahblah" temp-file dup exists? [ delete-directory ] [ drop ] if ] unit-test
  13 [ ] [ "blahblah" temp-file make-directory ] unit-test
  14 [ t ] [ "blahblah" temp-file file-info directory? ] unit-test
  15
  16 [ t ] [
  17     [ temp-directory "loldir" append-path delete-directory ] ignore-errors
  18     temp-directory [
  19         "loldir" make-directory
  20     ] with-directory
  21     temp-directory "loldir" append-path exists?
  22 ] unit-test
  23
  24 [ ] [
  25     [ temp-directory "loldir" append-path delete-directory ] ignore-errors
  26     temp-directory [
  27         "loldir" make-directory
  28         "loldir" delete-directory
  29     ] with-directory
  30 ] unit-test
  31
  32 [ "file1 contents" ] [
  33     [ temp-directory "loldir" append-path delete-directory ] ignore-errors
  34     temp-directory [
  35         "file1 contents" "file1" utf8 set-file-contents
  36         "file1" "file2" copy-file
  37         "file2" utf8 file-contents
  38     ] with-directory
  39     "file1" temp-file delete-file
  40     "file2" temp-file delete-file
  41 ] unit-test
  42
  43 [ "file3 contents" ] [
  44     temp-directory [
  45         "file3 contents" "file3" utf8 set-file-contents
  46         "file3" "file4" move-file
  47         "file4" utf8 file-contents
  48     ] with-directory
  49     "file4" temp-file delete-file
  50 ] unit-test
  51
  52 [ "file5" temp-file delete-file ] ignore-errors
  53
  54 [ ] [
  55     temp-directory [
  56         "file5" touch-file
  57         "file5" delete-file
  58     ] with-directory
  59 ] unit-test
  60
  61 [ "file6" temp-file delete-file ] ignore-errors
  62
  63 [ ] [
  64     temp-directory [
  65         "file6" touch-file
  66         "file6" link-info drop
  67     ] with-directory
  68 ] unit-test
  69
  70 [ "passwd" ] [ "/etc/passwd" file-name ] unit-test
  71 [ "awk" ] [ "/usr/libexec/awk/" file-name ] unit-test
  72 [ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test
  73 [ "" ] [ "" file-name ] unit-test
  74
  75 [ "freetype6.dll" ] [ "resource:freetype6.dll" file-name ] unit-test
  76 [ "freetype6.dll" ] [ "resource:/freetype6.dll" file-name ] unit-test
  77
  78 [ ] [
  79     { "Hello world." }
  80     "test-foo.txt" temp-file ascii set-file-lines
  81 ] unit-test
  82
  83 [ ] [
  84     "test-foo.txt" temp-file ascii [
  85         "Hello appender." print
  86     ] with-file-appender
  87 ] unit-test
  88
  89 [ ] [
  90     "test-bar.txt" temp-file ascii [
  91         "Hello appender." print
  92     ] with-file-appender
  93 ] unit-test
  94
  95 [ "Hello world.\nHello appender.\n" ] [
  96     "test-foo.txt" temp-file ascii file-contents
  97 ] unit-test
  98
  99 [ "Hello appender.\n" ] [
 100     "test-bar.txt" temp-file ascii file-contents
 101 ] unit-test
 102
 103 [ ] [ "test-foo.txt" temp-file delete-file ] unit-test
 104
 105 [ ] [ "test-bar.txt" temp-file delete-file ] unit-test
 106
 107 [ f ] [ "test-foo.txt" temp-file exists? ] unit-test
 108
 109 [ f ] [ "test-bar.txt" temp-file exists? ] unit-test
 110
 111 [ "test-blah" temp-file delete-tree ] ignore-errors
 112
 113 [ ] [ "test-blah" temp-file make-directory ] unit-test
 114
 115 [ ] [
 116     "test-blah/fooz" temp-file ascii <file-writer> dispose
 117 ] unit-test
 118
 119 [ t ] [
 120     "test-blah/fooz" temp-file exists?
 121 ] unit-test
 122
 123 [ ] [ "test-blah/fooz" temp-file delete-file ] unit-test
 124
 125 [ ] [ "test-blah" temp-file delete-directory ] unit-test
 126
 127 [ f ] [ "test-blah" temp-file exists? ] unit-test
 128
 129 USE: debugger.threads
 130
 131 [ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
 132
 133 [ ] [ "test-quux.txt" temp-file delete-file ] unit-test
 134
 135 [ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
 136
 137 [ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] bi@ move-file ] unit-test
 138
 139 [ t ] [ "quux-test.txt" temp-file exists? ] unit-test
 140
 141 [ ] [ "quux-test.txt" temp-file delete-file ] unit-test
 142
 143 [ ] [ "delete-tree-test/a/b/c" temp-file make-directories ] unit-test
 144
 145 [ ] [
 146     { "Hi" }
 147     "delete-tree-test/a/b/c/d" temp-file ascii set-file-lines
 148 ] unit-test
 149
 150 [ ] [
 151     "delete-tree-test" temp-file delete-tree
 152 ] unit-test
 153
 154 [ { { "kernel" t } } ] [
 155     "core" resource-path [
 156         "." directory [ first "kernel" = ] filter
 157     ] with-directory
 158 ] unit-test
 159
 160 [ { { "kernel" t } } ] [
 161     "resource:core" [
 162         "." directory [ first "kernel" = ] filter
 163     ] with-directory
 164 ] unit-test
 165
 166 [ ] [
 167     "copy-tree-test/a/b/c" temp-file make-directories
 168 ] unit-test
 169
 170 [ ] [
 171     "Foobar"
 172     "copy-tree-test/a/b/c/d" temp-file
 173     ascii set-file-contents
 174 ] unit-test
 175
 176 [ ] [
 177     "copy-tree-test" temp-file
 178     "copy-destination" temp-file copy-tree
 179 ] unit-test
 180
 181 [ "Foobar" ] [
 182     "copy-destination/a/b/c/d" temp-file ascii file-contents
 183 ] unit-test
 184
 185 [ ] [
 186     "copy-destination" temp-file delete-tree
 187 ] unit-test
 188
 189 [ ] [
 190     "copy-tree-test" temp-file
 191     "copy-destination" temp-file copy-tree-into
 192 ] unit-test
 193
 194 [ "Foobar" ] [
 195     "copy-destination/copy-tree-test/a/b/c/d" temp-file ascii file-contents
 196 ] unit-test
 197
 198 [ ] [
 199     "copy-destination/copy-tree-test/a/b/c/d" temp-file "" temp-file copy-file-into
 200 ] unit-test
 201
 202 [ "Foobar" ] [
 203     "d" temp-file ascii file-contents
 204 ] unit-test
 205
 206 [ ] [ "d" temp-file delete-file ] unit-test
 207
 208 [ ] [ "copy-destination" temp-file delete-tree ] unit-test
 209
 210 [ ] [ "copy-tree-test" temp-file delete-tree ] unit-test
 211
 212 [ t ] [ cwd "misc" resource-path [ ] with-directory cwd = ] unit-test
 213
 214 [ t ] [
 215     temp-directory [ "hi41" "test41" utf8 set-file-contents ] with-directory
 216     temp-directory "test41" append-path utf8 file-contents "hi41" =
 217 ] unit-test
 218
 219 [ t ] [
 220     temp-directory [ "test41" file-info size>> ] with-directory 4 =
 221 ] unit-test
 222
 223 [ ] [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test
 224
 225 [ ] [ "append-test" temp-file ascii <file-appender> dispose ] unit-test
 226
 227 [ "/usr/lib" ] [ "/usr" "lib" append-path ] unit-test
 228 [ "/usr/lib" ] [ "/usr/" "lib" append-path ] unit-test
 229 [ "/usr/lib" ] [ "/usr" "./lib" append-path ] unit-test
 230 [ "/usr/lib/" ] [ "/usr" "./lib/" append-path ] unit-test
 231 [ "/lib" ] [ "/usr" "../lib" append-path ] unit-test
 232 [ "/lib/" ] [ "/usr" "../lib/" append-path ] unit-test
 233
 234 [ "" ] [ "" "." append-path ] unit-test
 235 [ "" ".." append-path ] must-fail
 236
 237 [ "/" ] [ "/" "./." append-path ] unit-test
 238 [ "/" ] [ "/" "././" append-path ] unit-test
 239 [ "/a/b/lib" ] [ "/a/b/c/d/e/f/" "../../../../lib" append-path ] unit-test
 240 [ "/a/b/lib/" ] [ "/a/b/c/d/e/f/" "../../../../lib/" append-path ] unit-test
 241
 242 [ "" "../lib/" append-path ] must-fail
 243 [ "lib" ] [ "" "lib" append-path ] unit-test
 244 [ "lib" ] [ "" "./lib" append-path ] unit-test
 245
 246 [ "foo/bar/." parent-directory ] must-fail
 247 [ "foo/bar/./" parent-directory ] must-fail
 248 [ "foo/bar/baz/.." parent-directory ] must-fail
 249 [ "foo/bar/baz/../" parent-directory ] must-fail
 250
 251 [ "." parent-directory ] must-fail
 252 [ "./" parent-directory ] must-fail
 253 [ ".." parent-directory ] must-fail
 254 [ "../" parent-directory ] must-fail
 255 [ "../../" parent-directory ] must-fail
 256 [ "foo/.." parent-directory ] must-fail
 257 [ "foo/../" parent-directory ] must-fail
 258 [ "" parent-directory ] must-fail
 259 [ "." ] [ "boot.x86.64.image" parent-directory ] unit-test
 260
 261 [ "bar/foo" ] [ "bar/baz" "..///foo" append-path ] unit-test
 262 [ "bar/baz/foo" ] [ "bar/baz" ".///foo" append-path ] unit-test
 263 [ "bar/foo" ] [ "bar/baz" "./..//foo" append-path ] unit-test
 264 [ "bar/foo" ] [ "bar/baz" "./../././././././///foo" append-path ] unit-test
 265
 266 [ t ] [ "resource:core" absolute-path? ] unit-test
 267 [ f ] [ "" absolute-path? ] unit-test
 268
 269 [ "touch-twice-test" temp-file delete-file ] ignore-errors
 270 [ ] [ 2 [ "touch-twice-test" temp-file touch-file ] times ] unit-test
 271
 272 ! aum's bug
 273 [
 274     "." current-directory set
 275     ".." "resource-path" set
 276     [ "../core/bootstrap/stage2.factor" ]
 277     [ "resource:core/bootstrap/stage2.factor" (normalize-path) ]
 278     unit-test
 279 ] with-scope