use with-temp-file and with-temp-directory in some tests.

locals-and-roots
John Benediktsson 2016-04-04 10:32:42 -07:00
parent dd3189ecb6
commit 2269b07d33
17 changed files with 786 additions and 1000 deletions

View File

@ -1,13 +1,11 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators.short-circuit db db.errors
db.sqlite db.sqlite.errors io.files.temp io.files.unique kernel
namespaces tools.test ;
db.sqlite kernel locals tools.test ;
[
"sqlite" "error-test" [
[| path |
<sqlite-db> [
path <sqlite-db> [
[
"insert into foo (id) values('1');" sql-command
@ -24,5 +22,4 @@ namespaces tools.test ;
] must-fail-with
] with-db
] cleanup-unique-file
] with-temp-directory
] with-test-file

View File

@ -1,20 +1,14 @@
USING: calendar ftp.server io.encodings.ascii io.files
io.files.temp io.files.unique namespaces threads tools.test
kernel io.servers ftp.client accessors urls
io.pathnames io.directories sequences fry io.backend
continuations ;
USING: accessors fry ftp.server io.encodings.ascii io.files
io.pathnames io.servers kernel tools.test urls ;
FROM: ftp.client => ftp-get ;
IN: ftp.server.tests
CONSTANT: test-file-contents "Files are so boring anymore."
: create-test-file ( -- path )
test-file-contents
"ftp.server" "test" unique-file
[ ascii set-file-contents ] [ normalize-path ] bi ;
test-file-contents "ftp.server" [ ascii set-file-contents ] keep ;
: test-ftp-server ( quot -- )
[
: test-ftp-server ( quot: ( server path -- ) -- )
'[
"." 0 <ftp-server> [
"ftp://localhost" >url insecure-addr set-url-addr
@ -22,18 +16,12 @@ CONSTANT: test-file-contents "Files are so boring anymore."
create-test-file >>path
@
] with-threaded-server
] cleanup-unique-directory
] with-temp-directory ; inline
] with-test-directory ; inline
{ t }
[
[
[
{ t } [
[
[ ftp-get ]
[ path>> file-name ascii file-contents ] bi
] cleanup-unique-directory
] with-temp-directory
] test-ftp-server test-file-contents =
] unit-test
@ -41,11 +29,7 @@ CONSTANT: test-file-contents "Files are so boring anymore."
[
"/" >>path
[
[
[ ftp-get ]
[ path>> file-name ascii file-contents ] bi
] cleanup-unique-directory
] with-temp-directory
] test-ftp-server test-file-contents =
] must-fail

View File

@ -1,7 +1,5 @@
USING: globs globs.private io.directories io.files.temp
io.files.unique io.pathnames literals sequences sorting
USING: globs globs.private io.directories io.pathnames sorting
tools.test ;
IN: globs.tests
{ f } [ "abd" "fdf" glob-matches? ] unit-test
{ f } [ "fdsafas" "?" glob-matches? ] unit-test
@ -60,7 +58,6 @@ IN: globs.tests
{ "a/b" "a/e" }
} [
[
[
"a" make-directory
"a/b" make-directory
@ -86,6 +83,5 @@ IN: globs.tests
! "**/**/e" glob-directory natural-sort
"**/e/**" glob-directory natural-sort
"a/**" glob-directory natural-sort
] cleanup-unique-directory
] with-temp-directory
] with-test-directory
] unit-test

View File

