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

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

@ -1,28 +1,25 @@
! 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
] [ ] [
{ [ sql-table-missing? ] [ table>> "foo" = ] } 1&& { [ sql-table-missing? ] [ table>> "foo" = ] } 1&&
] must-fail-with ] must-fail-with
"create table foo(id);" sql-command
[
"create table foo(id);" sql-command "create table foo(id);" sql-command
] [
{ [ sql-table-exists? ] [ table>> "foo" = ] } 1&&
] must-fail-with
[ ] with-db
"create table foo(id);" sql-command ] with-test-file
] [
{ [ sql-table-exists? ] [ table>> "foo" = ] } 1&&
] must-fail-with
] with-db
] cleanup-unique-file
] with-temp-directory

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

@ -1,39 +1,27 @@
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 "ftp" >>protocol
"ftp" >>protocol create-test-file >>path
create-test-file >>path @
@ ] with-threaded-server
] with-threaded-server ] with-test-directory ; inline
] cleanup-unique-directory
] with-temp-directory ; inline
{ t } { t } [
[
[ [
[ [ ftp-get ]
[ [ path>> file-name ascii file-contents ] bi
[ ftp-get ]
[ 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 ]
[ [ path>> file-name ascii file-contents ] bi
[ ftp-get ]
[ 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

54
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
@ -61,31 +59,29 @@ IN: globs.tests
} [ } [
[ [
[ "a" make-directory
"a" make-directory "a/b" make-directory
"a/b" make-directory "a/b/c" make-directory
"a/b/c" make-directory "a/b/c/d" make-directory
"a/b/c/d" make-directory "a/b/c/d/e" touch-file
"a/b/c/d/e" touch-file "a/b/c/f" touch-file
"a/b/c/f" touch-file "a/b/g" touch-file
"a/b/g" touch-file "a/b/h" make-directory
"a/b/h" make-directory "a/b/h/e" touch-file
"a/b/h/e" touch-file "a/e" make-directory
"a/e" make-directory "a/e/f" touch-file
"a/e/f" touch-file "a/e/g" make-directory
"a/e/g" make-directory "a/e/g/e" touch-file
"a/e/g/e" touch-file
"**" glob-directory natural-sort "**" glob-directory natural-sort
"**/" glob-directory natural-sort "**/" glob-directory natural-sort
"**/*" glob-directory natural-sort "**/*" glob-directory natural-sort
"**/**" glob-directory natural-sort "**/**" glob-directory natural-sort
"**/b" glob-directory natural-sort "**/b" glob-directory natural-sort
"**/e" glob-directory natural-sort "**/e" glob-directory natural-sort
! "**//e" glob-directory natural-sort ! "**//e" glob-directory natural-sort
! "**/**/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

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

@ -1,130 +1,127 @@
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>
ascii <server> [
accept drop [
"Hello world" print flush
readln "XYZ" = "FOO" "BAR" ? print flush
] with-stream
] with-disposal
"socket-server" delete-file
] "Test" spawn drop
yield
{ { "Hello world" "FOO" } } [
[ [
"socket-server" <local> "socket-server" <local> ascii [
ascii <server> [ readln ,
accept drop [ "XYZ" print flush
"Hello world" print flush readln ,
readln "XYZ" = "FOO" "BAR" ? print flush ] with-client
] with-stream ] { } make
] with-disposal ] unit-test
"socket-server" delete-file ! Unix domain datagram sockets
] "Test" spawn drop [
"datagram-server" <local> <datagram> "d" [
yield "Receive 1" print
{ { "Hello world" "FOO" } } [ "d" get receive [ reverse ] dip
[
"socket-server" <local> ascii [
readln ,
"XYZ" print flush
readln ,
] with-client
] { } make
] unit-test
! Unix domain datagram sockets "Send 1" print
[ dup .
"datagram-server" <local> <datagram> "d" [
"Receive 1" print
"d" get receive [ reverse ] dip
"Send 1" print
dup .
"d" get send
"Receive 2" print
"d" get receive [ " world" append ] dip
"Send 1" print
dup .
"d" get send
"d" get dispose
"Done" print
"datagram-server" delete-file
] with-variable
] "Test" spawn drop
yield
{ } [ "datagram-client" <local> <datagram> "d" set ] unit-test
{ } [
"hello" >byte-array
"datagram-server" <local>
"d" get send "d" get send
] unit-test
{ "olleh" t } [ "Receive 2" print
"d" get receive
"datagram-server" <local> =
[ >string ] dip
] unit-test
{ } [ "d" get receive [ " world" append ] dip
"hello" >byte-array
"datagram-server" <local>
"d" get send
] unit-test
{ "hello world" t } [ "Send 1" print
"d" get receive dup .
"datagram-server" <local> =
[ >string ] dip
] unit-test
{ } [ "d" get dispose ] unit-test "d" get send
! Test error behavior "d" get dispose
"datagram-client" delete-file "Done" print
{ } [ "datagram-client" <local> <datagram> "d" set ] unit-test "datagram-server" delete-file
] with-variable
] "Test" spawn drop
[ B{ 1 2 3 } "another-datagram" <local> "d" get send ] must-fail yield
{ } [ "d" get dispose ] unit-test { } [ "datagram-client" <local> <datagram> "d" set ] unit-test
! See what happens on send/receive after close { } [
"hello" >byte-array
"datagram-server" <local>
"d" get send
] unit-test
[ "d" get receive ] must-fail { "olleh" t } [
"d" get receive
"datagram-server" <local> =
[ >string ] dip
] unit-test
[ B{ 1 2 } "datagram-server" <local> "d" get send ] must-fail { } [
"hello" >byte-array
"datagram-server" <local>
"d" get send
] unit-test
! Invalid parameter tests { "hello world" t } [
"d" get receive
"datagram-server" <local> =
[ >string ] dip
] unit-test
[ { } [ "d" get dispose ] unit-test
image-path binary [ input-stream get accept ] with-file-reader
] must-fail
[ ! Test error behavior
image-path binary [ input-stream get receive ] with-file-reader
] must-fail
[ "datagram-client" delete-file
image-path binary [
B{ 1 2 } "datagram-server" <local>
input-stream get send
] with-file-reader
] must-fail
] cleanup-unique-directory { } [ "datagram-client" <local> <datagram> "d" set ] unit-test
] with-temp-directory
[ B{ 1 2 3 } "another-datagram" <local> "d" get send ] must-fail
{ } [ "d" get dispose ] unit-test
! See what happens on send/receive after close
[ "d" get receive ] must-fail
[ B{ 1 2 } "datagram-server" <local> "d" get send ] must-fail
! Invalid parameter tests
[
image-path binary [ input-stream get accept ] with-file-reader
] must-fail
[
image-path binary [ input-stream get receive ] with-file-reader
] must-fail
[
image-path binary [
B{ 1 2 } "datagram-server" <local>
input-stream get send
] with-file-reader
] must-fail
] with-test-directory
! closing stdin caused some problems ! closing stdin caused some problems
{ } [ { } [

233
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,181 +20,144 @@ 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 t f } [
{ t } [ "blahblah" temp-file file-info directory? ] unit-test "blahblah" make-directory
"blahblah" exists?
"blahblah" file-info directory?
"blahblah" delete-directory
"blahblah" exists?
] unit-test
{ t } [ { "file1 contents" } [
[
[ "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" 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." }
{ } [ "test-foo.txt" ascii set-file-lines
{ "Hello world." } ] unit-test
"test-foo.txt" ascii set-file-lines
] unit-test
{ } [ { } [
"test-foo.txt" ascii [ "test-foo.txt" ascii [
"Hello appender." print "Hello appender." print
] with-file-appender ] with-file-appender
] unit-test ] unit-test
{ } [ { } [
"test-bar.txt" ascii [ "test-bar.txt" ascii [
"Hello appender." print "Hello appender." print
] with-file-appender ] with-file-appender
] unit-test ] unit-test
{ "Hello world.\nHello appender.\n" } [ { "Hello world.\nHello appender.\n" } [
"test-foo.txt" ascii file-contents "test-foo.txt" ascii file-contents
] unit-test ] unit-test
{ "Hello appender.\n" } [ { "Hello appender.\n" } [
"test-bar.txt" ascii file-contents "test-bar.txt" ascii file-contents
] unit-test ] unit-test
{ } [ "test-foo.txt" delete-file ] unit-test { } [ "test-foo.txt" delete-file ] unit-test
{ } [ "test-bar.txt" delete-file ] unit-test { } [ "test-bar.txt" delete-file ] unit-test
{ 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
{ } [ { } [
"test-blah/fooz" ascii <file-writer> dispose "test-blah/fooz" ascii <file-writer> dispose
] unit-test ] unit-test
{ t } [ { t } [
"test-blah/fooz" exists? "test-blah/fooz" exists?
] unit-test ] unit-test
{ } [ "test-blah/fooz" delete-file ] unit-test { } [ "test-blah/fooz" delete-file ] unit-test
{ } [ "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
{ } [ { } [
{ "Hi" } "delete-tree-test/a/b/c/d" ascii set-file-lines { "Hi" } "delete-tree-test/a/b/c/d" ascii set-file-lines
] 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
{ } [ ] unit-test
"copy-tree-test/a/b/c" make-directories
] unit-test
{ } [ { } [
"Foobar" "Foobar"
"copy-tree-test/a/b/c/d" "copy-tree-test/a/b/c/d"
ascii set-file-contents ascii set-file-contents
] unit-test ] unit-test
{ } [ { } [
"copy-tree-test" "copy-destination" copy-tree "copy-tree-test" "copy-destination" copy-tree
] unit-test ] unit-test
{ "Foobar" } [ { "Foobar" } [
"copy-destination/a/b/c/d" ascii file-contents "copy-destination/a/b/c/d" ascii file-contents
] unit-test ] unit-test
{ } [ { } [
"copy-destination" delete-tree "copy-destination" delete-tree
] unit-test ] unit-test
{ } [ { } [
"copy-tree-test" "copy-destination" copy-tree-into "copy-tree-test" "copy-destination" copy-tree-into
] unit-test ] unit-test
{ "Foobar" } [ { "Foobar" } [
"copy-destination/copy-tree-test/a/b/c/d" ascii file-contents "copy-destination/copy-tree-test/a/b/c/d" ascii file-contents
] unit-test ] unit-test
{ } [ { } [
"copy-destination/copy-tree-test/a/b/c/d" "." copy-file-into "copy-destination/copy-tree-test/a/b/c/d" "." copy-file-into
] unit-test ] unit-test
{ "Foobar" } [ { "Foobar" } [
"d" ascii file-contents "d" ascii file-contents
] unit-test ] unit-test
{ } [ "d" delete-file ] unit-test { } [ "d" delete-file ] unit-test
{ } [ "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 ! Issue #890
{ } [ "resource:deleteme" delete-file ] unit-test { } [
"foo" [ make-directories ] keep
[ "touch bar" try-output-process ] with-directory
] unit-test
] with-test-directory
! Issue #890
{ } [
"foo" temp-file [ make-directories ] keep
[ "touch bar" try-output-process ] with-directory
] unit-test

32
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 [ natural-sort ] same?
"." [ ] find-all-files ] with-test-directory
] cleanup-unique-directory [ natural-sort ] same?
] with-temp-directory
] unit-test ] unit-test
{ f } [ { f } [
@ -25,22 +21,20 @@ IN: io.directories.search.tests
{ 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? ] with-test-directory
] cleanup-unique-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 } [

31
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 -- )
@ -9,30 +8,24 @@ IN: io.files.links.unix.tests
{ t } [ { t } [
[ [
[ 5 "lol" make-test-links
5 "lol" make-test-links "lol1" follow-links
"lol1" follow-links "lol5" absolute-path =
"lol5" absolute-path = ] with-test-directory
] cleanup-unique-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-test-directory
] with-unique-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 = ] with-test-directory
] cleanup-unique-directory
] with-temp-directory
] with-variable ] with-variable
] unit-test ] unit-test

207
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,142 +30,140 @@ 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
path file-permissions 0o7777 mask path file-permissions 0o7777 mask
] unit-test ] unit-test
{ t } [ path user-read? ] unit-test { t } [ path user-read? ] unit-test
{ t } [ path user-write? ] unit-test { t } [ path user-write? ] unit-test
{ t } [ path user-execute? ] unit-test { t } [ path user-execute? ] unit-test
{ t } [ path group-read? ] unit-test { t } [ path group-read? ] unit-test
{ t } [ path group-write? ] unit-test { t } [ path group-write? ] unit-test
{ t } [ path group-execute? ] unit-test { t } [ path group-execute? ] unit-test
{ t } [ path other-read? ] unit-test { t } [ path other-read? ] unit-test
{ t } [ path other-write? ] unit-test { t } [ path other-write? ] unit-test
{ t } [ path other-execute? ] unit-test { t } [ path other-execute? ] unit-test
{ 0o776 } [ { 0o776 } [
path f set-other-execute path f set-other-execute
path file-permissions 0o7777 mask path file-permissions 0o7777 mask
] unit-test ] unit-test
{ f } [ path file-info other-execute? ] unit-test { f } [ path file-info other-execute? ] unit-test
{ 0o774 } [ { 0o774 } [
path f set-other-write path f set-other-write
path file-permissions 0o7777 mask path file-permissions 0o7777 mask
] unit-test ] unit-test
{ f } [ path file-info other-write? ] unit-test { f } [ path file-info other-write? ] unit-test
{ 0o770 } [ { 0o770 } [
path f set-other-read path f set-other-read
path file-permissions 0o7777 mask path file-permissions 0o7777 mask
] unit-test ] unit-test
{ f } [ path file-info other-read? ] unit-test { f } [ path file-info other-read? ] unit-test
{ 0o760 } [ { 0o760 } [
path f set-group-execute path f set-group-execute
path file-permissions 0o7777 mask path file-permissions 0o7777 mask
] unit-test ] unit-test
{ f } [ path file-info group-execute? ] unit-test { f } [ path file-info group-execute? ] unit-test
{ 0o740 } [ { 0o740 } [
path f set-group-write path f set-group-write
path file-permissions 0o7777 mask path file-permissions 0o7777 mask
] unit-test ] unit-test
{ f } [ path file-info group-write? ] unit-test { f } [ path file-info group-write? ] unit-test
{ 0o700 } [ { 0o700 } [
path f set-group-read path f set-group-read
path file-permissions 0o7777 mask path file-permissions 0o7777 mask
] unit-test ] unit-test
{ f } [ path file-info group-read? ] unit-test { f } [ path file-info group-read? ] unit-test
{ 0o600 } [ { 0o600 } [
path f set-user-execute path f set-user-execute
path file-permissions 0o7777 mask path file-permissions 0o7777 mask
] unit-test ] unit-test
{ f } [ path file-info other-execute? ] unit-test { f } [ path file-info other-execute? ] unit-test
{ 0o400 } [ { 0o400 } [
path f set-user-write path f set-user-write
path file-permissions 0o7777 mask path file-permissions 0o7777 mask
] unit-test ] unit-test
{ f } [ path file-info other-write? ] unit-test { f } [ path file-info other-write? ] unit-test
{ 0o000 } [ { 0o000 } [
path f set-user-read path f set-user-read
path file-permissions 0o7777 mask path file-permissions 0o7777 mask
] unit-test ] unit-test
{ f } [ path file-info other-read? ] unit-test { f } [ path file-info other-read? ] unit-test
{ 0o771 } [ { 0o771 } [
path flags{ USER-ALL GROUP-ALL OTHER-EXECUTE } set-file-permissions path flags{ USER-ALL GROUP-ALL OTHER-EXECUTE } set-file-permissions
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
[ set-file-access-time ] 2keep [ set-file-access-time ] 2keep
[ file-info accessed>> ] [ file-info accessed>> ]
[ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* = [ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* =
] unit-test ] unit-test
{ t } { t }
[ [
path now path now
[ set-file-modified-time ] 2keep [ set-file-modified-time ] 2keep
[ file-info modified>> ] [ file-info modified>> ]
[ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* = [ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* =
] unit-test ] unit-test
{ t } { t }
[ [
path now [ dup 2array set-file-times ] 2keep path now [ dup 2array set-file-times ] 2keep
[ file-info [ modified>> ] [ accessed>> ] bi ] dip [ file-info [ modified>> ] [ accessed>> ] bi ] dip
3array 3array
[ [ truncate >integer ] change-second >gmt ] map all-equal? [ [ truncate >integer ] change-second >gmt ] map all-equal?
] unit-test ] unit-test
{ } [ path f now 2array set-file-times ] unit-test { } [ path f now 2array set-file-times ] unit-test
{ } [ path now f 2array set-file-times ] unit-test { } [ path now f 2array set-file-times ] unit-test
{ } [ path f f 2array set-file-times ] unit-test { } [ path f f 2array set-file-times ] unit-test
{ } [ path real-user-name set-file-user ] unit-test { } [ path real-user-name set-file-user ] unit-test
{ } [ path real-user-id set-file-user ] unit-test { } [ path real-user-id set-file-user ] unit-test
{ } [ path real-group-name set-file-group ] unit-test { } [ path real-group-name set-file-group ] unit-test
{ } [ path real-group-id set-file-group ] unit-test { } [ path real-group-id set-file-group ] unit-test
{ t } [ path file-user-name real-user-name = ] unit-test { t } [ path file-user-name real-user-name = ] unit-test
{ t } [ path file-group-name real-group-name = ] unit-test { t } [ path file-group-name real-group-name = ] unit-test
{ } [ path real-user-id real-group-id set-file-ids ] unit-test { } [ path real-user-id real-group-id set-file-ids ] unit-test
{ } [ path f real-group-id set-file-ids ] unit-test { } [ path f real-group-id set-file-ids ] unit-test
{ } [ path real-user-id f set-file-ids ] unit-test { } [ path real-user-id f set-file-ids ] unit-test
{ } [ 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

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

@ -1,88 +1,85 @@
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
{ t } [ "launcher-test-1" exists? ] unit-test { t } [ "launcher-test-1" exists? ] unit-test
{ } [ { } [
[ "launcher-test-1" delete-file ] ignore-errors [ "launcher-test-1" delete-file ] ignore-errors
] unit-test ] unit-test
{ } [ { } [
<process> <process>
"echo Hello" >>command "echo Hello" >>command
"launcher-test-1" >>stdout "launcher-test-1" >>stdout
try-process try-process
] unit-test ] unit-test
{ "Hello\n" } [ { "Hello\n" } [
{ "cat" "launcher-test-1" } { "cat" "launcher-test-1" }
ascii <process-reader> stream-contents ascii <process-reader> stream-contents
] unit-test ] unit-test
{ } [ { } [
[ "launcher-test-1" delete-file ] ignore-errors [ "launcher-test-1" delete-file ] ignore-errors
] unit-test ] unit-test
{ } [ { } [
<process> <process>
"cat" >>command "cat" >>command
+closed+ >>stdin +closed+ >>stdin
"launcher-test-1" >>stdout "launcher-test-1" >>stdout
try-process try-process
] unit-test ] unit-test
{ "" } [ { "" } [
{ "cat" "launcher-test-1" } { "cat" "launcher-test-1" }
ascii <process-reader> stream-contents ascii <process-reader> stream-contents
] unit-test ] unit-test
{ } [ { } [
2 [ 2 [
"launcher-test-1" binary <file-appender> [ "launcher-test-1" binary <file-appender> [
<process>
swap >>stdout
"echo Hello" >>command
try-process
] with-disposal
] times
] unit-test
{ "Hello\nHello\n" } [
{ "cat" "launcher-test-1" }
ascii <process-reader> stream-contents
] unit-test
{ "hi\n" } [
<process>
{ "echo" "hi" } >>command
"launcher-test-2" >>stdout
try-process
"launcher-test-2" utf8 file-contents
] unit-test
{ "hi\nhi\n" } [
2 [
<process> <process>
"echo hi" >>command swap >>stdout
"launcher-test-3" <appender> >>stdout "echo Hello" >>command
try-process try-process
] times ] with-disposal
"launcher-test-3" utf8 file-contents ] times
] unit-test ] unit-test
] cleanup-unique-directory { "Hello\nHello\n" } [
] with-temp-directory { "cat" "launcher-test-1" }
ascii <process-reader> stream-contents
] unit-test
{ "hi\n" } [
<process>
{ "echo" "hi" } >>command
"launcher-test-2" >>stdout
try-process
"launcher-test-2" utf8 file-contents
] unit-test
{ "hi\nhi\n" } [
2 [
<process>
"echo hi" >>command
"launcher-test-3" <appender> >>stdout
try-process
] times
"launcher-test-3" utf8 file-contents
] unit-test
] with-test-directory
{ t } [ { t } [
<process> <process>

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

@ -1,26 +1,23 @@
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 { 5 } [ path [ char <mapped-array> length ] with-mapped-file-reader ] unit-test
{ 5 } [ path [ char <mapped-array> length ] with-mapped-file-reader ] unit-test { "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 ] with-test-file
] cleanup-unique-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 ]

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

@ -1,41 +1,36 @@
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 { } [
{ } [ "." f <monitor> "m" set
"." f <monitor> "m" set 3 seconds "m" get set-timeout
3 seconds "m" get set-timeout "." touch-file
"." touch-file ] unit-test
] unit-test
{ t } [ { t } [
"m" get next-change path>> "m" get next-change path>>
[ "" = ] [ "." absolute-path = ] bi or [ "" = ] [ "." absolute-path = ] bi or
] unit-test ] unit-test
{ } [ "m" get dispose ] unit-test { } [ "m" get dispose ] unit-test
! Recursive ! Recursive
{ } [ { } [
"." t <monitor> "m" set "." t <monitor> "m" set
3 seconds "m" get set-timeout 3 seconds "m" get set-timeout
"." touch-file "." touch-file
] unit-test ] unit-test
{ t } [ { t } [
"m" get next-change path>> "m" get next-change path>>
[ "" = ] [ "." absolute-path = ] bi or [ "" = ] [ "." absolute-path = ] bi or
] unit-test ] 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

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

@ -1,80 +1,75 @@
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
{ } [ "a1" make-directory ] unit-test { } [ "a1" make-directory ] unit-test
{ } [ "a2" make-directory ] unit-test { } [ "a2" make-directory ] unit-test
{ } [ "a1" "a2" move-file-into ] unit-test { } [ "a1" "a2" move-file-into ] unit-test
{ t } [ "a2/a1" exists? ] unit-test { t } [ "a2/a1" exists? ] unit-test
{ } [ "a2/a1/a3.txt" touch-file ] unit-test { } [ "a2/a1/a3.txt" touch-file ] unit-test
{ t } [ "a2/a1/a3.txt" exists? ] unit-test { t } [ "a2/a1/a3.txt" exists? ] unit-test
{ } [ "a2/a1/a4.txt" touch-file ] unit-test { } [ "a2/a1/a4.txt" touch-file ] unit-test
{ } [ "a2/a1/a5.txt" touch-file ] unit-test { } [ "a2/a1/a5.txt" touch-file ] unit-test
{ } [ "a2/a1/a4.txt" delete-file ] unit-test { } [ "a2/a1/a4.txt" delete-file ] unit-test
{ } [ "a2/a1/a5.txt" "a2/a1/a4.txt" move-file ] unit-test { } [ "a2/a1/a5.txt" "a2/a1/a4.txt" move-file ] unit-test
{ t } [ "a2/a1/a4.txt" exists? ] unit-test { t } [ "a2/a1/a4.txt" exists? ] 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
[ [
[ [
[ { } [ "xyz" make-directory ] unit-test
{ } [ "xyz" make-directory ] unit-test { } [ "." t <monitor> "m" set ] unit-test
{ } [ "." t <monitor> "m" set ] unit-test
{ } [ 1 <count-down> "b" set ] unit-test { } [ 1 <count-down> "b" set ] unit-test
{ } [ 1 <count-down> "c1" set ] unit-test { } [ 1 <count-down> "c1" set ] unit-test
{ } [ 1 <count-down> "c2" set ] unit-test { } [ 1 <count-down> "c2" set ] unit-test
[
"b" get count-down
[ [
"b" get count-down "m" get next-change path>>
dup print flush
dup parent-directory
[ trim-tail-separators "xyz" tail? ] either? not
] loop
[ "c1" get count-down
"m" get next-change path>> [
dup print flush "m" get next-change path>>
dup parent-directory dup print flush
[ trim-tail-separators "xyz" tail? ] either? not dup parent-directory
] loop [ trim-tail-separators "yxy" tail? ] either? not
] loop
"c1" get count-down "c2" get count-down
[ ] "Monitor test thread" spawn drop
"m" get next-change path>>
dup print flush
dup parent-directory
[ trim-tail-separators "yxy" tail? ] either? not
] loop
"c2" get count-down { } [ "b" get await ] unit-test
] "Monitor test thread" spawn drop { } [ "xyz/test.txt" touch-file ] unit-test
{ } [ "c1" get 1 minutes await-timeout ] unit-test
{ } [ "subdir/blah/yxy" make-directories ] unit-test
{ } [ "subdir/blah/yxy/test.txt" touch-file ] unit-test
{ } [ "c2" get 1 minutes await-timeout ] unit-test
{ } [ "b" get await ] unit-test ! Dispose twice
{ } [ "xyz/test.txt" touch-file ] unit-test { } [ "m" get dispose ] unit-test
{ } [ "c1" get 1 minutes await-timeout ] unit-test { } [ "m" get dispose ] unit-test
{ } [ "subdir/blah/yxy" make-directories ] unit-test ] with-monitors
{ } [ "subdir/blah/yxy/test.txt" touch-file ] unit-test ] with-test-directory
{ } [ "c2" get 1 minutes await-timeout ] unit-test
! Dispose twice
{ } [ "m" get dispose ] unit-test
{ } [ "m" get dispose ] unit-test
] with-monitors
] cleanup-unique-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
@ -83,51 +78,47 @@ IN: io.monitors.tests
! Timeouts ! Timeouts
[ [
[ [
[ ! Non-recursive
! Non-recursive { } [
{ } [ "." f <monitor> "m" set
"." f <monitor> "m" set 100 milliseconds "m" get set-timeout
100 milliseconds "m" get set-timeout [ [ t ] [ "m" get next-change drop ] while ] must-fail
[ [ t ] [ "m" get next-change drop ] while ] must-fail "m" get dispose
"m" get dispose ] unit-test
] unit-test
! Recursive ! Recursive
{ } [ { } [
"." t <monitor> "m" set "." t <monitor> "m" set
100 milliseconds "m" get set-timeout 100 milliseconds "m" get set-timeout
[ [ t ] [ "m" get next-change drop ] while ] must-fail [ [ t ] [ "m" get next-change drop ] while ] must-fail
"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
[ [
[ [
{ } [
<promise> "p" set
"." t <monitor> "m" set
10 seconds "m" get set-timeout
] unit-test
[ [
{ } [ [ "m" get next-change ] [ ] recover
<promise> "p" set "p" get fulfill
"." t <monitor> "m" set ] in-thread
10 seconds "m" get set-timeout
] unit-test
[ { } [
[ "m" get next-change ] [ ] recover 100 milliseconds sleep
"p" get fulfill "m" get dispose
] in-thread ] unit-test
{ } [ { t } [
100 milliseconds sleep "p" get 10 seconds ?promise-timeout
"m" get dispose already-disposed?
] unit-test ] unit-test
] with-monitors
{ t } [ ] with-test-directory
"p" get 10 seconds ?promise-timeout
already-disposed?
] unit-test
] with-monitors
] cleanup-unique-directory
] with-temp-directory

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

@ -1,33 +1,30 @@
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 [
[ [
100,000 iota 100,000 iota
0 0
100,000 int malloc-array &free [ copy ] keep write 100,000 int malloc-array &free [ copy ] keep write
] with-destructors ] with-destructors
] with-file-writer ] with-file-writer
] unit-test ] unit-test
{ t } [ { t } [
path binary [ path binary [
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

410
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,30 +41,28 @@ 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 ] unit-test
] unit-test
{
{ {
{ { "It seems " CHAR: J }
{ "It seems " CHAR: J } { "obs has lost h" CHAR: i }
{ "obs has lost h" CHAR: i } { "s grasp on reality again.\n" f }
{ "s grasp on reality again.\n" f } }
} } [
} [ [
[ path latin1 [
path 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 ] with-test-file
] cleanup-unique-file
] with-temp-directory
{ } [ { } [
image-path binary [ image-path binary [
@ -78,35 +71,31 @@ 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 ] with-file-writer
] with-file-writer ] unit-test
] unit-test
{ int-array{ 1 2 3 } } [ { int-array{ 1 2 3 } } [
path 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-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
{ t } [ { t } [
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,34 +103,30 @@ 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
{ t } [ { t } [
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 ] unit-test
] unit-test
{ t } [
{ t } [ path 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 ] with-test-file
] cleanup-unique-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,138 +150,93 @@ 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" "" [ B{ 1 2 3 4 5 } write
binary tell-output 5 assert=
[ 0 seek-absolute seek-output
[ tell-output 0 assert=
B{ 1 2 3 4 5 } write B{ 3 } write
tell-output 5 assert= tell-output 1 assert=
0 seek-absolute seek-output ] with-file-writer path binary file-contents
tell-output 0 assert= ] unit-test
B{ 3 } write ] with-test-file
tell-output 1 assert=
] with-file-writer
] [
file-contents
] 2bi
] cleanup-unique-file
] with-temp-directory
] unit-test
{ B{ 1 2 3 4 3 } } [| path |
[ { B{ 1 2 3 4 3 } } [
[ path binary [
"seek-test2" "" [ B{ 1 2 3 4 5 } write
binary tell-output 5 assert=
[ -1 seek-relative seek-output
[ tell-output 4 assert=
B{ 1 2 3 4 5 } write B{ 3 } write
tell-output 5 assert= tell-output 5 assert=
-1 seek-relative seek-output ] with-file-writer path binary file-contents
tell-output 4 assert= ] unit-test
B{ 3 } write ] with-test-file
tell-output 5 assert=
] with-file-writer
] [
file-contents
] 2bi
] cleanup-unique-file
] with-temp-directory
] unit-test
{ B{ 1 2 3 4 5 0 3 } } [| path |
[ { B{ 1 2 3 4 5 0 3 } } [
[ path binary [
"seek-test3" "" [ B{ 1 2 3 4 5 } write
binary tell-output 5 assert=
[ 1 seek-relative seek-output
[ tell-output 6 assert=
B{ 1 2 3 4 5 } write B{ 3 } write
tell-output 5 assert= tell-output 7 assert=
1 seek-relative seek-output ] with-file-writer path binary file-contents
tell-output 6 assert= ] unit-test
B{ 3 } write ] with-test-file
tell-output 7 assert=
] with-file-writer
] [
file-contents
] 2bi
] cleanup-unique-file
] with-temp-directory
] unit-test
{ 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 tell-input 0 assert=
[ -3 seek-end seek-input
set-file-contents tell-input 2 assert=
] [ 1 read
[ tell-input 3 assert=
tell-input 0 assert= ] with-file-reader
-3 seek-end seek-input ] unit-test
tell-input 2 assert= ] with-test-file
1 read
tell-input 3 assert=
] with-file-reader
] 2bi
] cleanup-unique-file
] with-temp-directory
] unit-test
{ 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=
] [ 3 seek-absolute seek-input
[ tell-input 3 assert=
tell-input 0 assert= -2 seek-relative seek-input
3 seek-absolute seek-input tell-input 1 assert=
tell-input 3 assert= 1 read
-2 seek-relative seek-input tell-input 2 assert=
tell-input 1 assert= ] with-file-reader
1 read ] unit-test
tell-input 2 assert= ] with-test-file
] with-file-reader
] 2bi
] cleanup-unique-file
] with-temp-directory
] unit-test
[ [
[ "does-not-exist" binary [
"seek-test6" "" [ -10 seek-absolute seek-input
binary [ ] with-file-reader
-10 seek-absolute seek-input
] 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" "" [
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 "closing-twice" ascii <file-writer>
] [ "nick cage" = ] must-fail-with [ dispose ] [ dispose ] bi
] with-test-directory
{ f t t } [
[
"resource:core" absolute-path
[ cwd = ] [ cd ] [ cwd = ] tri
] cwd '[ _ dup cd cwd = ] [ ] cleanup
] unit-test

8
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 ] with-test-file
] cleanup-unique-file
] with-temp-directory
! aum's bug ! aum's bug
H{ H{

51
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 | [
[ "omgfail.txt" absolute-path "wb" fopen <c-writer> [
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

39
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
@ -48,11 +46,9 @@ SYMBOLS: supported-layouts supported-formats ;
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? ] with-test-directory ;
] cleanup-unique-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