core/io/files/files-tests.factor

   1 USING: arrays debugger.threads destructors io io.directories
   2 io.encodings.ascii io.encodings.binary
   3 io.files io.files.private io.files.temp io.files.unique kernel
   4 make math sequences system threads tools.test generic.single
   5 io.encodings.8-bit.latin1 ;
   6 IN: io.files.tests
   7
   8 [ ] [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test
   9
  10 [ ] [ "append-test" temp-file ascii <file-appender> dispose ] unit-test
  11
  12 [
  13     "This is a line.\rThis is another line.\r"
  14 ] [
  15     "vocab:io/test/mac-os-eol.txt" latin1
  16     [ 500 read ] with-file-reader
  17 ] unit-test
  18
  19 [
  20     255
  21 ] [
  22     "vocab:io/test/binary.txt" latin1
  23     [ read1 ] with-file-reader >fixnum
  24 ] unit-test
  25
  26 [ ] [
  27     "It seems Jobs has lost his grasp on reality again.\n"
  28     "separator-test.txt" temp-file latin1 set-file-contents
  29 ] unit-test
  30
  31 [
  32     {
  33         { "It seems " CHAR: J }
  34         { "obs has lost h" CHAR: i }
  35         { "s grasp on reality again.\n" f }
  36     }
  37 ] [
  38     [
  39         "separator-test.txt" temp-file
  40         latin1 [
  41             "J" read-until 2array ,
  42             "i" read-until 2array ,
  43             "X" read-until 2array ,
  44         ] with-file-reader
  45     ] { } make
  46 ] unit-test
  47
  48 [ ] [
  49     image binary [
  50         10 [ 65536 read drop ] times
  51     ] with-file-reader
  52 ] unit-test
  53
  54 ! Test EOF behavior
  55 [ 10 ] [
  56     image binary [
  57         0 read drop
  58         10 read length
  59     ] with-file-reader
  60 ] unit-test
  61
  62 USE: debugger.threads
  63
  64 [ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
  65
  66 [ ] [ "test-quux.txt" temp-file delete-file ] unit-test
  67
  68 [ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
  69
  70 [ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] bi@ move-file ] unit-test
  71
  72 [ t ] [ "quux-test.txt" temp-file exists? ] unit-test
  73
  74 [ ] [ "quux-test.txt" temp-file delete-file ] unit-test
  75
  76 ! File seeking tests
  77 [ B{ 3 2 3 4 5 } ]
  78 [
  79     "seek-test1" unique-file binary
  80     [
  81         [
  82             B{ 1 2 3 4 5 } write 0 seek-absolute seek-output
  83             B{ 3 } write
  84         ] with-file-writer
  85     ] [
  86         file-contents
  87     ] 2bi
  88 ] unit-test
  89
  90 [ B{ 1 2 3 4 3 } ]
  91 [
  92     "seek-test2" unique-file binary
  93     [
  94         [
  95             B{ 1 2 3 4 5 } write -1 seek-relative seek-output
  96             B{ 3 } write
  97         ] with-file-writer
  98     ] [
  99         file-contents
 100     ] 2bi
 101 ] unit-test
 102
 103 [ B{ 1 2 3 4 5 0 3 } ]
 104 [
 105     "seek-test3" unique-file binary
 106     [
 107         [
 108             B{ 1 2 3 4 5 } write 1 seek-relative seek-output
 109             B{ 3 } write
 110         ] with-file-writer
 111     ] [
 112         file-contents
 113     ] 2bi
 114 ] unit-test
 115
 116 [ B{ 3 } ]
 117 [
 118     B{ 1 2 3 4 5 } "seek-test4" unique-file binary [
 119         set-file-contents
 120     ] [
 121         [
 122             -3 seek-end seek-input 1 read
 123         ] with-file-reader
 124     ] 2bi
 125 ] unit-test
 126
 127 [ B{ 2 } ]
 128 [
 129     B{ 1 2 3 4 5 } "seek-test5" unique-file binary [
 130         set-file-contents
 131     ] [
 132         [
 133             3 seek-absolute seek-input
 134             -2 seek-relative seek-input
 135             1 read
 136         ] with-file-reader
 137     ] 2bi
 138 ] unit-test
 139
 140 [
 141     "seek-test6" unique-file binary [
 142         -10 seek-absolute seek-input
 143     ] with-file-reader
 144 ] must-fail
 145
 146 [
 147     "non-string-error" unique-file ascii [
 148         { } write
 149     ] with-file-writer
 150 ] [ no-method? ] must-fail-with
 151
 152 [
 153     "non-byte-array-error" unique-file binary [
 154         "" write
 155     ] with-file-writer
 156 ] [ no-method? ] must-fail-with
 157
 158 ! What happens if we close a file twice?
 159 [ ] [
 160     "closing-twice" unique-file ascii <file-writer>
 161     [ dispose ] [ dispose ] bi
 162 ] unit-test