io.files: make tests not use temp-file

locals-and-roots
Doug Coleman 2016-03-30 17:30:12 -07:00
parent 9e9b7fe367
commit 80d0baaa7d
1 changed files with 104 additions and 74 deletions

View File

@ -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