io.files: make tests not use temp-file
parent
9e9b7fe367
commit
80d0baaa7d
|
@ -1,16 +1,22 @@
|
||||||
USING: alien alien.c-types alien.data arrays classes.struct
|
USING: alien alien.c-types alien.data arrays classes.struct
|
||||||
compiler.units continuations destructors generic.single io
|
compiler.units continuations destructors generic.single io
|
||||||
io.directories io.encodings.8-bit.latin1 io.encodings.ascii
|
io.directories io.encodings.8-bit.latin1 io.encodings.ascii
|
||||||
io.encodings.binary io.encodings.string io.files io.pathnames
|
io.encodings.binary io.encodings.string io.files
|
||||||
io.files.private io.files.temp io.files.unique kernel make math
|
io.files.private io.files.temp io.files.unique io.pathnames
|
||||||
sequences specialized-arrays system threads tools.test vocabs ;
|
kernel locals make math sequences specialized-arrays
|
||||||
|
system threads tools.test vocabs ;
|
||||||
FROM: specialized-arrays.private => specialized-array-vocab ;
|
FROM: specialized-arrays.private => specialized-array-vocab ;
|
||||||
SPECIALIZED-ARRAY: int
|
|
||||||
IN: io.files.tests
|
IN: io.files.tests
|
||||||
|
|
||||||
{ } [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test
|
SPECIALIZED-ARRAY: int
|
||||||
|
|
||||||
{ } [ "append-test" temp-file ascii <file-appender> dispose ] unit-test
|
{ } [
|
||||||
|
[
|
||||||
|
"append-test" ".txt" [| path |
|
||||||
|
path ascii <file-appender> dispose
|
||||||
|
] cleanup-unique-file
|
||||||
|
] with-temp-directory
|
||||||
|
] unit-test
|
||||||
|
|
||||||
{
|
{
|
||||||
"This is a line.\rThis is another line.\r"
|
"This is a line.\rThis is another line.\r"
|
||||||
|
@ -40,9 +46,11 @@ IN: io.files.tests
|
||||||
[ " " read-until [ ascii decode ] dip ] with-file-reader
|
[ " " read-until [ ascii decode ] dip ] with-file-reader
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
"separator-test" ".txt" [| path |
|
||||||
{ } [
|
{ } [
|
||||||
"It seems Jobs has lost his grasp on reality again.\n"
|
"It seems Jobs has lost his grasp on reality again.\n"
|
||||||
"separator-test.txt" temp-file latin1 set-file-contents
|
path latin1 set-file-contents
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{
|
{
|
||||||
|
@ -53,14 +61,15 @@ IN: io.files.tests
|
||||||
}
|
}
|
||||||
} [
|
} [
|
||||||
[
|
[
|
||||||
"separator-test.txt" temp-file
|
path latin1 [
|
||||||
latin1 [
|
|
||||||
"J" read-until 2array ,
|
"J" read-until 2array ,
|
||||||
"i" read-until 2array ,
|
"i" read-until 2array ,
|
||||||
"X" read-until 2array ,
|
"X" read-until 2array ,
|
||||||
] with-file-reader
|
] with-file-reader
|
||||||
] { } make
|
] { } make
|
||||||
] unit-test
|
] unit-test
|
||||||
|
] cleanup-unique-file
|
||||||
|
] with-temp-directory
|
||||||
|
|
||||||
{ } [
|
{ } [
|
||||||
image-path binary [
|
image-path binary [
|
||||||
|
@ -69,27 +78,35 @@ IN: io.files.tests
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
! Writing specialized arrays to binary streams should work
|
! Writing specialized arrays to binary streams should work
|
||||||
|
[
|
||||||
|
"binary-int-array" ".bin" [| path |
|
||||||
{ } [
|
{ } [
|
||||||
"test.txt" temp-file binary [
|
path binary [
|
||||||
int-array{ 1 2 3 } write
|
int-array{ 1 2 3 } write
|
||||||
] with-file-writer
|
] with-file-writer
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ int-array{ 1 2 3 } } [
|
{ int-array{ 1 2 3 } } [
|
||||||
"test.txt" temp-file binary [
|
path binary [
|
||||||
3 4 * read
|
3 4 * read
|
||||||
] with-file-reader
|
] with-file-reader
|
||||||
int cast-array
|
int cast-array
|
||||||
] unit-test
|
] unit-test
|
||||||
|
] cleanup-unique-file
|
||||||
|
] with-temp-directory
|
||||||
|
|
||||||
|
[
|
||||||
|
"test-012" ".bin" [| path |
|
||||||
{ } [
|
{ } [
|
||||||
BV{ 0 1 2 } "test.txt" temp-file binary set-file-contents
|
BV{ 0 1 2 } path binary set-file-contents
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
"test.txt" temp-file binary file-contents
|
path binary file-contents
|
||||||
B{ 0 1 2 } =
|
B{ 0 1 2 } =
|
||||||
] unit-test
|
] unit-test
|
||||||
|
] cleanup-unique-file
|
||||||
|
] with-temp-directory
|
||||||
|
|
||||||
STRUCT: pt { x uint } { y uint } ;
|
STRUCT: pt { x uint } { y uint } ;
|
||||||
SPECIALIZED-ARRAY: pt
|
SPECIALIZED-ARRAY: pt
|
||||||
|
@ -97,28 +114,34 @@ SPECIALIZED-ARRAY: pt
|
||||||
CONSTANT: pt-array-1
|
CONSTANT: pt-array-1
|
||||||
pt-array{ S{ pt f 1 1 } S{ pt f 2 2 } S{ pt f 3 3 } }
|
pt-array{ S{ pt f 1 1 } S{ pt f 2 2 } S{ pt f 3 3 } }
|
||||||
|
|
||||||
|
[
|
||||||
|
"test-pt-array-1" ".bin" [| path |
|
||||||
{ } [
|
{ } [
|
||||||
pt-array-1
|
pt-array-1 path binary set-file-contents
|
||||||
"test.txt" temp-file binary set-file-contents
|
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
"test.txt" temp-file binary file-contents
|
path binary file-contents
|
||||||
pt-array-1 >c-ptr sequence=
|
pt-array-1 >c-ptr sequence=
|
||||||
] unit-test
|
] unit-test
|
||||||
|
] cleanup-unique-file
|
||||||
|
] with-temp-directory
|
||||||
|
|
||||||
! Slices should support >c-ptr and byte-length
|
! Slices should support >c-ptr and byte-length
|
||||||
|
[
|
||||||
|
"test-pt-array-1-slice" ".bin" [| path |
|
||||||
{ } [
|
{ } [
|
||||||
pt-array-1 rest-slice
|
pt-array-1 rest-slice
|
||||||
"test.txt" temp-file binary set-file-contents
|
path binary set-file-contents
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
"test.txt" temp-file binary file-contents
|
path binary file-contents
|
||||||
pt cast-array
|
pt cast-array
|
||||||
pt-array-1 rest-slice sequence=
|
pt-array-1 rest-slice sequence=
|
||||||
] unit-test
|
] unit-test
|
||||||
|
] cleanup-unique-file
|
||||||
|
] with-temp-directory
|
||||||
|
|
||||||
{ } [
|
{ } [
|
||||||
[
|
[
|
||||||
|
@ -128,9 +151,9 @@ CONSTANT: pt-array-1
|
||||||
|
|
||||||
! Writing strings to binary streams should fail
|
! Writing strings to binary streams should fail
|
||||||
[
|
[
|
||||||
"test.txt" temp-file binary [
|
"omgfail-binary" ".bin" [| path |
|
||||||
"OMGFAIL" write
|
path binary [ "OMGFAIL" write ] with-file-writer
|
||||||
] with-file-writer
|
] cleanup-unique-file
|
||||||
] must-fail
|
] must-fail
|
||||||
|
|
||||||
! Test EOF behavior
|
! Test EOF behavior
|
||||||
|
@ -142,17 +165,24 @@ CONSTANT: pt-array-1
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
! Make sure that writing to a closed stream from another thread doesn't crash
|
! Make sure that writing to a closed stream from another thread doesn't crash
|
||||||
{ } [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
|
! Don't use cleanup-unique-file here because we do manual cleanup as part of test
|
||||||
|
[
|
||||||
|
"test-quux" ".txt" unique-file [| path |
|
||||||
|
path ".2" append :> path2
|
||||||
|
|
||||||
{ } [ "test-quux.txt" temp-file delete-file ] unit-test
|
{ } [ path ascii [ [ yield "Hi" write ] "Test-write-file" spawn drop ] with-file-writer ] unit-test
|
||||||
|
|
||||||
{ } [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
|
{ } [ path delete-file ] unit-test
|
||||||
|
|
||||||
{ } [ "test-quux.txt" "quux-test.txt" [ temp-file ] bi@ move-file ] unit-test
|
{ } [ path ascii [ [ yield "Hi" write ] "Test-write-file" spawn drop ] with-file-writer ] unit-test
|
||||||
|
|
||||||
{ t } [ "quux-test.txt" temp-file exists? ] unit-test
|
{ } [ path path2 move-file ] unit-test
|
||||||
|
|
||||||
{ } [ "quux-test.txt" temp-file delete-file ] unit-test
|
{ t } [ path2 exists? ] unit-test
|
||||||
|
|
||||||
|
{ } [ path2 delete-file ] unit-test
|
||||||
|
] call
|
||||||
|
] with-temp-directory
|
||||||
|
|
||||||
! File seeking tests
|
! File seeking tests
|
||||||
{ B{ 3 2 3 4 5 } }
|
{ B{ 3 2 3 4 5 } }
|
||||||
|
@ -304,8 +334,8 @@ CONSTANT: pt-array-1
|
||||||
] with-temp-directory
|
] with-temp-directory
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
! Test cwd, cd. You do not want to use with-cd, you want with-directory.
|
! Test cwd, cd.
|
||||||
|
! NOTE TO USER: You do not want to use with-cd, you want with-directory.
|
||||||
: with-cd ( path quot -- )
|
: with-cd ( path quot -- )
|
||||||
[ [ absolute-path cd ] curry ] dip compose
|
[ [ absolute-path cd ] curry ] dip compose
|
||||||
cwd [ cd ] curry
|
cwd [ cd ] curry
|
||||||
|
|
Loading…
Reference in New Issue