@ -1,11 +1,9 @@
USING: byte-arrays destructors io io.directories
io.encodings.ascii io.encodings.binary io.files io.files.temp
io.files.unique io.launcher io.sockets io.streams.duplex kernel
make namespaces prettyprint sequences strings system threads
tools.test ;
io.encodings.ascii io.encodings.binary io.files io.launcher
io.sockets io.streams.duplex kernel make namespaces prettyprint
sequences strings system threads tools.test ;
[
[
[
"socket-server" <local>
ascii <server> [
@ -123,8 +121,7 @@ tools.test ;
] with-file-reader
] must-fail
] cleanup-unique-directory
] with-temp-directory
] with-test-directory
! closing stdin caused some problems
{ } [

View File

@ -1,8 +1,6 @@
USING: continuations destructors io io.directories
io.directories.hierarchy io.encodings.ascii io.encodings.utf8
io.files io.files.info io.files.temp io.files.unique io.launcher
io.pathnames kernel sequences tools.test ;
IN: io.directories.tests
USING: destructors io io.directories io.directories.hierarchy
io.encodings.ascii io.encodings.utf8 io.files io.files.info
io.launcher io.pathnames kernel sequences tools.test ;
{ { "kernel" } } [
"core" resource-path [
@ -22,63 +20,40 @@ IN: io.directories.tests
] with-directory-files
] unit-test
{ } [ "blahblah" temp-file dup exists? [ delete-directory ] [ drop ] if ] unit-test
{ } [ "blahblah" temp-file make-directory ] unit-test
{ t } [ "blahblah" temp-file file-info directory? ] unit-test
[
{ t t f } [
"blahblah" make-directory
"blahblah" exists?
"blahblah" file-info directory?
"blahblah" delete-directory
"blahblah" exists?
] unit-test
{ t } [
[
[ "loldir" delete-directory ] ignore-errors
"loldir" make-directory
"loldir" exists?
] with-temp-directory
] unit-test
{ } [
[
[ "loldir" delete-directory ] ignore-errors
"loldir" make-directory
"loldir" delete-directory
] with-temp-directory
] unit-test
{ "file1 contents" } [
[
{ "file1 contents" } [
"file1 contents" "file1" utf8 set-file-contents
"file1" "file2" copy-file
"file2" utf8 file-contents
"file1" delete-file
"file2" delete-file
] with-temp-directory
] unit-test
] unit-test
{ "file3 contents" } [
[
{ "file3 contents" } [
"file3 contents" "file3" utf8 set-file-contents
"file3" "file4" move-file
"file4" utf8 file-contents
"file4" delete-file
] with-temp-directory
] unit-test
] unit-test
{ } [
[
[ "file5" delete-file ] ignore-errors
{ } [
"file5" touch-file
"file5" delete-file
] with-temp-directory
] unit-test
] unit-test
{ } [
[
[ "file6" delete-file ] ignore-errors
{ } [
"file6" touch-file
"file6" link-info drop
] with-temp-directory
] unit-test
] unit-test
[
[
{ } [
{ "Hello world." }
"test-foo.txt" ascii set-file-lines
@ -109,11 +84,7 @@ IN: io.directories.tests
{ f } [ "test-foo.txt" exists? ] unit-test
{ f } [ "test-bar.txt" exists? ] unit-test
] cleanup-unique-directory
] with-temp-directory
[
[
{ } [ "test-blah" make-directory ] unit-test
{ } [
@ -128,11 +99,7 @@ IN: io.directories.tests
{ } [ "test-blah" delete-directory ] unit-test
{ f } [ "test-blah" exists? ] unit-test
] cleanup-unique-directory
] with-temp-directory
[
[
{ } [ "delete-tree-test/a/b/c" make-directories ] unit-test
{ } [
@ -140,11 +107,7 @@ IN: io.directories.tests
] unit-test
{ } [ "delete-tree-test" delete-tree ] unit-test
] cleanup-unique-directory
] with-temp-directory
[
[
{ } [
"copy-tree-test/a/b/c" make-directories
] unit-test
@ -188,15 +151,13 @@ IN: io.directories.tests
{ } [ "copy-destination" delete-tree ] unit-test
{ } [ "copy-tree-test" delete-tree ] unit-test
] cleanup-unique-directory
] with-temp-directory
{ } [ "resource:deleteme" touch-file ] unit-test
{ } [ "resource:deleteme" delete-file ] unit-test
! Issue #890
{ } [
"foo" temp-file [ make-directories ] keep
! Issue #890
{ } [
"foo" [ make-directories ] keep
[ "touch bar" try-output-process ] with-directory
] unit-test
] unit-test
] with-test-directory

View File

@ -1,16 +1,12 @@
USING: combinators.smart io.directories
io.directories.hierarchy io.directories.search io.files
io.files.temp io.files.unique io.pathnames kernel namespaces
USING: io.directories io.directories.hierarchy
io.directories.search io.files.unique io.pathnames kernel
sequences sorting strings tools.test ;
IN: io.directories.search.tests
{ t } [
[
[
10 [ "io.paths.test" "gogogo" unique-file ] replicate
"." [ ] find-all-files
] cleanup-unique-directory [ natural-sort ] same?
] with-temp-directory
"." [ ] find-all-files [ natural-sort ] same?
] with-test-directory
] unit-test
{ f } [
@ -24,23 +20,21 @@ IN: io.directories.search.tests
] unit-test
{ t } [
[
[
"the-head" "" unique-file drop
"." t [ file-name "the-head" head? ] find-file string?
] cleanup-unique-directory
] with-temp-directory
] with-test-directory
] unit-test
{ t } [
[
[
[ unique-directory unique-directory ] output>array
{ "foo" "bar" } {
[ [ make-directory ] each ]
[ [ "abcd" append-path touch-file ] each ]
[ [ file-name "abcd" = ] find-all-in-directories length 2 = ]
[ [ delete-tree ] each ] tri
] cleanup-unique-directory
] with-temp-directory
[ [ delete-tree ] each ]
} cleave
] with-test-directory
] unit-test
{ t } [

View File

@ -1,6 +1,5 @@
USING: io.directories io.files.links tools.test sequences
io.files.temp io.files.unique tools.files fry math kernel
math.parser io.pathnames namespaces ;
USING: fry io.directories io.files.links io.pathnames kernel
math math.parser namespaces sequences tools.test ;
IN: io.files.links.unix.tests
: make-test-links ( n path -- )
@ -8,31 +7,25 @@ IN: io.files.links.unix.tests
[ [ number>string ] dip prepend touch-file ] 2bi ; inline
{ t } [
[
[
5 "lol" make-test-links
"lol1" follow-links
"lol5" absolute-path =
] cleanup-unique-directory
] with-temp-directory
] with-test-directory
] unit-test
[
[
[
100 "laf" make-test-links "laf1" follow-links
] with-unique-directory
] with-temp-directory
] with-test-directory
] [ too-many-symlinks? ] must-fail-with
{ t } [
110 symlink-depth [
[
[
100 "laf" make-test-links
"laf1" follow-links
"laf100" absolute-path =
] cleanup-unique-directory
] with-temp-directory
] with-test-directory
] with-variable
] unit-test

