core/io/files/files-tests.factor

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