! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators.short-circuit db db.errors
-db.sqlite db.sqlite.errors io.files.temp io.files.unique kernel
-namespaces tools.test ;
+db.sqlite kernel locals tools.test ;
-[
- "sqlite" "error-test" [
+[| path |
- <sqlite-db> [
+ path <sqlite-db> [
- [
- "insert into foo (id) values('1');" sql-command
- ] [
- { [ 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
- [
- "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
-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-server> [
- "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-server> [
+ "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
[
"/" >>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
-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
} [
[
- [
- "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
USING: byte-arrays destructors io io.directories
-io.encodings.ascii io.encodings.binary io.files io.files.temp
-io.files.unique io.launcher io.sockets io.streams.duplex kernel
-make namespaces prettyprint sequences strings system threads
-tools.test ;
+io.encodings.ascii io.encodings.binary io.files io.launcher
+io.sockets io.streams.duplex kernel make namespaces prettyprint
+sequences strings system threads tools.test ;
[
[
+ "socket-server" <local>
+ ascii <server> [
+ 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>
- 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> ascii [
- readln ,
- "XYZ" print flush
- readln ,
- ] with-client
- ] { } make
- ] unit-test
-
- ! Unix domain datagram sockets
- [
- "datagram-server" <local> <datagram> "d" [
+ "socket-server" <local> ascii [
+ readln ,
+ "XYZ" print flush
+ readln ,
+ ] with-client
+ ] { } make
+ ] unit-test
+
+ ! Unix domain datagram sockets
+ [
+ "datagram-server" <local> <datagram> "d" [
- "Receive 1" print
+ "Receive 1" print
- "d" get receive [ reverse ] dip
+ "d" get receive [ reverse ] dip
- "Send 1" print
- dup .
+ "Send 1" print
+ dup .
- "d" get send
+ "d" get send
- "Receive 2" print
+ "Receive 2" print
- "d" get receive [ " world" append ] dip
+ "d" get receive [ " world" append ] dip
- "Send 1" print
- dup .
+ "Send 1" print
+ dup .
- "d" get send
+ "d" get send
- "d" get dispose
+ "d" get dispose
- "Done" print
+ "Done" print
- "datagram-server" delete-file
- ] with-variable
- ] "Test" spawn drop
+ "datagram-server" delete-file
+ ] with-variable
+ ] "Test" spawn drop
- yield
+ yield
- { } [ "datagram-client" <local> <datagram> "d" set ] unit-test
+ { } [ "datagram-client" <local> <datagram> "d" set ] unit-test
- { } [
- "hello" >byte-array
- "datagram-server" <local>
- "d" get send
- ] unit-test
+ { } [
+ "hello" >byte-array
+ "datagram-server" <local>
+ "d" get send
+ ] unit-test
- { "olleh" t } [
- "d" get receive
- "datagram-server" <local> =
- [ >string ] dip
- ] unit-test
+ { "olleh" t } [
+ "d" get receive
+ "datagram-server" <local> =
+ [ >string ] dip
+ ] unit-test
- { } [
- "hello" >byte-array
- "datagram-server" <local>
- "d" get send
- ] unit-test
+ { } [
+ "hello" >byte-array
+ "datagram-server" <local>
+ "d" get send
+ ] unit-test
- { "hello world" t } [
- "d" get receive
- "datagram-server" <local> =
- [ >string ] dip
- ] unit-test
+ { "hello world" t } [
+ "d" get receive
+ "datagram-server" <local> =
+ [ >string ] dip
+ ] unit-test
- { } [ "d" get dispose ] unit-test
+ { } [ "d" get dispose ] unit-test
- ! Test error behavior
+ ! Test error behavior
- "datagram-client" delete-file
+ "datagram-client" delete-file
- { } [ "datagram-client" <local> <datagram> "d" set ] unit-test
+ { } [ "datagram-client" <local> <datagram> "d" set ] unit-test
- [ B{ 1 2 3 } "another-datagram" <local> "d" get send ] must-fail
+ [ B{ 1 2 3 } "another-datagram" <local> "d" get send ] must-fail
- { } [ "d" get dispose ] unit-test
+ { } [ "d" get dispose ] unit-test
- ! See what happens on send/receive after close
+ ! See what happens on send/receive after close
- [ "d" get receive ] must-fail
+ [ "d" get receive ] must-fail
- [ B{ 1 2 } "datagram-server" <local> "d" get send ] must-fail
+ [ B{ 1 2 } "datagram-server" <local> "d" get send ] must-fail
- ! Invalid parameter tests
+ ! Invalid parameter tests
- [
- image-path binary [ input-stream get accept ] with-file-reader
- ] must-fail
+ [
+ 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 [ 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
-
- ] cleanup-unique-directory
-] with-temp-directory
+ [
+ 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
{ } [
-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 [
] 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 } [
- [
- [ "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" } [
- [
+[
+ { t t f } [
+ "blahblah" make-directory
+ "blahblah" exists?
+ "blahblah" file-info directory?
+ "blahblah" delete-directory
+ "blahblah" exists?
+ ] unit-test
+
+ { "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
-
- { } [
- "test-foo.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 appender.\n" } [
- "test-bar.txt" ascii file-contents
- ] 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
+ { } [
+ { "Hello world." }
+ "test-foo.txt" ascii set-file-lines
+ ] unit-test
-[
- [
- { } [ "test-blah" make-directory ] unit-test
+ { } [
+ "test-foo.txt" ascii [
+ "Hello appender." print
+ ] with-file-appender
+ ] unit-test
- { } [
- "test-blah/fooz" ascii <file-writer> dispose
- ] unit-test
+ { } [
+ "test-bar.txt" ascii [
+ "Hello appender." print
+ ] with-file-appender
+ ] unit-test
- { t } [
- "test-blah/fooz" exists?
- ] unit-test
+ { "Hello world.\nHello appender.\n" } [
+ "test-foo.txt" ascii file-contents
+ ] unit-test
- { } [ "test-blah/fooz" delete-file ] unit-test
- { } [ "test-blah" delete-directory ] unit-test
+ { "Hello appender.\n" } [
+ "test-bar.txt" ascii file-contents
+ ] unit-test
- { f } [ "test-blah" exists? ] unit-test
- ] cleanup-unique-directory
-] with-temp-directory
+ { } [ "test-foo.txt" delete-file ] unit-test
+ { } [ "test-bar.txt" delete-file ] unit-test
-[
- [
- { } [ "delete-tree-test/a/b/c" make-directories ] unit-test
+ { f } [ "test-foo.txt" exists? ] unit-test
+ { f } [ "test-bar.txt" exists? ] unit-test
- { } [
- { "Hi" } "delete-tree-test/a/b/c/d" ascii set-file-lines
- ] unit-test
+ { } [ "test-blah" make-directory ] unit-test
- { } [ "delete-tree-test" delete-tree ] unit-test
- ] cleanup-unique-directory
-] with-temp-directory
+ { } [
+ "test-blah/fooz" ascii <file-writer> dispose
+ ] unit-test
-[
- [
- { } [
- "copy-tree-test/a/b/c" make-directories
- ] unit-test
+ { t } [
+ "test-blah/fooz" exists?
+ ] unit-test
- { } [
- "Foobar"
- "copy-tree-test/a/b/c/d"
- ascii set-file-contents
- ] unit-test
+ { } [ "test-blah/fooz" delete-file ] unit-test
+ { } [ "test-blah" delete-directory ] unit-test
- { } [
- "copy-tree-test" "copy-destination" copy-tree
- ] unit-test
+ { f } [ "test-blah" exists? ] unit-test
- { "Foobar" } [
- "copy-destination/a/b/c/d" ascii file-contents
- ] unit-test
+ { } [ "delete-tree-test/a/b/c" make-directories ] unit-test
- { } [
- "copy-destination" delete-tree
- ] unit-test
+ { } [
+ { "Hi" } "delete-tree-test/a/b/c/d" ascii set-file-lines
+ ] unit-test
- { } [
- "copy-tree-test" "copy-destination" copy-tree-into
- ] unit-test
+ { } [ "delete-tree-test" delete-tree ] unit-test
- { "Foobar" } [
- "copy-destination/copy-tree-test/a/b/c/d" ascii file-contents
- ] unit-test
+ { } [
+ "copy-tree-test/a/b/c" make-directories
+ ] unit-test
- { } [
- "copy-destination/copy-tree-test/a/b/c/d" "." copy-file-into
- ] unit-test
+ { } [
+ "Foobar"
+ "copy-tree-test/a/b/c/d"
+ ascii set-file-contents
+ ] unit-test
- { "Foobar" } [
- "d" ascii file-contents
- ] unit-test
+ { } [
+ "copy-tree-test" "copy-destination" copy-tree
+ ] unit-test
- { } [ "d" delete-file ] 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" delete-tree ] unit-test
- ] cleanup-unique-directory
-] with-temp-directory
+ { } [
+ "copy-tree-test" "copy-destination" copy-tree-into
+ ] unit-test
-{ } [ "resource:deleteme" touch-file ] unit-test
-{ } [ "resource:deleteme" delete-file ] 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
+
+ { "Foobar" } [
+ "d" ascii file-contents
+ ] unit-test
+
+ { } [ "d" delete-file ] unit-test
+
+ { } [ "copy-destination" delete-tree ] unit-test
+
+ { } [ "copy-tree-test" delete-tree ] 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
-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 } [
{ 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 } [
-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 -- )
{ 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
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
{ "/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
USING: accessors calendar concurrency.promises continuations
debugger.unix destructors io io.backend.unix io.directories
io.encodings.ascii io.encodings.binary io.encodings.utf8
-io.files io.files.temp io.files.unique io.launcher
-io.launcher.unix io.streams.duplex io.timeouts kernel libc
-locals math namespaces sequences threads tools.test unix.process
-;
+io.files io.launcher io.launcher.unix io.streams.duplex
+io.timeouts kernel libc locals math namespaces sequences threads
+tools.test unix.process ;
IN: io.launcher.unix.tests
[
- [
- { } [ { "touch" "launcher-test-1" } try-process ] unit-test
-
- { t } [ "launcher-test-1" exists? ] unit-test
-
- { } [
- [ "launcher-test-1" delete-file ] ignore-errors
- ] unit-test
-
- { } [
- <process>
- "echo Hello" >>command
- "launcher-test-1" >>stdout
- try-process
- ] unit-test
-
- { "Hello\n" } [
- { "cat" "launcher-test-1" }
- ascii <process-reader> stream-contents
- ] unit-test
-
- { } [
- [ "launcher-test-1" delete-file ] ignore-errors
- ] unit-test
-
- { } [
- <process>
- "cat" >>command
- +closed+ >>stdin
- "launcher-test-1" >>stdout
- try-process
- ] unit-test
-
- { "" } [
- { "cat" "launcher-test-1" }
- ascii <process-reader> stream-contents
- ] unit-test
-
- { } [
- 2 [
- "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 [
+ { } [ { "touch" "launcher-test-1" } try-process ] unit-test
+
+ { t } [ "launcher-test-1" exists? ] unit-test
+
+ { } [
+ [ "launcher-test-1" delete-file ] ignore-errors
+ ] unit-test
+
+ { } [
+ <process>
+ "echo Hello" >>command
+ "launcher-test-1" >>stdout
+ try-process
+ ] unit-test
+
+ { "Hello\n" } [
+ { "cat" "launcher-test-1" }
+ ascii <process-reader> stream-contents
+ ] unit-test
+
+ { } [
+ [ "launcher-test-1" delete-file ] ignore-errors
+ ] unit-test
+
+ { } [
+ <process>
+ "cat" >>command
+ +closed+ >>stdin
+ "launcher-test-1" >>stdout
+ try-process
+ ] unit-test
+
+ { "" } [
+ { "cat" "launcher-test-1" }
+ ascii <process-reader> stream-contents
+ ] unit-test
+
+ { } [
+ 2 [
+ "launcher-test-1" binary <file-appender> [
<process>
- "echo hi" >>command
- "launcher-test-3" <appender> >>stdout
+ swap >>stdout
+ "echo Hello" >>command
try-process
- ] times
- "launcher-test-3" utf8 file-contents
- ] unit-test
+ ] 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>
+ "echo hi" >>command
+ "launcher-test-3" <appender> >>stdout
+ try-process
+ ] times
+ "launcher-test-3" utf8 file-contents
+ ] unit-test
- ] cleanup-unique-directory
-] with-temp-directory
+] with-test-directory
{ t } [
<process>
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 <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-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 <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-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" <mapped-file> void* <c-direct-array> first-unsafe ]
-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 <monitor> "m" set
- 3 seconds "m" get set-timeout
- "." touch-file
- ] unit-test
+ ! Non-recursive
+ { } [
+ "." f <monitor> "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 <monitor> "m" set
- 3 seconds "m" get set-timeout
- "." touch-file
- ] unit-test
+ ! Recursive
+ { } [
+ "." t <monitor> "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
USING: accessors calendar concurrency.count-downs
concurrency.promises continuations destructors io io.directories
-io.files io.files.temp io.files.unique io.monitors io.pathnames
-io.timeouts kernel namespaces sequences threads tools.test ;
-IN: io.monitors.tests
+io.files io.monitors io.pathnames io.timeouts kernel namespaces
+sequences threads tools.test ;
[
[
- [
- { } [ "." t <monitor> "m" set ] unit-test
+ { } [ "." t <monitor> "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 <monitor> "m" set ] unit-test
+
+ { } [ 1 <count-down> "b" set ] unit-test
+ { } [ 1 <count-down> "c1" set ] unit-test
+ { } [ 1 <count-down> "c2" set ] unit-test
+
[
- { } [ "xyz" make-directory ] unit-test
- { } [ "." t <monitor> "m" set ] unit-test
+ "b" get count-down
- { } [ 1 <count-down> "b" set ] unit-test
- { } [ 1 <count-down> "c1" set ] unit-test
- { } [ 1 <count-down> "c2" set ] unit-test
+ [
+ "m" get next-change path>>
+ dup print flush
+ dup parent-directory
+ [ trim-tail-separators "xyz" tail? ] either? not
+ ] loop
+ "c1" 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
- dup parent-directory
- [ trim-tail-separators "yxy" tail? ] either? not
- ] loop
-
- "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
-
- ! Dispose twice
- { } [ "m" get dispose ] unit-test
- { } [ "m" get dispose ] unit-test
- ] with-monitors
- ] cleanup-unique-directory
-] with-temp-directory
+ "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
+
+ { } [ "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
+] with-test-directory
! Out-of-scope disposal should not fail
{ } [ [ "resource:" f <monitor> ] with-monitors dispose ] unit-test
! Timeouts
[
[
- [
- ! Non-recursive
- { } [
- "." f <monitor> "m" set
- 100 milliseconds "m" get set-timeout
- [ [ t ] [ "m" get next-change drop ] while ] must-fail
- "m" get dispose
- ] unit-test
-
- ! Recursive
- { } [
- "." t <monitor> "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
+ ! Non-recursive
+ { } [
+ "." f <monitor> "m" set
+ 100 milliseconds "m" get set-timeout
+ [ [ t ] [ "m" get next-change drop ] while ] must-fail
+ "m" get dispose
+ ] unit-test
+
+ ! Recursive
+ { } [
+ "." t <monitor> "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
[
[
- [
- { } [
- <promise> "p" set
- "." t <monitor> "m" set
- 10 seconds "m" get set-timeout
- ] unit-test
+ { } [
+ <promise> "p" set
+ "." t <monitor> "m" set
+ 10 seconds "m" get set-timeout
+ ] unit-test
- [
- [ "m" get next-change ] [ ] recover
- "p" get fulfill
- ] in-thread
-
- { } [
- 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
+ [
+ [ "m" get next-change ] [ ] recover
+ "p" get fulfill
+ ] in-thread
+
+ { } [
+ 100 milliseconds sleep
+ "m" get dispose
+ ] unit-test
+
+ { t } [
+ "p" get 10 seconds ?promise-timeout
+ already-disposed?
+ ] unit-test
+ ] with-monitors
+] with-test-directory
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 <pipe> [ stream-element-type ] with-disposal ] unit-test
USING: alien alien.c-types alien.data arrays classes.struct
-compiler.units continuations destructors generic.single io
+compiler.units continuations destructors fry generic.single io
io.directories io.encodings.8-bit.latin1 io.encodings.ascii
io.encodings.binary io.encodings.string io.files
-io.files.private io.files.temp io.files.unique io.pathnames
-kernel locals make math sequences specialized-arrays
-system threads tools.test vocabs ;
+io.files.private io.pathnames kernel locals make math sequences
+specialized-arrays system threads tools.test vocabs ;
FROM: specialized-arrays.private => specialized-array-vocab ;
IN: io.files.tests
SPECIALIZED-ARRAY: int
{ } [
- [
- "append-test" ".txt" [| path |
- path ascii <file-appender> dispose
- ] cleanup-unique-file
- ] with-temp-directory
+ [ ascii <file-appender> dispose ] with-test-file
] unit-test
{
[ " " 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 [
] 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
-
- { int-array{ 1 2 3 } } [
- path binary [
- 3 4 * read
- ] with-file-reader
- int cast-array
- ] unit-test
- ] cleanup-unique-file
-] with-temp-directory
-
-[
- "test-012" ".bin" [| 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
+[| 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
+] with-test-file
+
+[| path |
+ { } [
+ BV{ 0 1 2 } path binary set-file-contents
+ ] unit-test
+
+ { t } [
+ path binary file-contents
+ B{ 0 1 2 } =
+ ] unit-test
+] with-test-file
STRUCT: pt { x uint } { y uint } ;
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
-
- { t } [
- path binary file-contents
- pt-array-1 >c-ptr sequence=
- ] unit-test
- ] cleanup-unique-file
-] with-temp-directory
+[| path |
+ { } [
+ pt-array-1 path binary set-file-contents
+ ] unit-test
+
+ { 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
{ } [
[
] 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 } [
] 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
-
-{ 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
-
-{ 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{ 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
+
+[| 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
+
+[| 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
+
+[| 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
+
+[| 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
-{ 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
-
-{ 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
-
-[
- [
- "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
{ } [
] with-file-reader
] unit-test
-[
- [
- "non-string-error" "" [
- ascii [ { } write ] with-file-writer
- ] cleanup-unique-file
- ] with-temp-directory
-] [ no-method? ] must-fail-with
+[| path |
+ [ path ascii [ { } write ] with-file-writer ]
+ [ no-method? ] must-fail-with
+] with-test-file
-[
- [
- "non-byte-array-error" "" [
- binary [ "" write ] with-file-writer
- ] cleanup-unique-file
- ] with-temp-directory
-] [ no-method? ] must-fail-with
+[| path |
+ [ path binary [ "" write ] with-file-writer ]
+ [ no-method? ] must-fail-with
+] with-test-file
! What happens if we close a file twice?
-{ } [
- [
- "closing-twice" "" [
- ascii <file-writer>
- [ dispose ] [ dispose ] bi
- ] cleanup-unique-file
- ] with-temp-directory
-] unit-test
-
-! Test cwd, cd.
-! NOTE TO USER: You do not want to use with-cd, you want with-directory.
-: with-cd ( path quot -- )
- [ [ absolute-path cd ] curry ] dip compose
- cwd [ cd ] curry
- [ ] cleanup ; inline
-
-{ t } [
- cwd
- "resource:core/" [ "hi" print ] with-cd
- cwd =
-] unit-test
+[
+ "closing-twice" ascii <file-writer>
+ [ dispose ] [ dispose ] bi
+] with-test-directory
-{ t } [
- cwd
- [ "resource:core/" [ "nick cage" throw ] with-cd ] [ drop ] recover
- cwd =
+{ f t t } [
+ [
+ "resource:core" absolute-path
+ [ cwd = ] [ cd ] [ cwd = ] tri
+ ] cwd '[ _ dup cd cwd = ] [ ] cleanup
] unit-test
-
-[
- "resource:core/" [ "nick cage" throw ] with-cd
-] [ "nick cage" = ] must-fail-with
{ 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{
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 <c-reader> 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 <c-reader> stream-contents >string ] bi
+ ] unit-test
! Writing specialized arrays to binary streams
- "io-streams-c-tests-int" ".txt" [| path |
- { } [
- path "wb" fopen <c-writer> [
+ { int-array{ 1 2 3 } } [
+ "c-tests-int.dat" absolute-path [
+ "wb" fopen <c-writer> [
int-array{ 1 2 3 } write
] with-output-stream
- ] unit-test
-
- { int-array{ 1 2 3 } } [
- path "rb" fopen <c-reader> [
- 3 4 * read
+ ] [
+ "rb" fopen <c-reader> [
+ 3 4 * read int cast-array
] with-input-stream
- int cast-array
- ] unit-test
- ] cleanup-unique-file
+ ] bi
+ ] unit-test
! Writing strings to binary streams should fail
- "test-omgfail" ".txt" [| path |
- [
- path "wb" fopen <c-writer> [
- "OMGFAIL" write
- ] with-output-stream
- ] must-fail
- ] cleanup-unique-file
+ [
+ "omgfail.txt" absolute-path "wb" fopen <c-writer> [
+ "OMGFAIL" write
+ ] with-output-stream
+ ] must-fail
-] with-temp-directory
+] with-test-directory
-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
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 ;
[ 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
projects / factor.git / commitdiff