View File

@ -1,8 +1,7 @@
USING: accessors arrays calendar grouping io.files.info
io.files.info.unix io.files.temp io.files.unique io.files.unix
io.pathnames kernel literals locals math math.bitwise
math.functions sequences strings system tools.test unix
unix.groups unix.users ;
io.files.info.unix io.files.unix io.pathnames kernel literals
locals math math.bitwise math.functions sequences strings system
tools.test unix unix.groups unix.users ;
{ "/usr/libexec/" } [ "/usr/libexec/awk/" parent-directory ] unit-test
{ "/etc/" } [ "/etc/passwd" parent-directory ] unit-test
@ -31,8 +30,7 @@ unix.groups unix.users ;
{ "/lib/bux/" } [ "/usr" "/lib/bux/" append-path ] unit-test
{ t } [ "/foo" absolute-path? ] unit-test
[
"permissions-1" ".txt" [| path |
[| path |
{ 0o777 } [
path flags{ USER-ALL GROUP-ALL OTHER-ALL } set-file-permissions
@ -117,9 +115,9 @@ unix.groups unix.users ;
path file-permissions 0o7777 mask
] unit-test
] cleanup-unique-file
] with-test-file
"permissions-2" ".txt" [| path |
[| path |
{ t } [
path now
@ -165,8 +163,7 @@ unix.groups unix.users ;
{ } [ path f f set-file-ids ] unit-test
] cleanup-unique-file
] with-temp-directory
] with-test-file
{ t } [ 0o4000 uid? ] unit-test
{ t } [ 0o2000 gid? ] unit-test

View File

@ -1,15 +1,13 @@
USING: accessors calendar concurrency.promises continuations
debugger.unix destructors io io.backend.unix io.directories
io.encodings.ascii io.encodings.binary io.encodings.utf8
io.files io.files.temp io.files.unique io.launcher
io.launcher.unix io.streams.duplex io.timeouts kernel libc
locals math namespaces sequences threads tools.test unix.process
;
io.files io.launcher io.launcher.unix io.streams.duplex
io.timeouts kernel libc locals math namespaces sequences threads
tools.test unix.process ;
IN: io.launcher.unix.tests
[
[
{ } [ { "touch" "launcher-test-1" } try-process ] unit-test
{ t } [ "launcher-test-1" exists? ] unit-test
@ -81,8 +79,7 @@ IN: io.launcher.unix.tests
"launcher-test-3" utf8 file-contents
] unit-test
] cleanup-unique-directory
] with-temp-directory
] with-test-directory
{ t } [
<process>

View File

@ -1,13 +1,11 @@
USING: alien.c-types alien.data compiler.tree.debugger
io.encodings.ascii io.files io.files.temp io.files.unique
io.mmap kernel locals math sequences sequences.private
specialized-arrays tools.test ;
IN: io.mmap.tests
io.encodings.ascii io.files io.mmap kernel locals math sequences
sequences.private specialized-arrays
specialized-arrays.instances.alien.c-types.uint tools.test ;
SPECIALIZED-ARRAY: uint
[
"mmap-test-file" ".txt" [| path |
[| path |
"12345" path ascii set-file-contents
{ } [ path [ char <mapped-array> CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test
{ 5 } [ path [ char <mapped-array> length ] with-mapped-file ] unit-test
@ -15,12 +13,11 @@ SPECIALIZED-ARRAY: uint
{ "22345" } [ path ascii file-contents ] unit-test
{ t } [ path uint [ sum ] with-mapped-array integer? ] unit-test
{ t } [ path uint [ sum ] with-mapped-array-reader integer? ] unit-test
] cleanup-unique-file
] with-test-file
"mmap-empty-file" ".txt" [| path |
[| path |
[ path [ drop ] with-mapped-file ] [ bad-mmap-size? ] must-fail-with
] cleanup-unique-file
] with-temp-directory
] with-test-file
{ t } [
[ "test.txt" <mapped-file> void* <c-direct-array> first-unsafe ]

View File

@ -1,13 +1,9 @@
IN: io.monitors.linux.tests
USING: io.monitors tools.test io.files io.files.temp
io.files.unique io.directories io.pathnames system sequences
continuations namespaces concurrency.count-downs kernel io
threads calendar prettyprint destructors io.timeouts accessors ;
USING: accessors calendar destructors io.directories io.monitors
io.pathnames io.timeouts kernel namespaces tools.test ;
! On Linux, a notification on the directory itself would report an invalid
! path name
[
[
[
! Non-recursive
{ } [
@ -37,5 +33,4 @@ threads calendar prettyprint destructors io.timeouts accessors ;
{ } [ "m" get dispose ] unit-test
] with-monitors
] cleanup-unique-directory
] with-temp-directory
] with-test-directory

View File

@ -1,11 +1,9 @@
USING: accessors calendar concurrency.count-downs
concurrency.promises continuations destructors io io.directories
io.files io.files.temp io.files.unique io.monitors io.pathnames
io.timeouts kernel namespaces sequences threads tools.test ;
IN: io.monitors.tests
io.files io.monitors io.pathnames io.timeouts kernel namespaces
sequences threads tools.test ;
[
[
[
{ } [ "." t <monitor> "m" set ] unit-test
@ -28,11 +26,9 @@ IN: io.monitors.tests
{ } [ "m" get dispose ] unit-test
] with-monitors
] cleanup-unique-directory
] with-temp-directory
] with-test-directory
[
[
[
{ } [ "xyz" make-directory ] unit-test
{ } [ "." t <monitor> "m" set ] unit-test
@ -73,8 +69,7 @@ IN: io.monitors.tests
{ } [ "m" get dispose ] unit-test
{ } [ "m" get dispose ] unit-test
] with-monitors
] cleanup-unique-directory
] with-temp-directory
] with-test-directory
! Out-of-scope disposal should not fail
{ } [ [ "resource:" f <monitor> ] with-monitors dispose ] unit-test
@ -82,7 +77,6 @@ IN: io.monitors.tests
! Timeouts
[
[
[
! Non-recursive
{ } [
@ -100,13 +94,11 @@ IN: io.monitors.tests
"m" get dispose
] unit-test
] with-monitors
] cleanup-unique-directory
] with-temp-directory
] with-test-directory
! Disposing a monitor should throw an error in any threads
! waiting on notifications
[
[
[
{ } [
<promise> "p" set
@ -129,5 +121,4 @@ IN: io.monitors.tests
already-disposed?
] unit-test
] with-monitors
] cleanup-unique-directory
] with-temp-directory
] with-test-directory

