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.ascii
io.encodings.binary io.encodings.latin1 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 = ] finally
] 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