basis/io/directories/directories-tests.factor

   1 USING: arrays combinators destructors grouping io io.directories
   2 io.encodings.ascii io.encodings.utf8 io.files io.files.info
   3 io.files.unique io.launcher io.pathnames kernel math namespaces
   4 sequences sorting splitting splitting.monotonic strings system
   5 tools.test ;
   6
   7 { { "kernel" } } [
   8     "core" resource-path [
   9         "." directory-files [ "kernel" = ] filter
  10     ] with-directory
  11 ] unit-test
  12
  13 { { "kernel" } } [
  14     "resource:core" [
  15         "." directory-files [ "kernel" = ] filter
  16     ] with-directory
  17 ] unit-test
  18
  19 { { "kernel" } } [
  20     "resource:core" [
  21         [ "kernel" = ] filter
  22     ] with-directory-files
  23 ] unit-test
  24
  25 [
  26     { t t f } [
  27         "blahblah" make-directory
  28         "blahblah" file-exists?
  29         "blahblah" file-info directory?
  30         "blahblah" delete-directory
  31         "blahblah" file-exists?
  32     ] unit-test
  33
  34     { "file1 contents" } [
  35         "file1 contents" "file1" utf8 set-file-contents
  36         "file1" "file2" copy-file
  37         "file2" utf8 file-contents
  38         "file1" delete-file
  39         "file2" delete-file
  40     ] unit-test
  41
  42     { "file3 contents" } [
  43         "file3 contents" "file3" utf8 set-file-contents
  44         "file3" "file4" move-file
  45         "file4" utf8 file-contents
  46         "file4" delete-file
  47     ] unit-test
  48
  49     { } [
  50         "file5" touch-file
  51         "file5" delete-file
  52     ] unit-test
  53
  54     { } [
  55         "file6" touch-file
  56         "file6" link-info drop
  57     ] unit-test
  58
  59     { } [
  60         { "Hello world." }
  61         "test-foo.txt" ascii set-file-lines
  62     ] unit-test
  63
  64     { } [
  65         "test-foo.txt" ascii [
  66             "Hello appender." print
  67         ] with-file-appender
  68     ] unit-test
  69
  70     { } [
  71         "test-bar.txt" ascii [
  72             "Hello appender." print
  73         ] with-file-appender
  74     ] unit-test
  75
  76     { "Hello world.\nHello appender.\n" } [
  77         "test-foo.txt" ascii file-contents
  78     ] unit-test
  79
  80     { "Hello appender.\n" } [
  81         "test-bar.txt" ascii file-contents
  82     ] unit-test
  83
  84     { } [ "test-foo.txt" delete-file ] unit-test
  85     { } [ "test-bar.txt" delete-file ] unit-test
  86
  87     { f } [ "test-foo.txt" file-exists? ] unit-test
  88     { f } [ "test-bar.txt" file-exists? ] unit-test
  89
  90     { } [ "test-blah" make-directory ] unit-test
  91
  92     { } [
  93         "test-blah/fooz" ascii <file-writer> dispose
  94     ] unit-test
  95
  96     { t } [
  97         "test-blah/fooz" file-exists?
  98     ] unit-test
  99
 100     { } [ "test-blah/fooz" delete-file ] unit-test
 101     { } [ "test-blah" delete-directory ] unit-test
 102
 103     { f } [ "test-blah" file-exists? ] unit-test
 104
 105     { } [ "delete-tree-test/a/b/c" make-directories ] unit-test
 106
 107     { } [
 108         { "Hi" } "delete-tree-test/a/b/c/d" ascii set-file-lines
 109     ] unit-test
 110
 111     { } [ "delete-tree-test" delete-tree ] unit-test
 112
 113     { } [
 114         "copy-tree-test/a/b/c" make-directories
 115     ] unit-test
 116
 117     { } [
 118         "Foobar"
 119         "copy-tree-test/a/b/c/d"
 120         ascii set-file-contents
 121     ] unit-test
 122
 123     { } [
 124         "copy-tree-test" "copy-destination" copy-tree
 125     ] unit-test
 126
 127     { "Foobar" } [
 128         "copy-destination/a/b/c/d" ascii file-contents
 129     ] unit-test
 130
 131     { } [
 132         "copy-destination" delete-tree
 133     ] unit-test
 134
 135     { } [
 136         "copy-tree-test" "copy-destination" copy-tree-into
 137     ] unit-test
 138
 139     { "Foobar" } [
 140         "copy-destination/copy-tree-test/a/b/c/d" ascii file-contents
 141     ] unit-test
 142
 143     ! copy-file
 144     { } [
 145         "resource:LICENSE.txt" "test" copy-file
 146     ] unit-test
 147
 148     ! copy-file-into
 149     { } [
 150         "copy-destination/copy-tree-test/a/b/c/d" "." copy-file-into
 151     ] unit-test
 152
 153     { "Foobar" } [
 154         "d" ascii file-contents
 155     ] unit-test
 156
 157     { } [ "d" delete-file ] unit-test
 158
 159     { } [ "copy-destination" delete-tree ] unit-test
 160
 161     { } [ "copy-tree-test" delete-tree ] unit-test
 162
 163     ! Issue #890
 164     { f t } [
 165         "foo" [ make-directories ] keep
 166         [
 167             "bar" file-exists?
 168             vm-path "-e=USE: io.directories \"bar\" touch-file" 2array try-output-process
 169             "bar" file-exists?
 170         ] with-directory
 171     ] unit-test
 172
 173     { t } [
 174         "one/two/three" make-parent-directories parent-directory file-exists?
 175     ] unit-test
 176
 177 ] with-test-directory
 178
 179 { t } [
 180     [
 181         10 [ "io.paths.test" "gogogo" unique-file ] replicate
 182         "." [ ] find-files [ absolute-path ] map [ natural-sort ] same?
 183     ] with-test-directory
 184 ] unit-test
 185
 186 { f } [
 187     { "omg you shoudnt have a directory called this" "or this" }
 188     [ "asdfasdfasdfasdfasdf" tail? ] find-file-in-directories
 189 ] unit-test
 190
 191 { f } [
 192     { } [ "asdfasdfasdfasdfasdf" tail? ] find-file-in-directories
 193 ] unit-test
 194
 195 { t } [
 196     [
 197         "the-head" "" unique-file drop
 198         "." [ file-name "the-head" head? ] find-file string?
 199     ] with-test-directory
 200 ] unit-test
 201
 202 { t } [
 203     [
 204         { "foo" "bar" } {
 205             [ [ make-directory ] each ]
 206             [ [ "abcd" append-path touch-file ] each ]
 207             [ [ file-name "abcd" = ] find-files-in-directories length 2 = ]
 208             [ [ delete-tree ] each ]
 209         } cleave
 210     ] with-test-directory
 211 ] unit-test
 212
 213 { t } [
 214     "resource:core/math/integers/integers.factor"
 215     [ "math.factor" tail? ] find-up-to-root >boolean
 216 ] unit-test
 217
 218 { f } [
 219     "resource:core/math/integers/integers.factor"
 220     [ drop f ] find-up-to-root
 221 ] unit-test
 222
 223 [
 224     {
 225         "a"
 226         "a/a"
 227         "a/a/a"
 228         "a/b"
 229         "a/b/a"
 230         "b"
 231         "b/a"
 232         "b/a/a"
 233         "b/b"
 234         "b/b/a"
 235         "c"
 236         "c/a"
 237         "c/a/a"
 238         "c/b"
 239         "c/b/a"
 240     }
 241     {
 242         "a"
 243         "b"
 244         "c"
 245         "a/a"
 246         "a/b"
 247         "b/a"
 248         "b/b"
 249         "c/a"
 250         "c/b"
 251         "a/a/a"
 252         "a/b/a"
 253         "b/a/a"
 254         "b/b/a"
 255         "c/a/a"
 256         "c/b/a"
 257     }
 258 ] [
 259     [
 260         "a" make-directory
 261         "a/a" make-directory
 262         "a/a/a" touch-file
 263         "a/b" make-directory
 264         "a/b/a" touch-file
 265         "b" make-directory
 266         "b/a" make-directory
 267         "b/a/a" touch-file
 268         "b/b" make-directory
 269         "b/b/a" touch-file
 270         "c" make-directory
 271         "c/a" make-directory
 272         "c/a/a" touch-file
 273         "c/b" make-directory
 274         "c/b/a" touch-file
 275
 276         +depth-first+ traversal-method [
 277             "." recursive-directory-files
 278             current-directory get '[ _ ?head drop ] map
 279
 280             ! preserve file traversal order, but sort
 281             ! alphabetically for cross-platform testing
 282             dup length 3 / group natural-sort
 283             [ natural-sort ] map concat
 284         ] with-variable
 285
 286         +breadth-first+ traversal-method [
 287             "." recursive-directory-files
 288             current-directory get '[ _ ?head drop ] map
 289
 290             ! preserve file traversal order, but sort
 291             ! alphabetically for cross-platform testing
 292             [ [ length ] bi@ = ] monotonic-split
 293             [ natural-sort ] map concat
 294         ] with-variable
 295     ] with-test-directory
 296 ] unit-test