View File

@ -1,15 +1,12 @@
USING: accessors alien.c-types alien.data destructors io
io.encodings.ascii io.encodings.binary io.encodings.string
io.encodings.utf8 io.files io.files.temp io.files.unique
io.pipes io.sockets kernel libc locals math namespaces sequences
tools.test ;
IN: io.ports.tests
io.encodings.utf8 io.files io.pipes io.sockets kernel libc
locals math namespaces sequences tools.test ;
! Make sure that writing malloced storage to a file works, and
! also make sure that writes larger than the buffer size work
[
"test" ".txt" [| path |
[| path |
{ } [
path binary [
@ -26,8 +23,8 @@ IN: io.ports.tests
100,000 4 * read int cast-array 100,000 iota sequence=
] with-file-reader
] unit-test
] cleanup-unique-file
] with-temp-directory
] with-test-file
! Getting the stream-element-type of an output-port was broken
{ +byte+ } [ binary <pipe> [ stream-element-type ] with-disposal ] unit-test

View File

@ -1,21 +1,16 @@
USING: alien alien.c-types alien.data arrays classes.struct
compiler.units continuations destructors generic.single io
compiler.units continuations destructors fry generic.single io
io.directories io.encodings.8-bit.latin1 io.encodings.ascii
io.encodings.binary io.encodings.string io.files
io.files.private io.files.temp io.files.unique io.pathnames
kernel locals make math sequences specialized-arrays
system threads tools.test vocabs ;
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
{ } [
[
"append-test" ".txt" [| path |
path ascii <file-appender> dispose
] cleanup-unique-file
] with-temp-directory
[ ascii <file-appender> dispose ] with-test-file
] unit-test
{
@ -46,8 +41,7 @@ SPECIALIZED-ARRAY: int
[ " " read-until [ ascii decode ] dip ] with-file-reader
] unit-test
[
"separator-test" ".txt" [| path |
[| path |
{ } [
"It seems Jobs has lost his grasp on reality again.\n"
path latin1 set-file-contents
@ -68,8 +62,7 @@ SPECIALIZED-ARRAY: int
] with-file-reader
] { } make
] unit-test
] cleanup-unique-file
] with-temp-directory
] with-test-file
{ } [
image-path binary [
@ -78,8 +71,7 @@ SPECIALIZED-ARRAY: int
] unit-test
! Writing specialized arrays to binary streams should work
[
"binary-int-array" ".bin" [| path |
[| path |
{ } [
path binary [
int-array{ 1 2 3 } write
@ -92,11 +84,9 @@ SPECIALIZED-ARRAY: int
] with-file-reader
int cast-array
] unit-test
] cleanup-unique-file
] with-temp-directory
] with-test-file
[
"test-012" ".bin" [| path |
[| path |
{ } [
BV{ 0 1 2 } path binary set-file-contents
] unit-test
@ -105,8 +95,7 @@ SPECIALIZED-ARRAY: int
path binary file-contents
B{ 0 1 2 } =
] unit-test
] cleanup-unique-file
] with-temp-directory
] with-test-file
STRUCT: pt { x uint } { y uint } ;
SPECIALIZED-ARRAY: pt
@ -114,8 +103,7 @@ SPECIALIZED-ARRAY: pt
CONSTANT: pt-array-1
pt-array{ S{ pt f 1 1 } S{ pt f 2 2 } S{ pt f 3 3 } }
[
"test-pt-array-1" ".bin" [| path |
[| path |
{ } [
pt-array-1 path binary set-file-contents
] unit-test
@ -124,12 +112,10 @@ CONSTANT: pt-array-1
path binary file-contents
pt-array-1 >c-ptr sequence=
] unit-test
] cleanup-unique-file
] with-temp-directory
] with-test-file
! Slices should support >c-ptr and byte-length
[
"test-pt-array-1-slice" ".bin" [| path |
[| path |
{ } [
pt-array-1 rest-slice
path binary set-file-contents
@ -140,8 +126,7 @@ CONSTANT: pt-array-1
pt cast-array
pt-array-1 rest-slice sequence=
] unit-test
] cleanup-unique-file
] with-temp-directory
] with-test-file
{ } [
[
@ -150,11 +135,11 @@ CONSTANT: pt-array-1
] unit-test
! Writing strings to binary streams should fail
[
"omgfail-binary" ".bin" [| path |
[| path |
[
path binary [ "OMGFAIL" write ] with-file-writer
] cleanup-unique-file
] must-fail
] must-fail
] with-test-file
! Test EOF behavior
{ 10 } [
@ -165,117 +150,78 @@ CONSTANT: pt-array-1
] unit-test
! Make sure that writing to a closed stream from another thread doesn't crash
! 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.txt" ascii [ [ yield "Hi" write ] "Test-write-file" spawn drop ] with-file-writer ] unit-test
{ } [ path ascii [ [ yield "Hi" write ] "Test-write-file" spawn drop ] with-file-writer ] unit-test
{ } [ "test.txt" delete-file ] unit-test
{ } [ path delete-file ] unit-test
{ } [ "test.txt" ascii [ [ yield "Hi" write ] "Test-write-file" spawn drop ] with-file-writer ] unit-test
{ } [ path ascii [ [ yield "Hi" write ] "Test-write-file" spawn drop ] with-file-writer ] unit-test
{ } [ "test.txt" "test2.txt" move-file ] unit-test
{ } [ path path2 move-file ] unit-test
{ t } [ "test2.txt" exists? ] unit-test
{ t } [ path2 exists? ] unit-test
{ } [ path2 delete-file ] unit-test
] call
] with-temp-directory
{ } [ "test2.txt" delete-file ] unit-test
] with-test-directory
! File seeking tests
{ B{ 3 2 3 4 5 } }
[
[
"seek-test1" "" [
binary
[
[
[| 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
] [
file-contents
] 2bi
] cleanup-unique-file
] with-temp-directory
] unit-test
] with-file-writer path binary file-contents
] unit-test
] with-test-file
{ B{ 1 2 3 4 3 } }
[
[
"seek-test2" "" [
binary
[
[
[| 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
] [
file-contents
] 2bi
] cleanup-unique-file
] with-temp-directory
] unit-test
] with-file-writer path binary file-contents
] unit-test
] with-test-file
{ B{ 1 2 3 4 5 0 3 } }
[
[
"seek-test3" "" [
binary
[
[
[| 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
] [
file-contents
] 2bi
] cleanup-unique-file
] with-temp-directory
] unit-test
] with-file-writer path binary file-contents
] unit-test
] with-test-file
{ B{ 3 } }
[
[
"seek-test4" "" [
B{ 1 2 3 4 5 } swap binary
[
set-file-contents
] [
[
[| 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
] 2bi
] cleanup-unique-file
] with-temp-directory
] unit-test
] unit-test
] with-test-file
{ B{ 2 } }
[
[
"seek-test5" "" [
B{ 1 2 3 4 5 } swap binary [
set-file-contents
] [
[
[| 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=
@ -284,19 +230,13 @@ CONSTANT: pt-array-1
1 read
tell-input 2 assert=
] with-file-reader
] 2bi
] cleanup-unique-file
] with-temp-directory
] unit-test
] unit-test
] with-test-file
[
[
"seek-test6" "" [
binary [
"does-not-exist" binary [
-10 seek-absolute seek-input
] with-file-reader
] cleanup-unique-file
] with-temp-directory
] must-fail
{ } [
@ -308,51 +248,25 @@ CONSTANT: pt-array-1
] with-file-reader
] unit-test
[
[
"non-string-error" "" [
ascii [ { } write ] with-file-writer
] cleanup-unique-file
] with-temp-directory
] [ no-method? ] must-fail-with
[| path |
[ path ascii [ { } write ] with-file-writer ]
[ no-method? ] must-fail-with
] with-test-file
[
[
"non-byte-array-error" "" [
binary [ "" write ] with-file-writer
] cleanup-unique-file
] with-temp-directory
] [ no-method? ] must-fail-with
[| 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
] cleanup-unique-file
] with-temp-directory
] unit-test
! Test cwd, cd.
! NOTE TO USER: You do not want to use with-cd, you want with-directory.
: with-cd ( path quot -- )
[ [ absolute-path cd ] curry ] dip compose
cwd [ cd ] curry
[ ] cleanup ; inline
{ t } [
cwd
"resource:core/" [ "hi" print ] with-cd
cwd =
] unit-test
{ t } [
cwd
[ "resource:core/" [ "nick cage" throw ] with-cd ] [ drop ] recover
cwd =
] unit-test
[
"resource:core/" [ "nick cage" throw ] with-cd
] [ "nick cage" = ] must-fail-with
"closing-twice" ascii <file-writer>
[ dispose ] [ dispose ] bi
] with-test-directory
{ f t t } [
[
"resource:core" absolute-path
[ cwd = ] [ cd ] [ cwd = ] tri
] cwd '[ _ dup cd cwd = ] [ ] cleanup
] unit-test

