Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
300 lines (255 sloc) 6.77 KB
USING: alien alien.c-types alien.data arrays classes.struct
compiler.units continuations destructors fry generic.single io
io.backend io.directories io.encodings io.encodings.8-bit.latin1
io.encodings.ascii io.encodings.binary io.encodings.string
io.encodings.utf16 io.encodings.utf8 io.files io.files.private
io.pathnames kernel locals make math sequences
specialized-arrays system threads tools.test vocabs ;
FROM: specialized-arrays.private => specialized-array-vocab ;
IN: io.files.tests
SPECIALIZED-ARRAY: int
{ } [
[ ascii <file-appender> dispose ] with-test-file
] unit-test
{
"This is a line.\rThis is another line.\r"
} [
"vocab:io/test/mac-os-eol.txt" latin1
[ 500 read ] with-file-reader
] unit-test
{
255
} [
"vocab:io/test/binary.txt" latin1
[ read1 ] with-file-reader >fixnum
] unit-test
{
"This" CHAR: \s
} [
"vocab:io/test/read-until-test.txt" ascii
[ " " read-until ] with-file-reader
] unit-test
{
"This" CHAR: \s
} [
"vocab:io/test/read-until-test.txt" binary
[ " " read-until [ ascii decode ] dip ] with-file-reader
] unit-test
[| path |
{ } [
"It seems Jobs has lost his grasp on reality again.\n"
path latin1 set-file-contents
] unit-test
{
{
{ "It seems " CHAR: J }
{ "obs has lost h" CHAR: i }
{ "s grasp on reality again.\n" f }
}
} [
[
path latin1 [
"J" read-until 2array ,
"i" read-until 2array ,
"X" read-until 2array ,
] with-file-reader
] { } make
] unit-test
] with-test-file
{ } [
image-path binary [
10 [ 65536 read drop ] times
] with-file-reader
] unit-test
! Writing specialized arrays to binary streams should work
[| path |
{ } [
path binary [
int-array{ 1 2 3 } write
] with-file-writer
] unit-test
{ int-array{ 1 2 3 } } [
path binary [
3 4 * read
] with-file-reader
int cast-array
] unit-test
] with-test-file
[| path |
{ } [
BV{ 0 1 2 } path binary set-file-contents
] unit-test
{ t } [
path binary file-contents
B{ 0 1 2 } =
] unit-test
] with-test-file
STRUCT: pt { x uint } { y uint } ;
SPECIALIZED-ARRAY: pt
CONSTANT: pt-array-1
pt-array{ S{ pt f 1 1 } S{ pt f 2 2 } S{ pt f 3 3 } }
[| path |
{ } [
pt-array-1 path binary set-file-contents
] unit-test
{ t } [
path binary file-contents
pt-array-1 >c-ptr sequence=
] unit-test
] with-test-file
! Slices should support >c-ptr and byte-length
[| path |
{ } [
pt-array-1 rest-slice
path binary set-file-contents
] unit-test
{ t } [
path binary file-contents
pt cast-array
pt-array-1 rest-slice sequence=
] unit-test
] with-test-file
{ } [
[
pt specialized-array-vocab forget-vocab
] with-compilation-unit
] unit-test
! Writing strings to binary streams should fail
[| path |
[
path binary [ "OMGFAIL" write ] with-file-writer
] must-fail
] with-test-file
! Test EOF behavior
{ 10 } [
image-path binary [
0 read drop
10 read length
] with-file-reader
] unit-test
! Make sure that writing to a closed stream from another thread doesn't crash
[
{ } [ "test.txt" ascii [ [ yield "Hi" write ] "Test-write-file" spawn drop ] with-file-writer ] unit-test
{ } [ "test.txt" delete-file ] unit-test
{ } [ "test.txt" ascii [ [ yield "Hi" write ] "Test-write-file" spawn drop ] with-file-writer ] unit-test
{ } [ "test.txt" "test2.txt" move-file ] unit-test
{ t } [ "test2.txt" exists? ] unit-test
{ } [ "test2.txt" delete-file ] unit-test
] with-test-directory
! File seeking tests
[| path |
{ B{ 3 2 3 4 5 } } [
path binary [
B{ 1 2 3 4 5 } write
tell-output 5 assert=
0 seek-absolute seek-output
tell-output 0 assert=
B{ 3 } write
tell-output 1 assert=
] with-file-writer path binary file-contents
] unit-test
] with-test-file
[| path |
{ B{ 1 2 3 4 3 } } [
path binary [
B{ 1 2 3 4 5 } write
tell-output 5 assert=
-1 seek-relative seek-output
tell-output 4 assert=
B{ 3 } write
tell-output 5 assert=
] with-file-writer path binary file-contents
] unit-test
] with-test-file
[| path |
{ B{ 1 2 3 4 5 0 3 } } [
path binary [
B{ 1 2 3 4 5 } write
tell-output 5 assert=
1 seek-relative seek-output
tell-output 6 assert=
B{ 3 } write
tell-output 7 assert=
] with-file-writer path binary file-contents
] unit-test
] with-test-file
[| path |
{ B{ 3 } } [
B{ 1 2 3 4 5 } path binary set-file-contents
path binary [
tell-input 0 assert=
-3 seek-end seek-input
tell-input 2 assert=
1 read
tell-input 3 assert=
] with-file-reader
] unit-test
] with-test-file
[| path |
{ B{ 2 } } [
B{ 1 2 3 4 5 } path binary set-file-contents
path binary [
tell-input 0 assert=
3 seek-absolute seek-input
tell-input 3 assert=
-2 seek-relative seek-input
tell-input 1 assert=
1 read
tell-input 2 assert=
] with-file-reader
] unit-test
] with-test-file
[
"does-not-exist" binary [
-10 seek-absolute seek-input
] with-file-reader
] must-fail
{ } [
"resource:LICENSE.txt" binary [
44 read drop
tell-input 44 assert=
-44 seek-relative seek-input
tell-input 0 assert=
] with-file-reader
] unit-test
[| path |
[ path ascii [ { 129 } write ] with-file-writer ]
[ encode-error? ] must-fail-with
] with-test-file
[| path |
{ }
[ path ascii [ { } write ] with-file-writer ] unit-test
] with-test-file
[| path |
[ path binary [ "" write ] with-file-writer ]
[ no-method? ] must-fail-with
] with-test-file
! What happens if we close a file twice?
[
"closing-twice" ascii <file-writer>
[ dispose ] [ dispose ] bi
] with-test-directory
{ f t t } [
[
"resource:core" normalize-path
[ cwd = ] [ cd ] [ cwd = ] tri
] cwd '[ _ dup cd cwd = ] [ ] cleanup
] unit-test
{ t } [
[
[ 0 1 "å" <slice> swap utf8 set-file-contents ]
[ utf8 file-contents ] bi "å" =
] with-test-file
] unit-test
{ t } [
[
[ 0 1 "å" <slice> swap utf16 set-file-contents ]
[ utf16 file-contents ] bi "å" =
] with-test-file
] unit-test
{ t } [
[
[ 0 1 "a" <slice> swap ascii set-file-contents ]
[ ascii file-contents ] bi "a" =
] with-test-file
] unit-test