core/io/files/files-tests.factor

   1 USING: alien alien.c-types arrays classes.struct
   2 debugger.threads destructors generic.single io io.directories
   3 io.encodings.8-bit.latin1 io.encodings.ascii
   4 io.encodings.binary io.encodings.string io.files
   5 io.files.private io.files.temp io.files.unique kernel make math
   6 sequences specialized-arrays system threads tools.test ;
   7 SPECIALIZED-ARRAY: int
   8 IN: io.files.tests
   9
  10 [ ] [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test
  11
  12 [ ] [ "append-test" temp-file ascii <file-appender> dispose ] unit-test
  13
  14 [
  15     "This is a line.\rThis is another line.\r"
  16 ] [
  17     "vocab:io/test/mac-os-eol.txt" latin1
  18     [ 500 read ] with-file-reader
  19 ] unit-test
  20
  21 [
  22     255
  23 ] [
  24     "vocab:io/test/binary.txt" latin1
  25     [ read1 ] with-file-reader >fixnum
  26 ] unit-test
  27
  28 [
  29     "This" CHAR: \s
  30 ] [
  31     "vocab:io/test/read-until-test.txt" ascii
  32     [ " " read-until ] with-file-reader
  33 ] unit-test
  34
  35 [
  36     "This" CHAR: \s
  37 ] [
  38     "vocab:io/test/read-until-test.txt" binary
  39     [ " " read-until [ ascii decode ] dip ] with-file-reader
  40 ] unit-test
  41
  42 [ ] [
  43     "It seems Jobs has lost his grasp on reality again.\n"
  44     "separator-test.txt" temp-file latin1 set-file-contents
  45 ] unit-test
  46
  47 [
  48     {
  49         { "It seems " CHAR: J }
  50         { "obs has lost h" CHAR: i }
  51         { "s grasp on reality again.\n" f }
  52     }
  53 ] [
  54     [
  55         "separator-test.txt" temp-file
  56         latin1 [
  57             "J" read-until 2array ,
  58             "i" read-until 2array ,
  59             "X" read-until 2array ,
  60         ] with-file-reader
  61     ] { } make
  62 ] unit-test
  63
  64 [ ] [
  65     image binary [
  66         10 [ 65536 read drop ] times
  67     ] with-file-reader
  68 ] unit-test
  69
  70 ! Writing specialized arrays to binary streams should work
  71 [ ] [
  72     "test.txt" temp-file binary [
  73         int-array{ 1 2 3 } write
  74     ] with-file-writer
  75 ] unit-test
  76
  77 [ int-array{ 1 2 3 } ] [
  78     "test.txt" temp-file binary [
  79         3 4 * read
  80     ] with-file-reader
  81     byte-array>int-array
  82 ] unit-test
  83
  84 [ ] [
  85     BV{ 0 1 2 } "test.txt" temp-file binary set-file-contents
  86 ] unit-test
  87
  88 [ t ] [
  89     "test.txt" temp-file binary file-contents
  90     B{ 0 1 2 } =
  91 ] unit-test
  92
  93 STRUCT: pt { x uint } { y uint } ;
  94 SPECIALIZED-ARRAY: pt
  95
  96 CONSTANT: pt-array-1
  97     pt-array{ S{ pt f 1 1 } S{ pt f 2 2 } S{ pt f 3 3 } }
  98
  99 [ ] [
 100     pt-array-1
 101     "test.txt" temp-file binary set-file-contents
 102 ] unit-test
 103
 104 [ t ] [
 105     "test.txt" temp-file binary file-contents
 106     pt-array-1 >c-ptr sequence=
 107 ] unit-test
 108
 109 ! Slices should support >c-ptr and byte-length
 110
 111 [ ] [
 112     pt-array-1 rest-slice
 113     "test.txt" temp-file binary set-file-contents
 114 ] unit-test
 115
 116 [ t ] [
 117     "test.txt" temp-file binary file-contents
 118     byte-array>pt-array
 119     pt-array-1 rest-slice sequence=
 120 ] unit-test
 121
 122 ! Writing strings to binary streams should fail
 123 [
 124     "test.txt" temp-file binary [
 125         "OMGFAIL" write
 126     ] with-file-writer
 127 ] must-fail
 128
 129 ! Test EOF behavior
 130 [ 10 ] [
 131     image binary [
 132         0 read drop
 133         10 read length
 134     ] with-file-reader
 135 ] unit-test
 136
 137 ! Make sure that writing to a closed stream from another thread doesn't crash
 138 [ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
 139
 140 [ ] [ "test-quux.txt" temp-file delete-file ] unit-test
 141
 142 [ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
 143
 144 [ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] bi@ move-file ] unit-test
 145
 146 [ t ] [ "quux-test.txt" temp-file exists? ] unit-test
 147
 148 [ ] [ "quux-test.txt" temp-file delete-file ] unit-test
 149
 150 ! File seeking tests
 151 [ B{ 3 2 3 4 5 } ]
 152 [
 153     "seek-test1" unique-file binary
 154     [
 155         [
 156             B{ 1 2 3 4 5 } write 0 seek-absolute seek-output
 157             B{ 3 } write
 158         ] with-file-writer
 159     ] [
 160         file-contents
 161     ] 2bi
 162 ] unit-test
 163
 164 [ B{ 1 2 3 4 3 } ]
 165 [
 166     "seek-test2" unique-file binary
 167     [
 168         [
 169             B{ 1 2 3 4 5 } write -1 seek-relative seek-output
 170             B{ 3 } write
 171         ] with-file-writer
 172     ] [
 173         file-contents
 174     ] 2bi
 175 ] unit-test
 176
 177 [ B{ 1 2 3 4 5 0 3 } ]
 178 [
 179     "seek-test3" unique-file binary
 180     [
 181         [
 182             B{ 1 2 3 4 5 } write 1 seek-relative seek-output
 183             B{ 3 } write
 184         ] with-file-writer
 185     ] [
 186         file-contents
 187     ] 2bi
 188 ] unit-test
 189
 190 [ B{ 3 } ]
 191 [
 192     B{ 1 2 3 4 5 } "seek-test4" unique-file binary [
 193         set-file-contents
 194     ] [
 195         [
 196             -3 seek-end seek-input 1 read
 197         ] with-file-reader
 198     ] 2bi
 199 ] unit-test
 200
 201 [ B{ 2 } ]
 202 [
 203     B{ 1 2 3 4 5 } "seek-test5" unique-file binary [
 204         set-file-contents
 205     ] [
 206         [
 207             3 seek-absolute seek-input
 208             -2 seek-relative seek-input
 209             1 read
 210         ] with-file-reader
 211     ] 2bi
 212 ] unit-test
 213
 214 [
 215     "seek-test6" unique-file binary [
 216         -10 seek-absolute seek-input
 217     ] with-file-reader
 218 ] must-fail
 219
 220 [
 221     "non-string-error" unique-file ascii [
 222         { } write
 223     ] with-file-writer
 224 ] [ no-method? ] must-fail-with
 225
 226 [
 227     "non-byte-array-error" unique-file binary [
 228         "" write
 229     ] with-file-writer
 230 ] [ no-method? ] must-fail-with
 231
 232 ! What happens if we close a file twice?
 233 [ ] [
 234     "closing-twice" unique-file ascii <file-writer>
 235     [ dispose ] [ dispose ] bi
 236 ] unit-test