View File

@ -52,11 +52,9 @@ system tools.test ;
{ t } [ "resource:core" absolute-path? ] unit-test
{ f } [ "" absolute-path? ] unit-test
[
"touch-twice-test" ".txt" [| path |
[| path |
{ } [ 2 [ path touch-file ] times ] unit-test
] cleanup-unique-file
] with-temp-directory
] with-test-file
! aum's bug
H{

View File

@ -1,42 +1,35 @@
USING: alien.c-types alien.data io io.encodings.ascii io.files
io.files.temp io.files.unique io.streams.c kernel locals math
specialized-arrays strings tools.test ;
io.pathnames io.streams.c kernel math specialized-arrays
strings tools.test ;
SPECIALIZED-ARRAY: int
IN: io.streams.c.tests
[
"io-streams-c-tests-hello-world" ".txt" [| path |
! Writing strings to ascii streams
{ "hello world" } [
"hello world" path ascii set-file-contents
path "rb" fopen <c-reader> stream-contents >string
"hello-world.txt" absolute-path
[ "hello world" swap ascii set-file-contents ]
[ "rb" fopen <c-reader> stream-contents >string ] bi
] unit-test
] cleanup-unique-file
! Writing specialized arrays to binary streams
"io-streams-c-tests-int" ".txt" [| path |
{ } [
path "wb" fopen <c-writer> [
{ int-array{ 1 2 3 } } [
"c-tests-int.dat" absolute-path [
"wb" fopen <c-writer> [
int-array{ 1 2 3 } write
] with-output-stream
] unit-test
{ int-array{ 1 2 3 } } [
path "rb" fopen <c-reader> [
3 4 * read
] [
"rb" fopen <c-reader> [
3 4 * read int cast-array
] with-input-stream
int cast-array
] bi
] unit-test
] cleanup-unique-file
! Writing strings to binary streams should fail
"test-omgfail" ".txt" [| path |
[
path "wb" fopen <c-writer> [
"omgfail.txt" absolute-path "wb" fopen <c-writer> [
"OMGFAIL" write
] with-output-stream
] must-fail
] cleanup-unique-file
] with-temp-directory
] with-test-directory

View File

@ -1,11 +1,9 @@
USING: accessors arrays assocs combinators.short-circuit
continuations formatting graphviz graphviz.attributes
graphviz.dot graphviz.notation graphviz.render
graphviz.render.private images.loader.private io.directories
io.directories.hierarchy io.files io.files.temp io.files.unique
io.launcher io.pathnames kernel locals make math
math.combinatorics math.parser memoize namespaces sequences
sequences.extras sets splitting system tools.test ;
USING: accessors arrays assocs continuations formatting graphviz
graphviz.notation graphviz.render graphviz.render.private
images.loader.private io.directories io.encodings.8-bit.latin1
io.encodings.ascii io.encodings.utf8 io.files io.launcher kernel
locals make math math.combinatorics math.parser namespaces
sequences sequences.extras sets splitting system tools.test ;
IN: graphviz.tests
! XXX hack
@ -47,12 +45,10 @@ SYMBOLS: supported-layouts supported-formats ;
:: smoke-test ( graph -- pass? )
supported-formats get-global next! :> -T
supported-layouts get-global next! :> -K
[
[
graph "smoke-test" -T -K graphviz
"smoke-test" graphviz-output-appears-to-exist?
] cleanup-unique-directory
] with-temp-directory ;
] with-test-directory ;
: preview-smoke-test ( graph -- pass? )
[ exists? ] with-preview ;
@ -296,21 +292,10 @@ default-graphviz-program [
[ preview-format-test ] attempt-all
] [ unsupported-preview-format? ] must-fail-with
{ t }
[
USE: io.encodings.8-bit.latin1
latin1 encoding-test
] unit-test
{ t } [ latin1 encoding-test ] unit-test
{ t }
[
USE: io.encodings.utf8
utf8 encoding-test
] unit-test
{ t } [ utf8 encoding-test ] unit-test
[
USE: io.encodings.ascii
ascii encoding-test
] [ unsupported-encoding? ] must-fail-with
[ ascii encoding-test ] [ unsupported-encoding? ] must-fail-with
] when