From 2269b07d3391b5759d09a577cef0485efe7b987f Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 4 Apr 2016 10:32:42 -0700 Subject: [PATCH] use with-temp-file and with-temp-directory in some tests. --- basis/db/sqlite/errors/errors-tests.factor | 35 +- basis/ftp/server/server-tests.factor | 50 +-- basis/globs/globs-tests.factor | 54 ++- basis/io/backend/unix/unix-tests.factor | 195 ++++----- basis/io/directories/directories-tests.factor | 233 +++++----- .../io/directories/search/search-tests.factor | 32 +- basis/io/files/links/unix/unix-tests.factor | 31 +- basis/io/files/unix/unix-tests.factor | 207 +++++---- basis/io/launcher/unix/unix-tests.factor | 131 +++--- basis/io/mmap/mmap-tests.factor | 33 +- basis/io/monitors/linux/linux-tests.factor | 57 ++- basis/io/monitors/monitors-tests.factor | 179 ++++---- basis/io/ports/ports-tests.factor | 41 +- core/io/files/files-tests.factor | 410 +++++++----------- core/io/pathnames/pathnames-tests.factor | 8 +- core/io/streams/c/c-tests.factor | 51 +-- extra/graphviz/graphviz-tests.factor | 39 +- 17 files changed, 786 insertions(+), 1000 deletions(-) diff --git a/basis/db/sqlite/errors/errors-tests.factor b/basis/db/sqlite/errors/errors-tests.factor index aa162774ae..039c428350 100644 --- a/basis/db/sqlite/errors/errors-tests.factor +++ b/basis/db/sqlite/errors/errors-tests.factor @@ -1,28 +1,25 @@ ! 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 | - [ + path [ - [ - "insert into foo (id) values('1');" sql-command - ] [ - { [ sql-table-missing? ] [ table>> "foo" = ] } 1&& - ] must-fail-with + [ + "insert into foo (id) values('1');" sql-command + ] [ + { [ sql-table-missing? ] [ table>> "foo" = ] } 1&& + ] must-fail-with + "create table foo(id);" sql-command + + [ "create table foo(id);" sql-command + ] [ + { [ sql-table-exists? ] [ table>> "foo" = ] } 1&& + ] must-fail-with - [ - "create table foo(id);" sql-command - ] [ - { [ sql-table-exists? ] [ table>> "foo" = ] } 1&& - ] must-fail-with - - ] with-db - ] cleanup-unique-file -] with-temp-directory + ] with-db +] with-test-file diff --git a/basis/ftp/server/server-tests.factor b/basis/ftp/server/server-tests.factor index 7f5148d1e7..b37f31b342 100644 --- a/basis/ftp/server/server-tests.factor +++ b/basis/ftp/server/server-tests.factor @@ -1,39 +1,27 @@ -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 -- ) - [ - '[ - "." 0 [ - "ftp://localhost" >url insecure-addr set-url-addr - "ftp" >>protocol - create-test-file >>path - @ - ] with-threaded-server - ] cleanup-unique-directory - ] with-temp-directory ; inline +: test-ftp-server ( quot: ( server path -- ) -- ) + '[ + "." 0 [ + "ftp://localhost" >url insecure-addr set-url-addr + "ftp" >>protocol + create-test-file >>path + @ + ] with-threaded-server + ] with-test-directory ; inline -{ t } -[ +{ t } [ [ - [ - [ - [ ftp-get ] - [ path>> file-name ascii file-contents ] bi - ] cleanup-unique-directory - ] with-temp-directory + [ ftp-get ] + [ path>> file-name ascii file-contents ] bi ] 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 + [ ftp-get ] + [ path>> file-name ascii file-contents ] bi ] test-ftp-server test-file-contents = ] must-fail diff --git a/basis/globs/globs-tests.factor b/basis/globs/globs-tests.factor index cb45002296..4af63c3d59 100755 --- a/basis/globs/globs-tests.factor +++ b/basis/globs/globs-tests.factor @@ -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 @@ -61,31 +59,29 @@ IN: globs.tests } [ [ - [ - "a" make-directory - "a/b" make-directory - "a/b/c" make-directory - "a/b/c/d" make-directory - "a/b/c/d/e" touch-file - "a/b/c/f" touch-file - "a/b/g" touch-file - "a/b/h" make-directory - "a/b/h/e" touch-file - "a/e" make-directory - "a/e/f" touch-file - "a/e/g" make-directory - "a/e/g/e" touch-file + "a" make-directory + "a/b" make-directory + "a/b/c" make-directory + "a/b/c/d" make-directory + "a/b/c/d/e" touch-file + "a/b/c/f" touch-file + "a/b/g" touch-file + "a/b/h" make-directory + "a/b/h/e" touch-file + "a/e" make-directory + "a/e/f" touch-file + "a/e/g" make-directory + "a/e/g/e" touch-file - "**" glob-directory natural-sort - "**/" glob-directory natural-sort - "**/*" glob-directory natural-sort - "**/**" 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 - "a/**" glob-directory natural-sort - ] cleanup-unique-directory - ] with-temp-directory + "**" glob-directory natural-sort + "**/" glob-directory natural-sort + "**/*" glob-directory natural-sort + "**/**" 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 + "a/**" glob-directory natural-sort + ] with-test-directory ] unit-test diff --git a/basis/io/backend/unix/unix-tests.factor b/basis/io/backend/unix/unix-tests.factor index 0891a659e8..d28aa24d4f 100644 --- a/basis/io/backend/unix/unix-tests.factor +++ b/basis/io/backend/unix/unix-tests.factor @@ -1,130 +1,127 @@ 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" + ascii [ + 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" - ascii [ - accept drop [ - "Hello world" print flush - readln "XYZ" = "FOO" "BAR" ? print flush - ] with-stream - ] with-disposal + "socket-server" ascii [ + readln , + "XYZ" print flush + readln , + ] with-client + ] { } make + ] unit-test - "socket-server" delete-file - ] "Test" spawn drop + ! Unix domain datagram sockets + [ + "datagram-server" "d" [ - yield + "Receive 1" print - { { "Hello world" "FOO" } } [ - [ - "socket-server" ascii [ - readln , - "XYZ" print flush - readln , - ] with-client - ] { } make - ] unit-test + "d" get receive [ reverse ] dip - ! Unix domain datagram sockets - [ - "datagram-server" "d" [ + "Send 1" print + dup . - "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" "d" set ] unit-test - - { } [ - "hello" >byte-array - "datagram-server" "d" get send - ] unit-test - { "olleh" t } [ - "d" get receive - "datagram-server" = - [ >string ] dip - ] unit-test + "Receive 2" print - { } [ - "hello" >byte-array - "datagram-server" - "d" get send - ] unit-test + "d" get receive [ " world" append ] dip - { "hello world" t } [ - "d" get receive - "datagram-server" = - [ >string ] dip - ] unit-test + "Send 1" print + dup . - { } [ "d" get dispose ] unit-test + "d" get send - ! Test error behavior + "d" get dispose - "datagram-client" delete-file + "Done" print - { } [ "datagram-client" "d" set ] unit-test + "datagram-server" delete-file + ] with-variable + ] "Test" spawn drop - [ B{ 1 2 3 } "another-datagram" "d" get send ] must-fail + yield - { } [ "d" get dispose ] unit-test + { } [ "datagram-client" "d" set ] unit-test - ! See what happens on send/receive after close + { } [ + "hello" >byte-array + "datagram-server" + "d" get send + ] unit-test - [ "d" get receive ] must-fail + { "olleh" t } [ + "d" get receive + "datagram-server" = + [ >string ] dip + ] unit-test - [ B{ 1 2 } "datagram-server" "d" get send ] must-fail + { } [ + "hello" >byte-array + "datagram-server" + "d" get send + ] unit-test - ! Invalid parameter tests + { "hello world" t } [ + "d" get receive + "datagram-server" = + [ >string ] dip + ] unit-test - [ - image-path binary [ input-stream get accept ] with-file-reader - ] must-fail + { } [ "d" get dispose ] unit-test - [ - image-path binary [ input-stream get receive ] with-file-reader - ] must-fail + ! Test error behavior - [ - image-path binary [ - B{ 1 2 } "datagram-server" - input-stream get send - ] with-file-reader - ] must-fail + "datagram-client" delete-file - ] cleanup-unique-directory -] with-temp-directory + { } [ "datagram-client" "d" set ] unit-test + + [ B{ 1 2 3 } "another-datagram" "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" "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" + input-stream get send + ] with-file-reader + ] must-fail + +] with-test-directory ! closing stdin caused some problems { } [ diff --git a/basis/io/directories/directories-tests.factor b/basis/io/directories/directories-tests.factor index 9401f37c8f..6176629b58 100644 --- a/basis/io/directories/directories-tests.factor +++ b/basis/io/directories/directories-tests.factor @@ -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,181 +20,144 @@ 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 - ] unit-test + { } [ + { "Hello world." } + "test-foo.txt" ascii set-file-lines + ] unit-test - { } [ - "test-foo.txt" ascii [ - "Hello appender." print - ] with-file-appender - ] unit-test + { } [ + "test-foo.txt" ascii [ + "Hello appender." print + ] with-file-appender + ] unit-test - { } [ - "test-bar.txt" ascii [ - "Hello appender." print - ] with-file-appender - ] unit-test + { } [ + "test-bar.txt" ascii [ + "Hello appender." print + ] with-file-appender + ] unit-test - { "Hello world.\nHello appender.\n" } [ - "test-foo.txt" ascii file-contents - ] unit-test + { "Hello world.\nHello appender.\n" } [ + "test-foo.txt" ascii file-contents + ] unit-test - { "Hello appender.\n" } [ - "test-bar.txt" ascii file-contents - ] unit-test + { "Hello appender.\n" } [ + "test-bar.txt" ascii file-contents + ] unit-test - { } [ "test-foo.txt" delete-file ] unit-test - { } [ "test-bar.txt" delete-file ] unit-test + { } [ "test-foo.txt" delete-file ] unit-test + { } [ "test-bar.txt" delete-file ] unit-test - { f } [ "test-foo.txt" exists? ] unit-test - { f } [ "test-bar.txt" exists? ] unit-test - ] cleanup-unique-directory -] with-temp-directory + { f } [ "test-foo.txt" exists? ] unit-test + { f } [ "test-bar.txt" exists? ] unit-test -[ - [ - { } [ "test-blah" make-directory ] unit-test + { } [ "test-blah" make-directory ] unit-test - { } [ - "test-blah/fooz" ascii dispose - ] unit-test + { } [ + "test-blah/fooz" ascii dispose + ] unit-test - { t } [ - "test-blah/fooz" exists? - ] unit-test + { t } [ + "test-blah/fooz" exists? + ] unit-test - { } [ "test-blah/fooz" delete-file ] unit-test - { } [ "test-blah" delete-directory ] unit-test + { } [ "test-blah/fooz" delete-file ] unit-test + { } [ "test-blah" delete-directory ] unit-test - { f } [ "test-blah" exists? ] unit-test - ] cleanup-unique-directory -] with-temp-directory + { f } [ "test-blah" exists? ] unit-test -[ - [ - { } [ "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 - ] unit-test + { } [ + { "Hi" } "delete-tree-test/a/b/c/d" ascii set-file-lines + ] unit-test - { } [ "delete-tree-test" delete-tree ] unit-test - ] cleanup-unique-directory -] with-temp-directory + { } [ "delete-tree-test" delete-tree ] unit-test -[ - [ - { } [ - "copy-tree-test/a/b/c" make-directories - ] unit-test + { } [ + "copy-tree-test/a/b/c" make-directories + ] unit-test - { } [ - "Foobar" - "copy-tree-test/a/b/c/d" - ascii set-file-contents - ] unit-test + { } [ + "Foobar" + "copy-tree-test/a/b/c/d" + ascii set-file-contents + ] unit-test - { } [ - "copy-tree-test" "copy-destination" copy-tree - ] unit-test + { } [ + "copy-tree-test" "copy-destination" copy-tree + ] unit-test - { "Foobar" } [ - "copy-destination/a/b/c/d" ascii file-contents - ] unit-test + { "Foobar" } [ + "copy-destination/a/b/c/d" ascii file-contents + ] unit-test - { } [ - "copy-destination" delete-tree - ] unit-test + { } [ + "copy-destination" delete-tree + ] unit-test - { } [ - "copy-tree-test" "copy-destination" copy-tree-into - ] unit-test + { } [ + "copy-tree-test" "copy-destination" copy-tree-into + ] unit-test - { "Foobar" } [ - "copy-destination/copy-tree-test/a/b/c/d" ascii file-contents - ] unit-test + { "Foobar" } [ + "copy-destination/copy-tree-test/a/b/c/d" ascii file-contents + ] unit-test - { } [ - "copy-destination/copy-tree-test/a/b/c/d" "." copy-file-into - ] unit-test + { } [ + "copy-destination/copy-tree-test/a/b/c/d" "." copy-file-into + ] unit-test - { "Foobar" } [ - "d" ascii file-contents - ] unit-test + { "Foobar" } [ + "d" ascii file-contents + ] 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 - ] cleanup-unique-directory -] with-temp-directory + { } [ "copy-tree-test" delete-tree ] unit-test -{ } [ "resource:deleteme" touch-file ] unit-test -{ } [ "resource:deleteme" delete-file ] unit-test + ! Issue #890 + { } [ + "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 diff --git a/basis/io/directories/search/search-tests.factor b/basis/io/directories/search/search-tests.factor index 15e501da5b..bab1f15a2d 100644 --- a/basis/io/directories/search/search-tests.factor +++ b/basis/io/directories/search/search-tests.factor @@ -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 + 10 [ "io.paths.test" "gogogo" unique-file ] replicate + "." [ ] find-all-files [ natural-sort ] same? + ] with-test-directory ] unit-test { f } [ @@ -25,22 +21,20 @@ IN: io.directories.search.tests { t } [ [ - [ - "the-head" "" unique-file drop - "." t [ file-name "the-head" head? ] find-file string? - ] cleanup-unique-directory - ] with-temp-directory + "the-head" "" unique-file drop + "." t [ file-name "the-head" head? ] find-file string? + ] 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 } [ diff --git a/basis/io/files/links/unix/unix-tests.factor b/basis/io/files/links/unix/unix-tests.factor index 1222ed73ae..a0034c9cab 100644 --- a/basis/io/files/links/unix/unix-tests.factor +++ b/basis/io/files/links/unix/unix-tests.factor @@ -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 -- ) @@ -9,30 +8,24 @@ IN: io.files.links.unix.tests { t } [ [ - [ - 5 "lol" make-test-links - "lol1" follow-links - "lol5" absolute-path = - ] cleanup-unique-directory - ] with-temp-directory + 5 "lol" make-test-links + "lol1" follow-links + "lol5" absolute-path = + ] with-test-directory ] unit-test [ [ - [ - 100 "laf" make-test-links "laf1" follow-links - ] with-unique-directory - ] with-temp-directory + 100 "laf" make-test-links "laf1" follow-links + ] 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 + 100 "laf" make-test-links + "laf1" follow-links + "laf100" absolute-path = + ] with-test-directory ] with-variable ] unit-test diff --git a/basis/io/files/unix/unix-tests.factor b/basis/io/files/unix/unix-tests.factor index 870c0c971c..61baca677c 100644 --- a/basis/io/files/unix/unix-tests.factor +++ b/basis/io/files/unix/unix-tests.factor @@ -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,142 +30,140 @@ 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 - path file-permissions 0o7777 mask - ] unit-test + { 0o777 } [ + path flags{ USER-ALL GROUP-ALL OTHER-ALL } set-file-permissions + path file-permissions 0o7777 mask + ] unit-test - { t } [ path user-read? ] unit-test - { t } [ path user-write? ] unit-test - { t } [ path user-execute? ] unit-test - { t } [ path group-read? ] unit-test - { t } [ path group-write? ] unit-test - { t } [ path group-execute? ] unit-test - { t } [ path other-read? ] unit-test - { t } [ path other-write? ] unit-test - { t } [ path other-execute? ] unit-test + { t } [ path user-read? ] unit-test + { t } [ path user-write? ] unit-test + { t } [ path user-execute? ] unit-test + { t } [ path group-read? ] unit-test + { t } [ path group-write? ] unit-test + { t } [ path group-execute? ] unit-test + { t } [ path other-read? ] unit-test + { t } [ path other-write? ] unit-test + { t } [ path other-execute? ] unit-test - { 0o776 } [ - path f set-other-execute - path file-permissions 0o7777 mask - ] unit-test + { 0o776 } [ + path f set-other-execute + path file-permissions 0o7777 mask + ] unit-test - { f } [ path file-info other-execute? ] unit-test + { f } [ path file-info other-execute? ] unit-test - { 0o774 } [ - path f set-other-write - path file-permissions 0o7777 mask - ] unit-test + { 0o774 } [ + path f set-other-write + path file-permissions 0o7777 mask + ] unit-test - { f } [ path file-info other-write? ] unit-test + { f } [ path file-info other-write? ] unit-test - { 0o770 } [ - path f set-other-read - path file-permissions 0o7777 mask - ] unit-test + { 0o770 } [ + path f set-other-read + path file-permissions 0o7777 mask + ] unit-test - { f } [ path file-info other-read? ] unit-test + { f } [ path file-info other-read? ] unit-test - { 0o760 } [ - path f set-group-execute - path file-permissions 0o7777 mask - ] unit-test + { 0o760 } [ + path f set-group-execute + path file-permissions 0o7777 mask + ] unit-test - { f } [ path file-info group-execute? ] unit-test + { f } [ path file-info group-execute? ] unit-test - { 0o740 } [ - path f set-group-write - path file-permissions 0o7777 mask - ] unit-test + { 0o740 } [ + path f set-group-write + path file-permissions 0o7777 mask + ] unit-test - { f } [ path file-info group-write? ] unit-test + { f } [ path file-info group-write? ] unit-test - { 0o700 } [ - path f set-group-read - path file-permissions 0o7777 mask - ] unit-test + { 0o700 } [ + path f set-group-read + path file-permissions 0o7777 mask + ] unit-test - { f } [ path file-info group-read? ] unit-test + { f } [ path file-info group-read? ] unit-test - { 0o600 } [ - path f set-user-execute - path file-permissions 0o7777 mask - ] unit-test + { 0o600 } [ + path f set-user-execute + path file-permissions 0o7777 mask + ] unit-test - { f } [ path file-info other-execute? ] unit-test + { f } [ path file-info other-execute? ] unit-test - { 0o400 } [ - path f set-user-write - path file-permissions 0o7777 mask - ] unit-test + { 0o400 } [ + path f set-user-write + path file-permissions 0o7777 mask + ] unit-test - { f } [ path file-info other-write? ] unit-test + { f } [ path file-info other-write? ] unit-test - { 0o000 } [ - path f set-user-read - path file-permissions 0o7777 mask - ] unit-test + { 0o000 } [ + path f set-user-read + path file-permissions 0o7777 mask + ] unit-test - { f } [ path file-info other-read? ] unit-test + { f } [ path file-info other-read? ] unit-test - { 0o771 } [ - path flags{ USER-ALL GROUP-ALL OTHER-EXECUTE } set-file-permissions - path file-permissions 0o7777 mask - ] unit-test + { 0o771 } [ + path flags{ USER-ALL GROUP-ALL OTHER-EXECUTE } set-file-permissions + path file-permissions 0o7777 mask + ] unit-test - ] cleanup-unique-file +] with-test-file - "permissions-2" ".txt" [| path | +[| path | - { t } [ - path now - [ set-file-access-time ] 2keep - [ file-info accessed>> ] - [ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* = - ] unit-test + { t } [ + path now + [ set-file-access-time ] 2keep + [ file-info accessed>> ] + [ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* = + ] unit-test - { t } - [ - path now - [ set-file-modified-time ] 2keep - [ file-info modified>> ] - [ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* = - ] unit-test + { t } + [ + path now + [ set-file-modified-time ] 2keep + [ file-info modified>> ] + [ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* = + ] unit-test - { t } - [ - path now [ dup 2array set-file-times ] 2keep - [ file-info [ modified>> ] [ accessed>> ] bi ] dip - 3array - [ [ truncate >integer ] change-second >gmt ] map all-equal? - ] unit-test + { t } + [ + path now [ dup 2array set-file-times ] 2keep + [ file-info [ modified>> ] [ accessed>> ] bi ] dip + 3array + [ [ truncate >integer ] change-second >gmt ] map all-equal? + ] unit-test - { } [ path f now 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 now 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 real-user-name 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-id set-file-group ] unit-test + { } [ path real-user-name 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-id set-file-group ] 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-user-name real-user-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-temp-directory +] with-test-file { t } [ 0o4000 uid? ] unit-test { t } [ 0o2000 gid? ] unit-test diff --git a/basis/io/launcher/unix/unix-tests.factor b/basis/io/launcher/unix/unix-tests.factor index fcc2c40640..a07b60b918 100644 --- a/basis/io/launcher/unix/unix-tests.factor +++ b/basis/io/launcher/unix/unix-tests.factor @@ -1,88 +1,85 @@ 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 + { } [ { "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 - ] unit-test + { } [ + [ "launcher-test-1" delete-file ] ignore-errors + ] unit-test - { } [ - - "echo Hello" >>command - "launcher-test-1" >>stdout - try-process - ] unit-test + { } [ + + "echo Hello" >>command + "launcher-test-1" >>stdout + try-process + ] unit-test - { "Hello\n" } [ - { "cat" "launcher-test-1" } - ascii stream-contents - ] unit-test + { "Hello\n" } [ + { "cat" "launcher-test-1" } + ascii stream-contents + ] unit-test - { } [ - [ "launcher-test-1" delete-file ] ignore-errors - ] unit-test + { } [ + [ "launcher-test-1" delete-file ] ignore-errors + ] unit-test - { } [ - - "cat" >>command - +closed+ >>stdin - "launcher-test-1" >>stdout - try-process - ] unit-test + { } [ + + "cat" >>command + +closed+ >>stdin + "launcher-test-1" >>stdout + try-process + ] unit-test - { "" } [ - { "cat" "launcher-test-1" } - ascii stream-contents - ] unit-test + { "" } [ + { "cat" "launcher-test-1" } + ascii stream-contents + ] unit-test - { } [ - 2 [ - "launcher-test-1" binary [ - - swap >>stdout - "echo Hello" >>command - try-process - ] with-disposal - ] times - ] unit-test - - { "Hello\nHello\n" } [ - { "cat" "launcher-test-1" } - ascii stream-contents - ] unit-test - - { "hi\n" } [ - - { "echo" "hi" } >>command - "launcher-test-2" >>stdout - try-process - "launcher-test-2" utf8 file-contents - ] unit-test - - { "hi\nhi\n" } [ - 2 [ + { } [ + 2 [ + "launcher-test-1" binary [ - "echo hi" >>command - "launcher-test-3" >>stdout + swap >>stdout + "echo Hello" >>command try-process - ] times - "launcher-test-3" utf8 file-contents - ] unit-test + ] with-disposal + ] times + ] unit-test - ] cleanup-unique-directory -] with-temp-directory + { "Hello\nHello\n" } [ + { "cat" "launcher-test-1" } + ascii stream-contents + ] unit-test + + { "hi\n" } [ + + { "echo" "hi" } >>command + "launcher-test-2" >>stdout + try-process + "launcher-test-2" utf8 file-contents + ] unit-test + + { "hi\nhi\n" } [ + 2 [ + + "echo hi" >>command + "launcher-test-3" >>stdout + try-process + ] times + "launcher-test-3" utf8 file-contents + ] unit-test + +] with-test-directory { t } [ diff --git a/basis/io/mmap/mmap-tests.factor b/basis/io/mmap/mmap-tests.factor index ef92d0271b..28cbb547ed 100644 --- a/basis/io/mmap/mmap-tests.factor +++ b/basis/io/mmap/mmap-tests.factor @@ -1,26 +1,23 @@ 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 | - "12345" path ascii set-file-contents - { } [ path [ char CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test - { 5 } [ path [ char length ] with-mapped-file ] unit-test - { 5 } [ path [ char length ] with-mapped-file-reader ] 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-reader integer? ] unit-test - ] cleanup-unique-file +[| path | + "12345" path ascii set-file-contents + { } [ path [ char CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test + { 5 } [ path [ char length ] with-mapped-file ] unit-test + { 5 } [ path [ char length ] with-mapped-file-reader ] 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-reader integer? ] unit-test +] with-test-file - "mmap-empty-file" ".txt" [| path | - [ path [ drop ] with-mapped-file ] [ bad-mmap-size? ] must-fail-with - ] cleanup-unique-file -] with-temp-directory +[| path | + [ path [ drop ] with-mapped-file ] [ bad-mmap-size? ] must-fail-with +] with-test-file { t } [ [ "test.txt" void* first-unsafe ] diff --git a/basis/io/monitors/linux/linux-tests.factor b/basis/io/monitors/linux/linux-tests.factor index 3dc07f62ce..8abf5e5eb1 100644 --- a/basis/io/monitors/linux/linux-tests.factor +++ b/basis/io/monitors/linux/linux-tests.factor @@ -1,41 +1,36 @@ -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 - { } [ - "." f "m" set - 3 seconds "m" get set-timeout - "." touch-file - ] unit-test + ! Non-recursive + { } [ + "." f "m" set + 3 seconds "m" get set-timeout + "." touch-file + ] unit-test - { t } [ - "m" get next-change path>> - [ "" = ] [ "." absolute-path = ] bi or - ] unit-test + { t } [ + "m" get next-change path>> + [ "" = ] [ "." absolute-path = ] bi or + ] unit-test - { } [ "m" get dispose ] unit-test + { } [ "m" get dispose ] unit-test - ! Recursive - { } [ - "." t "m" set - 3 seconds "m" get set-timeout - "." touch-file - ] unit-test + ! Recursive + { } [ + "." t "m" set + 3 seconds "m" get set-timeout + "." touch-file + ] unit-test - { t } [ - "m" get next-change path>> - [ "" = ] [ "." absolute-path = ] bi or - ] unit-test + { t } [ + "m" get next-change path>> + [ "" = ] [ "." absolute-path = ] bi or + ] unit-test - { } [ "m" get dispose ] unit-test - ] with-monitors - ] cleanup-unique-directory -] with-temp-directory + { } [ "m" get dispose ] unit-test + ] with-monitors +] with-test-directory diff --git a/basis/io/monitors/monitors-tests.factor b/basis/io/monitors/monitors-tests.factor index cbaa36911a..ec250293cb 100644 --- a/basis/io/monitors/monitors-tests.factor +++ b/basis/io/monitors/monitors-tests.factor @@ -1,80 +1,75 @@ 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 "m" set ] unit-test + { } [ "." t "m" set ] unit-test - { } [ "a1" make-directory ] unit-test - { } [ "a2" make-directory ] unit-test - { } [ "a1" "a2" move-file-into ] unit-test + { } [ "a1" make-directory ] unit-test + { } [ "a2" make-directory ] 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/a5.txt" touch-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/a4.txt" touch-file ] unit-test + { } [ "a2/a1/a5.txt" touch-file ] unit-test + { } [ "a2/a1/a4.txt" delete-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 - ] with-monitors - ] cleanup-unique-directory -] with-temp-directory + { } [ "m" get dispose ] unit-test + ] with-monitors +] with-test-directory [ [ - [ - { } [ "xyz" make-directory ] unit-test - { } [ "." t "m" set ] unit-test + { } [ "xyz" make-directory ] unit-test + { } [ "." t "m" set ] unit-test - { } [ 1 "b" set ] unit-test - { } [ 1 "c1" set ] unit-test - { } [ 1 "c2" set ] unit-test + { } [ 1 "b" set ] unit-test + { } [ 1 "c1" set ] unit-test + { } [ 1 "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 - [ - "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 + dup parent-directory + [ trim-tail-separators "yxy" tail? ] either? not + ] loop - "c1" get count-down - [ - "m" get next-change path>> - dup print flush - dup parent-directory - [ trim-tail-separators "yxy" tail? ] either? not - ] loop + "c2" get count-down + ] "Monitor test thread" spawn drop - "c2" get count-down - ] "Monitor test thread" spawn drop + { } [ "b" get await ] unit-test + { } [ "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 - { } [ "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 - - ! Dispose twice - { } [ "m" get dispose ] unit-test - { } [ "m" get dispose ] unit-test - ] with-monitors - ] cleanup-unique-directory -] with-temp-directory + ! Dispose twice + { } [ "m" get dispose ] unit-test + { } [ "m" get dispose ] unit-test + ] with-monitors +] with-test-directory ! Out-of-scope disposal should not fail { } [ [ "resource:" f ] with-monitors dispose ] unit-test @@ -83,51 +78,47 @@ IN: io.monitors.tests ! Timeouts [ [ - [ - ! Non-recursive - { } [ - "." f "m" set - 100 milliseconds "m" get set-timeout - [ [ t ] [ "m" get next-change drop ] while ] must-fail - "m" get dispose - ] unit-test + ! Non-recursive + { } [ + "." f "m" set + 100 milliseconds "m" get set-timeout + [ [ t ] [ "m" get next-change drop ] while ] must-fail + "m" get dispose + ] unit-test - ! Recursive - { } [ - "." t "m" set - 100 milliseconds "m" get set-timeout - [ [ t ] [ "m" get next-change drop ] while ] must-fail - "m" get dispose - ] unit-test - ] with-monitors - ] cleanup-unique-directory -] with-temp-directory + ! Recursive + { } [ + "." t "m" set + 100 milliseconds "m" get set-timeout + [ [ t ] [ "m" get next-change drop ] while ] must-fail + "m" get dispose + ] unit-test + ] with-monitors +] with-test-directory ! Disposing a monitor should throw an error in any threads ! waiting on notifications [ [ + { } [ + "p" set + "." t "m" set + 10 seconds "m" get set-timeout + ] unit-test + [ - { } [ - "p" set - "." t "m" set - 10 seconds "m" get set-timeout - ] unit-test + [ "m" get next-change ] [ ] recover + "p" get fulfill + ] in-thread - [ - [ "m" get next-change ] [ ] recover - "p" get fulfill - ] in-thread + { } [ + 100 milliseconds sleep + "m" get dispose + ] unit-test - { } [ - 100 milliseconds sleep - "m" get dispose - ] unit-test - - { t } [ - "p" get 10 seconds ?promise-timeout - already-disposed? - ] unit-test - ] with-monitors - ] cleanup-unique-directory -] with-temp-directory + { t } [ + "p" get 10 seconds ?promise-timeout + already-disposed? + ] unit-test + ] with-monitors +] with-test-directory diff --git a/basis/io/ports/ports-tests.factor b/basis/io/ports/ports-tests.factor index 450a36af4e..d30bdaa6eb 100644 --- a/basis/io/ports/ports-tests.factor +++ b/basis/io/ports/ports-tests.factor @@ -1,33 +1,30 @@ 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 [ - [ - 100,000 iota - 0 - 100,000 int malloc-array &free [ copy ] keep write - ] with-destructors - ] with-file-writer - ] unit-test + { } [ + path binary [ + [ + 100,000 iota + 0 + 100,000 int malloc-array &free [ copy ] keep write + ] with-destructors + ] with-file-writer + ] unit-test - { t } [ - path binary [ - 100,000 4 * read int cast-array 100,000 iota sequence= - ] with-file-reader - ] unit-test - ] cleanup-unique-file -] with-temp-directory + { t } [ + path binary [ + 100,000 4 * read int cast-array 100,000 iota sequence= + ] with-file-reader + ] unit-test + +] with-test-file ! Getting the stream-element-type of an output-port was broken { +byte+ } [ binary [ stream-element-type ] with-disposal ] unit-test diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index c4e14b4cf5..dc0fca30de 100644 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -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 dispose - ] cleanup-unique-file - ] with-temp-directory + [ ascii dispose ] with-test-file ] unit-test { @@ -46,30 +41,28 @@ SPECIALIZED-ARRAY: int [ " " read-until [ ascii decode ] dip ] with-file-reader ] unit-test -[ - "separator-test" ".txt" [| path | - { } [ - "It seems Jobs has lost his grasp on reality again.\n" - path latin1 set-file-contents - ] unit-test +[| path | + { } [ + "It seems Jobs has lost his grasp on reality again.\n" + path latin1 set-file-contents + ] unit-test + { { - { - { "It seems " CHAR: J } - { "obs has lost h" CHAR: i } - { "s grasp on reality again.\n" f } - } - } [ - [ - path latin1 [ - "J" read-until 2array , - "i" read-until 2array , - "X" read-until 2array , - ] with-file-reader - ] { } make - ] unit-test - ] cleanup-unique-file -] with-temp-directory + { "It seems " CHAR: J } + { "obs has lost h" CHAR: i } + { "s grasp on reality again.\n" f } + } + } [ + [ + path latin1 [ + "J" read-until 2array , + "i" read-until 2array , + "X" read-until 2array , + ] with-file-reader + ] { } make + ] unit-test +] with-test-file { } [ image-path binary [ @@ -78,35 +71,31 @@ SPECIALIZED-ARRAY: int ] unit-test ! Writing specialized arrays to binary streams should work -[ - "binary-int-array" ".bin" [| path | - { } [ - path binary [ - int-array{ 1 2 3 } write - ] with-file-writer - ] unit-test +[| path | + { } [ + path binary [ + int-array{ 1 2 3 } write + ] with-file-writer + ] unit-test - { int-array{ 1 2 3 } } [ - path binary [ - 3 4 * read - ] with-file-reader - int cast-array - ] unit-test - ] cleanup-unique-file -] with-temp-directory + { int-array{ 1 2 3 } } [ + path binary [ + 3 4 * read + ] with-file-reader + int cast-array + ] unit-test +] with-test-file -[ - "test-012" ".bin" [| path | - { } [ - BV{ 0 1 2 } path binary set-file-contents - ] unit-test +[| path | + { } [ + BV{ 0 1 2 } path binary set-file-contents + ] unit-test - { t } [ - path binary file-contents - B{ 0 1 2 } = - ] unit-test - ] cleanup-unique-file -] with-temp-directory + { t } [ + path binary file-contents + B{ 0 1 2 } = + ] unit-test +] with-test-file STRUCT: pt { x uint } { y uint } ; SPECIALIZED-ARRAY: pt @@ -114,34 +103,30 @@ 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 | - { } [ - pt-array-1 path binary set-file-contents - ] unit-test +[| path | + { } [ + pt-array-1 path binary set-file-contents + ] unit-test - { t } [ - path binary file-contents - pt-array-1 >c-ptr sequence= - ] unit-test - ] cleanup-unique-file -] with-temp-directory + { t } [ + path binary file-contents + pt-array-1 >c-ptr sequence= + ] unit-test +] with-test-file ! Slices should support >c-ptr and byte-length -[ - "test-pt-array-1-slice" ".bin" [| path | - { } [ - pt-array-1 rest-slice - path binary set-file-contents - ] unit-test - - { t } [ - path binary file-contents - pt cast-array - pt-array-1 rest-slice sequence= - ] unit-test - ] cleanup-unique-file -] with-temp-directory +[| path | + { } [ + pt-array-1 rest-slice + path binary set-file-contents + ] unit-test + + { t } [ + path binary file-contents + pt cast-array + pt-array-1 rest-slice sequence= + ] unit-test +] 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,138 +150,93 @@ 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 - [ - [ - 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 +[| 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 path binary file-contents + ] unit-test +] with-test-file -{ B{ 1 2 3 4 3 } } -[ - [ - "seek-test2" "" [ - 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 +[| 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 path binary file-contents + ] unit-test +] with-test-file -{ B{ 1 2 3 4 5 0 3 } } -[ - [ - "seek-test3" "" [ - 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 +[| 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 path binary file-contents + ] unit-test +] with-test-file -{ B{ 3 } } -[ - [ - "seek-test4" "" [ - B{ 1 2 3 4 5 } swap binary - [ - set-file-contents - ] [ - [ - 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 +[| 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 + ] unit-test +] with-test-file -{ B{ 2 } } -[ - [ - "seek-test5" "" [ - B{ 1 2 3 4 5 } swap binary [ - set-file-contents - ] [ - [ - tell-input 0 assert= - 3 seek-absolute seek-input - tell-input 3 assert= - -2 seek-relative seek-input - tell-input 1 assert= - 1 read - tell-input 2 assert= - ] with-file-reader - ] 2bi - ] cleanup-unique-file - ] with-temp-directory -] unit-test +[| 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= + -2 seek-relative seek-input + tell-input 1 assert= + 1 read + tell-input 2 assert= + ] with-file-reader + ] unit-test +] with-test-file [ - [ - "seek-test6" "" [ - binary [ - -10 seek-absolute seek-input - ] with-file-reader - ] cleanup-unique-file - ] with-temp-directory + "does-not-exist" binary [ + -10 seek-absolute seek-input + ] with-file-reader ] 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 - [ 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 + [ dispose ] [ dispose ] bi +] with-test-directory + +{ f t t } [ + [ + "resource:core" absolute-path + [ cwd = ] [ cd ] [ cwd = ] tri + ] cwd '[ _ dup cd cwd = ] [ ] cleanup +] unit-test diff --git a/core/io/pathnames/pathnames-tests.factor b/core/io/pathnames/pathnames-tests.factor index 0cf298b8a0..a7f8c7df23 100644 --- a/core/io/pathnames/pathnames-tests.factor +++ b/core/io/pathnames/pathnames-tests.factor @@ -52,11 +52,9 @@ system tools.test ; { t } [ "resource:core" absolute-path? ] unit-test { f } [ "" absolute-path? ] unit-test -[ - "touch-twice-test" ".txt" [| path | - { } [ 2 [ path touch-file ] times ] unit-test - ] cleanup-unique-file -] with-temp-directory +[| path | + { } [ 2 [ path touch-file ] times ] unit-test +] with-test-file ! aum's bug H{ diff --git a/core/io/streams/c/c-tests.factor b/core/io/streams/c/c-tests.factor index a8609d9f76..2c69f6b194 100644 --- a/core/io/streams/c/c-tests.factor +++ b/core/io/streams/c/c-tests.factor @@ -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 | - { "hello world" } [ - "hello world" path ascii set-file-contents - - path "rb" fopen stream-contents >string - ] unit-test - ] cleanup-unique-file + ! Writing strings to ascii streams + { "hello world" } [ + "hello-world.txt" absolute-path + [ "hello world" swap ascii set-file-contents ] + [ "rb" fopen stream-contents >string ] bi + ] unit-test ! Writing specialized arrays to binary streams - "io-streams-c-tests-int" ".txt" [| path | - { } [ - path "wb" fopen [ + { int-array{ 1 2 3 } } [ + "c-tests-int.dat" absolute-path [ + "wb" fopen [ int-array{ 1 2 3 } write ] with-output-stream - ] unit-test - - { int-array{ 1 2 3 } } [ - path "rb" fopen [ - 3 4 * read + ] [ + "rb" fopen [ + 3 4 * read int cast-array ] with-input-stream - int cast-array - ] unit-test - ] cleanup-unique-file + ] bi + ] unit-test ! Writing strings to binary streams should fail - "test-omgfail" ".txt" [| path | - [ - path "wb" fopen [ - "OMGFAIL" write - ] with-output-stream - ] must-fail - ] cleanup-unique-file + [ + "omgfail.txt" absolute-path "wb" fopen [ + "OMGFAIL" write + ] with-output-stream + ] must-fail -] with-temp-directory +] with-test-directory diff --git a/extra/graphviz/graphviz-tests.factor b/extra/graphviz/graphviz-tests.factor index 9b72fff581..18bb1f045c 100644 --- a/extra/graphviz/graphviz-tests.factor +++ b/extra/graphviz/graphviz-tests.factor @@ -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 @@ -48,11 +46,9 @@ SYMBOLS: supported-layouts supported-formats ; 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 ; + graph "smoke-test" -T -K graphviz + "smoke-test" graphviz-output-appears-to-exist? + ] 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