core/io/files/files-tests.factor

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