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