steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
basis/db/sqlite/errors/errors-tests.factor
View File

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

28
basis/ftp/server/server-tests.factor
View File

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

8
basis/globs/globs-tests.factor
View File

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

11
basis/io/backend/unix/unix-tests.factor
View File

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

67
basis/io/directories/directories-tests.factor
View File

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

26
basis/io/directories/search/search-tests.factor
View File

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

17
basis/io/files/links/unix/unix-tests.factor
View File

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

17
basis/io/files/unix/unix-tests.factor
View File

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

11
basis/io/launcher/unix/unix-tests.factor
View File

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

17
basis/io/mmap/mmap-tests.factor
View File

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

11
basis/io/monitors/linux/linux-tests.factor
View File

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

21
basis/io/monitors/monitors-tests.factor
View File

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

13
basis/io/ports/ports-tests.factor
View File

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

216
core/io/files/files-tests.factor
View File

@ -1,21 +1,16 @@
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 fry 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.encodings.binary io.encodings.string io.files
io.files.private io.files.temp io.files.unique io.pathnames io.files.private io.pathnames kernel locals make math sequences
kernel locals make math sequences specialized-arrays specialized-arrays system threads tools.test vocabs ;
system threads tools.test vocabs ;
FROM: specialized-arrays.private => specialized-array-vocab ; FROM: specialized-arrays.private => specialized-array-vocab ;
IN: io.files.tests IN: io.files.tests
SPECIALIZED-ARRAY: int SPECIALIZED-ARRAY: int
{ } [ { } [
[ [ ascii <file-appender> dispose ] with-test-file
"append-test" ".txt" [| path |
path ascii <file-appender> dispose
] cleanup-unique-file
] with-temp-directory
] unit-test ] unit-test
{ {
@ -46,8 +41,7 @@ SPECIALIZED-ARRAY: int
[ " " read-until [ ascii decode ] dip ] with-file-reader [ " " read-until [ ascii decode ] dip ] with-file-reader
] unit-test ] unit-test
[ [| path |
"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"
path latin1 set-file-contents path latin1 set-file-contents
@ -68,8 +62,7 @@ SPECIALIZED-ARRAY: int
] with-file-reader ] with-file-reader
] { } make ] { } make
] unit-test ] unit-test
] cleanup-unique-file ] with-test-file
] with-temp-directory
{ } [ { } [
image-path binary [ image-path binary [
@ -78,8 +71,7 @@ SPECIALIZED-ARRAY: int
] unit-test ] unit-test
! Writing specialized arrays to binary streams should work ! Writing specialized arrays to binary streams should work
[ [| path |
"binary-int-array" ".bin" [| path |
{ } [ { } [
path binary [ path binary [
int-array{ 1 2 3 } write int-array{ 1 2 3 } write
@ -92,11 +84,9 @@ SPECIALIZED-ARRAY: int
] with-file-reader ] with-file-reader
int cast-array int cast-array
] unit-test ] unit-test
] cleanup-unique-file ] with-test-file
] with-temp-directory
[ [| path |
"test-012" ".bin" [| path |
{ } [ { } [
BV{ 0 1 2 } path binary set-file-contents BV{ 0 1 2 } path binary set-file-contents
] unit-test ] unit-test
@ -105,8 +95,7 @@ SPECIALIZED-ARRAY: int
path binary file-contents path binary file-contents
B{ 0 1 2 } = B{ 0 1 2 } =
] unit-test ] unit-test
] cleanup-unique-file ] with-test-file
] with-temp-directory
STRUCT: pt { x uint } { y uint } ; STRUCT: pt { x uint } { y uint } ;
SPECIALIZED-ARRAY: pt SPECIALIZED-ARRAY: pt
@ -114,8 +103,7 @@ 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 } }
[ [| path |
"test-pt-array-1" ".bin" [| path |
{ } [ { } [
pt-array-1 path binary set-file-contents pt-array-1 path binary set-file-contents
] unit-test ] unit-test
@ -124,12 +112,10 @@ CONSTANT: pt-array-1
path 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-test-file
] with-temp-directory
! Slices should support >c-ptr and byte-length ! Slices should support >c-ptr and byte-length
[ [| path |
"test-pt-array-1-slice" ".bin" [| path |
{ } [ { } [
pt-array-1 rest-slice pt-array-1 rest-slice
path binary set-file-contents path binary set-file-contents
@ -140,8 +126,7 @@ CONSTANT: pt-array-1
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-test-file
] with-temp-directory
{ } [ { } [
[ [
@ -150,11 +135,11 @@ CONSTANT: pt-array-1
] unit-test ] unit-test
! Writing strings to binary streams should fail ! Writing strings to binary streams should fail
[| path |
[ [
"omgfail-binary" ".bin" [| path |
path binary [ "OMGFAIL" write ] with-file-writer path binary [ "OMGFAIL" write ] with-file-writer
] cleanup-unique-file
] must-fail ] must-fail
] with-test-file
! Test EOF behavior ! Test EOF behavior
{ 10 } [ { 10 } [
@ -165,117 +150,78 @@ 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
! Don't use cleanup-unique-file here because we do manual cleanup as part of test
[ [
"test-quux" ".txt" unique-file [| path | { } [ "test.txt" ascii [ [ yield "Hi" write ] "Test-write-file" spawn drop ] with-file-writer ] unit-test
path ".2" append :> path2
{ } [ 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 { } [ "test2.txt" delete-file ] unit-test
] with-test-directory
{ } [ path2 delete-file ] unit-test
] call
] with-temp-directory
! File seeking tests ! File seeking tests
{ B{ 3 2 3 4 5 } } [| path |
[ { B{ 3 2 3 4 5 } } [
[ path binary [
"seek-test1" "" [
binary
[
[
B{ 1 2 3 4 5 } write B{ 1 2 3 4 5 } write
tell-output 5 assert= tell-output 5 assert=
0 seek-absolute seek-output 0 seek-absolute seek-output
tell-output 0 assert= tell-output 0 assert=
B{ 3 } write B{ 3 } write
tell-output 1 assert= tell-output 1 assert=
] with-file-writer ] with-file-writer path binary file-contents
] [
file-contents
] 2bi
] cleanup-unique-file
] with-temp-directory
] unit-test ] unit-test
] with-test-file
{ B{ 1 2 3 4 3 } } [| path |
[ { B{ 1 2 3 4 3 } } [
[ path binary [
"seek-test2" "" [
binary
[
[
B{ 1 2 3 4 5 } write B{ 1 2 3 4 5 } write
tell-output 5 assert= tell-output 5 assert=
-1 seek-relative seek-output -1 seek-relative seek-output
tell-output 4 assert= tell-output 4 assert=
B{ 3 } write B{ 3 } write
tell-output 5 assert= tell-output 5 assert=
] with-file-writer ] with-file-writer path binary file-contents
] [
file-contents
] 2bi
] cleanup-unique-file
] with-temp-directory
] unit-test ] unit-test
] with-test-file
{ B{ 1 2 3 4 5 0 3 } } [| path |
[ { B{ 1 2 3 4 5 0 3 } } [
[ path binary [
"seek-test3" "" [
binary
[
[
B{ 1 2 3 4 5 } write B{ 1 2 3 4 5 } write
tell-output 5 assert= tell-output 5 assert=
1 seek-relative seek-output 1 seek-relative seek-output
tell-output 6 assert= tell-output 6 assert=
B{ 3 } write B{ 3 } write
tell-output 7 assert= tell-output 7 assert=
] with-file-writer ] with-file-writer path binary file-contents
] [
file-contents
] 2bi
] cleanup-unique-file
] with-temp-directory
] unit-test ] unit-test
] with-test-file
{ B{ 3 } } [| path |
[ { B{ 3 } } [
[ B{ 1 2 3 4 5 } path binary set-file-contents
"seek-test4" "" [ path binary [
B{ 1 2 3 4 5 } swap binary
[
set-file-contents
] [
[
tell-input 0 assert= tell-input 0 assert=
-3 seek-end seek-input -3 seek-end seek-input
tell-input 2 assert= tell-input 2 assert=
1 read 1 read
tell-input 3 assert= tell-input 3 assert=
] with-file-reader ] with-file-reader
] 2bi
] cleanup-unique-file
] with-temp-directory
] unit-test ] unit-test
] with-test-file
{ B{ 2 } } [| path |
[
[ { B{ 2 } } [
"seek-test5" "" [ B{ 1 2 3 4 5 } path binary set-file-contents
B{ 1 2 3 4 5 } swap binary [ path binary [
set-file-contents
] [
[
tell-input 0 assert= tell-input 0 assert=
3 seek-absolute seek-input 3 seek-absolute seek-input
tell-input 3 assert= tell-input 3 assert=
@ -284,19 +230,13 @@ CONSTANT: pt-array-1
1 read 1 read
tell-input 2 assert= tell-input 2 assert=
] with-file-reader ] with-file-reader
] 2bi
] cleanup-unique-file
] with-temp-directory
] unit-test ] unit-test
] with-test-file
[ [
[ "does-not-exist" binary [
"seek-test6" "" [
binary [
-10 seek-absolute seek-input -10 seek-absolute seek-input
] with-file-reader ] with-file-reader
] cleanup-unique-file
] with-temp-directory
] must-fail ] must-fail
{ } [ { } [
@ -308,51 +248,25 @@ CONSTANT: pt-array-1
] with-file-reader ] with-file-reader
] unit-test ] unit-test
[ [| path |
[ [ path ascii [ { } write ] with-file-writer ]
"non-string-error" "" [ [ no-method? ] must-fail-with
ascii [ { } write ] with-file-writer ] with-test-file
] cleanup-unique-file
] with-temp-directory
] [ no-method? ] must-fail-with
[ [| path |
[ [ path binary [ "" write ] with-file-writer ]
"non-byte-array-error" "" [ [ no-method? ] must-fail-with
binary [ "" write ] with-file-writer ] with-test-file
] cleanup-unique-file
] with-temp-directory
] [ no-method? ] must-fail-with
! What happens if we close a file twice? ! What happens if we close a file twice?
{ } [
[ [
"closing-twice" "" [ "closing-twice" ascii <file-writer>
ascii <file-writer>
[ dispose ] [ dispose ] bi [ dispose ] [ dispose ] bi
] cleanup-unique-file ] with-test-directory
] 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
{ f t t } [
[ [
"resource:core/" [ "nick cage" throw ] with-cd "resource:core" absolute-path
] [ "nick cage" = ] must-fail-with [ cwd = ] [ cd ] [ cwd = ] tri
] cwd '[ _ dup cd cwd = ] [ ] cleanup
] unit-test

6
core/io/pathnames/pathnames-tests.factor
View File

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

37
core/io/streams/c/c-tests.factor
View File

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

35
extra/graphviz/graphviz-tests.factor
View File

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