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" } ] [
 155     "core" resource-path [
 156         "." directory-files [ "kernel" = ] filter
 157     ] with-directory
 158 ] unit-test
 159
 160 [ { "kernel" } ] [
 161     "resource:core" [
 162         "." directory-files [ "kernel" = ] filter
 163     ] with-directory
 164 ] unit-test
 165
 166 [ { "kernel" } ] [
 167     "resource:core" [
 168         [ "kernel" = ] filter
 169     ] with-directory-files
 170 ] unit-test
 171
 172 [ ] [
 173     "copy-tree-test/a/b/c" temp-file make-directories
 174 ] unit-test
 175
 176 [ ] [
 177     "Foobar"
 178     "copy-tree-test/a/b/c/d" temp-file
 179     ascii set-file-contents
 180 ] unit-test
 181
 182 [ ] [
 183     "copy-tree-test" temp-file
 184     "copy-destination" temp-file copy-tree
 185 ] unit-test
 186
 187 [ "Foobar" ] [
 188     "copy-destination/a/b/c/d" temp-file ascii file-contents
 189 ] unit-test
 190
 191 [ ] [
 192     "copy-destination" temp-file delete-tree
 193 ] unit-test
 194
 195 [ ] [
 196     "copy-tree-test" temp-file
 197     "copy-destination" temp-file copy-tree-into
 198 ] unit-test
 199
 200 [ "Foobar" ] [
 201     "copy-destination/copy-tree-test/a/b/c/d" temp-file ascii file-contents
 202 ] unit-test
 203
 204 [ ] [
 205     "copy-destination/copy-tree-test/a/b/c/d" temp-file "" temp-file copy-file-into
 206 ] unit-test
 207
 208 [ "Foobar" ] [
 209     "d" temp-file ascii file-contents
 210 ] unit-test
 211
 212 [ ] [ "d" temp-file delete-file ] unit-test
 213
 214 [ ] [ "copy-destination" temp-file delete-tree ] unit-test
 215
 216 [ ] [ "copy-tree-test" temp-file delete-tree ] unit-test
 217
 218 [ t ] [ cwd "misc" resource-path [ ] with-directory cwd = ] unit-test
 219
 220 [ t ] [
 221     temp-directory [ "hi41" "test41" utf8 set-file-contents ] with-directory
 222     temp-directory "test41" append-path utf8 file-contents "hi41" =
 223 ] unit-test
 224
 225 [ t ] [
 226     temp-directory [ "test41" file-info size>> ] with-directory 4 =
 227 ] unit-test
 228
 229 [ ] [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test
 230
 231 [ ] [ "append-test" temp-file ascii <file-appender> dispose ] unit-test
 232
 233 [ "/usr/lib" ] [ "/usr" "lib" append-path ] unit-test
 234 [ "/usr/lib" ] [ "/usr/" "lib" append-path ] unit-test
 235 [ "/usr/lib" ] [ "/usr" "./lib" append-path ] unit-test
 236 [ "/usr/lib/" ] [ "/usr" "./lib/" append-path ] unit-test
 237 [ "/lib" ] [ "/usr" "../lib" append-path ] unit-test
 238 [ "/lib/" ] [ "/usr" "../lib/" append-path ] unit-test
 239
 240 [ "" ] [ "" "." append-path ] unit-test
 241 [ "" ".." append-path ] must-fail
 242
 243 [ "/" ] [ "/" "./." append-path ] unit-test
 244 [ "/" ] [ "/" "././" append-path ] unit-test
 245 [ "/a/b/lib" ] [ "/a/b/c/d/e/f/" "../../../../lib" append-path ] unit-test
 246 [ "/a/b/lib/" ] [ "/a/b/c/d/e/f/" "../../../../lib/" append-path ] unit-test
 247
 248 [ "" "../lib/" append-path ] must-fail
 249 [ "lib" ] [ "" "lib" append-path ] unit-test
 250 [ "lib" ] [ "" "./lib" append-path ] unit-test
 251
 252 [ "foo/bar/." parent-directory ] must-fail
 253 [ "foo/bar/./" parent-directory ] must-fail
 254 [ "foo/bar/baz/.." parent-directory ] must-fail
 255 [ "foo/bar/baz/../" parent-directory ] must-fail
 256
 257 [ "." parent-directory ] must-fail
 258 [ "./" parent-directory ] must-fail
 259 [ ".." parent-directory ] must-fail
 260 [ "../" parent-directory ] must-fail
 261 [ "../../" parent-directory ] must-fail
 262 [ "foo/.." parent-directory ] must-fail
 263 [ "foo/../" parent-directory ] must-fail
 264 [ "" parent-directory ] must-fail
 265 [ "." ] [ "boot.x86.64.image" parent-directory ] unit-test
 266
 267 [ "bar/foo" ] [ "bar/baz" "..///foo" append-path ] unit-test
 268 [ "bar/baz/foo" ] [ "bar/baz" ".///foo" append-path ] unit-test
 269 [ "bar/foo" ] [ "bar/baz" "./..//foo" append-path ] unit-test
 270 [ "bar/foo" ] [ "bar/baz" "./../././././././///foo" append-path ] unit-test
 271
 272 [ t ] [ "resource:core" absolute-path? ] unit-test
 273 [ f ] [ "" absolute-path? ] unit-test
 274
 275 [ "touch-twice-test" temp-file delete-file ] ignore-errors
 276 [ ] [ 2 [ "touch-twice-test" temp-file touch-file ] times ] unit-test
 277
 278 ! aum's bug
 279 [
 280     "." current-directory set
 281     ".." "resource-path" set
 282     [ "../core/bootstrap/stage2.factor" ]
 283     [ "resource:core/bootstrap/stage2.factor" (normalize-path) ]
 284     unit-test
 285 ] with-scope
 286
 287 [ t ] [ "/" file-system-info file-system-info? ] unit-test
 288 [ t ] [ file-systems [ file-system-info? ] all? ] unit-test