io.files.unix: more test cleanup.
John Benediktsson
parent
68b0f7d0f0
commit
c09312d881
|
|
@ -1,8 +1,8 @@
|
||||||
USING: accessors arrays calendar continuations grouping io.directories
|
USING: accessors arrays calendar grouping io.files.info
|
||||||
io.files.info io.files.info.unix io.files.temp io.files.unix
|
io.files.info.unix io.files.temp io.files.unique io.files.unix
|
||||||
io.pathnames kernel literals math math.bitwise math.functions
|
io.pathnames kernel literals locals math math.bitwise
|
||||||
sequences strings system tools.test unix unix.groups unix.users ;
|
math.functions sequences strings system tools.test unix
|
||||||
IN: io.files.unix.tests
|
unix.groups unix.users ;
|
||||||
|
|
||||||
{ "/usr/libexec/" } [ "/usr/libexec/awk/" parent-directory ] unit-test
|
{ "/usr/libexec/" } [ "/usr/libexec/awk/" parent-directory ] unit-test
|
||||||
{ "/etc/" } [ "/etc/passwd" parent-directory ] unit-test
|
{ "/etc/" } [ "/etc/passwd" parent-directory ] unit-test
|
||||||
|
|
@ -31,111 +31,142 @@ IN: io.files.unix.tests
|
||||||
{ "/lib/bux/" } [ "/usr" "/lib/bux/" append-path ] unit-test
|
{ "/lib/bux/" } [ "/usr" "/lib/bux/" append-path ] unit-test
|
||||||
{ t } [ "/foo" absolute-path? ] unit-test
|
{ t } [ "/foo" absolute-path? ] unit-test
|
||||||
|
|
||||||
: test-file ( -- path )
|
|
||||||
"permissions" temp-file ;
|
|
||||||
|
|
||||||
: prepare-test-file ( -- )
|
|
||||||
[ test-file delete-file ] ignore-errors
|
|
||||||
test-file touch-file ;
|
|
||||||
|
|
||||||
: perms ( -- n )
|
|
||||||
test-file file-permissions 0o7777 mask ;
|
|
||||||
|
|
||||||
prepare-test-file
|
|
||||||
|
|
||||||
{ t }
|
|
||||||
[ test-file flags{ USER-ALL GROUP-ALL OTHER-ALL } set-file-permissions perms 0o777 = ] unit-test
|
|
||||||
|
|
||||||
{ t } [ test-file user-read? ] unit-test
|
|
||||||
{ t } [ test-file user-write? ] unit-test
|
|
||||||
{ t } [ test-file user-execute? ] unit-test
|
|
||||||
{ t } [ test-file group-read? ] unit-test
|
|
||||||
{ t } [ test-file group-write? ] unit-test
|
|
||||||
{ t } [ test-file group-execute? ] unit-test
|
|
||||||
{ t } [ test-file other-read? ] unit-test
|
|
||||||
{ t } [ test-file other-write? ] unit-test
|
|
||||||
{ t } [ test-file other-execute? ] unit-test
|
|
||||||
|
|
||||||
{ t } [ test-file f set-other-execute perms 0o776 = ] unit-test
|
|
||||||
{ f } [ test-file file-info other-execute? ] unit-test
|
|
||||||
|
|
||||||
{ t } [ test-file f set-other-write perms 0o774 = ] unit-test
|
|
||||||
{ f } [ test-file file-info other-write? ] unit-test
|
|
||||||
|
|
||||||
{ t } [ test-file f set-other-read perms 0o770 = ] unit-test
|
|
||||||
{ f } [ test-file file-info other-read? ] unit-test
|
|
||||||
|
|
||||||
{ t } [ test-file f set-group-execute perms 0o760 = ] unit-test
|
|
||||||
{ f } [ test-file file-info group-execute? ] unit-test
|
|
||||||
|
|
||||||
{ t } [ test-file f set-group-write perms 0o740 = ] unit-test
|
|
||||||
{ f } [ test-file file-info group-write? ] unit-test
|
|
||||||
|
|
||||||
{ t } [ test-file f set-group-read perms 0o700 = ] unit-test
|
|
||||||
{ f } [ test-file file-info group-read? ] unit-test
|
|
||||||
|
|
||||||
{ t } [ test-file f set-user-execute perms 0o600 = ] unit-test
|
|
||||||
{ f } [ test-file file-info other-execute? ] unit-test
|
|
||||||
|
|
||||||
{ t } [ test-file f set-user-write perms 0o400 = ] unit-test
|
|
||||||
{ f } [ test-file file-info other-write? ] unit-test
|
|
||||||
|
|
||||||
{ t } [ test-file f set-user-read perms 0o000 = ] unit-test
|
|
||||||
{ f } [ test-file file-info other-read? ] unit-test
|
|
||||||
|
|
||||||
{ t }
|
|
||||||
[ test-file flags{ USER-ALL GROUP-ALL OTHER-EXECUTE } set-file-permissions perms 0o771 = ] unit-test
|
|
||||||
|
|
||||||
prepare-test-file
|
|
||||||
|
|
||||||
{ t }
|
|
||||||
[
|
[
|
||||||
test-file now
|
"permissions-1" ".txt" [| path |
|
||||||
|
|
||||||
|
{ 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
|
||||||
|
|
||||||
|
{ 0o776 } [
|
||||||
|
path f set-other-execute
|
||||||
|
path file-permissions 0o7777 mask
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ f } [ path file-info other-execute? ] unit-test
|
||||||
|
|
||||||
|
{ 0o774 } [
|
||||||
|
path f set-other-write
|
||||||
|
path file-permissions 0o7777 mask
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ f } [ path file-info other-write? ] unit-test
|
||||||
|
|
||||||
|
{ 0o770 } [
|
||||||
|
path f set-other-read
|
||||||
|
path file-permissions 0o7777 mask
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ f } [ path file-info other-read? ] unit-test
|
||||||
|
|
||||||
|
{ 0o760 } [
|
||||||
|
path f set-group-execute
|
||||||
|
path file-permissions 0o7777 mask
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ f } [ path file-info group-execute? ] unit-test
|
||||||
|
|
||||||
|
{ 0o740 } [
|
||||||
|
path f set-group-write
|
||||||
|
path file-permissions 0o7777 mask
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ f } [ path file-info group-write? ] unit-test
|
||||||
|
|
||||||
|
{ 0o700 } [
|
||||||
|
path f set-group-read
|
||||||
|
path file-permissions 0o7777 mask
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ f } [ path file-info group-read? ] unit-test
|
||||||
|
|
||||||
|
{ 0o600 } [
|
||||||
|
path f set-user-execute
|
||||||
|
path file-permissions 0o7777 mask
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ f } [ path file-info other-execute? ] unit-test
|
||||||
|
|
||||||
|
{ 0o400 } [
|
||||||
|
path f set-user-write
|
||||||
|
path file-permissions 0o7777 mask
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ f } [ path file-info other-write? ] unit-test
|
||||||
|
|
||||||
|
{ 0o000 } [
|
||||||
|
path f set-user-read
|
||||||
|
path file-permissions 0o7777 mask
|
||||||
|
] 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
|
||||||
|
|
||||||
|
] cleanup-unique-file
|
||||||
|
|
||||||
|
"permissions-2" ".txt" [| path |
|
||||||
|
|
||||||
|
{ t } [
|
||||||
|
path now
|
||||||
[ set-file-access-time ] 2keep
|
[ set-file-access-time ] 2keep
|
||||||
[ file-info accessed>> ]
|
[ file-info accessed>> ]
|
||||||
[ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* =
|
[ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* =
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ t }
|
{ t }
|
||||||
[
|
[
|
||||||
test-file now
|
path now
|
||||||
[ set-file-modified-time ] 2keep
|
[ set-file-modified-time ] 2keep
|
||||||
[ file-info modified>> ]
|
[ file-info modified>> ]
|
||||||
[ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* =
|
[ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* =
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ t }
|
{ t }
|
||||||
[
|
[
|
||||||
test-file now [ dup 2array set-file-times ] 2keep
|
path now [ dup 2array set-file-times ] 2keep
|
||||||
[ file-info [ modified>> ] [ accessed>> ] bi ] dip
|
[ file-info [ modified>> ] [ accessed>> ] bi ] dip
|
||||||
3array
|
3array
|
||||||
[ [ truncate >integer ] change-second >gmt ] map all-equal?
|
[ [ truncate >integer ] change-second >gmt ] map all-equal?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ } [ test-file f now 2array set-file-times ] unit-test
|
{ } [ path f now 2array set-file-times ] unit-test
|
||||||
{ } [ test-file now f 2array set-file-times ] unit-test
|
{ } [ path now f 2array set-file-times ] unit-test
|
||||||
{ } [ test-file f f 2array set-file-times ] unit-test
|
{ } [ path f f 2array set-file-times ] unit-test
|
||||||
|
|
||||||
|
|
||||||
{ } [ test-file real-user-name set-file-user ] unit-test
|
{ } [ path real-user-name set-file-user ] unit-test
|
||||||
{ } [ test-file real-user-id set-file-user ] unit-test
|
{ } [ path real-user-id set-file-user ] unit-test
|
||||||
{ } [ test-file real-group-name set-file-group ] unit-test
|
{ } [ path real-group-name set-file-group ] unit-test
|
||||||
{ } [ test-file real-group-id set-file-group ] unit-test
|
{ } [ path real-group-id set-file-group ] unit-test
|
||||||
|
|
||||||
{ t } [ test-file file-user-name real-user-name = ] unit-test
|
{ t } [ path file-user-name real-user-name = ] unit-test
|
||||||
{ t } [ test-file file-group-name real-group-name = ] unit-test
|
{ t } [ path file-group-name real-group-name = ] unit-test
|
||||||
|
|
||||||
{ }
|
{ } [ path real-user-id real-group-id set-file-ids ] unit-test
|
||||||
[ test-file real-user-id real-group-id set-file-ids ] unit-test
|
|
||||||
|
|
||||||
{ }
|
{ } [ path f real-group-id set-file-ids ] unit-test
|
||||||
[ test-file f real-group-id set-file-ids ] unit-test
|
|
||||||
|
|
||||||
{ }
|
{ } [ path real-user-id f set-file-ids ] unit-test
|
||||||
[ test-file real-user-id f set-file-ids ] unit-test
|
|
||||||
|
|
||||||
{ }
|
{ } [ path f f set-file-ids ] unit-test
|
||||||
[ test-file f f set-file-ids ] unit-test
|
|
||||||
|
] cleanup-unique-file
|
||||||
|
] with-temp-directory
|
||||||
|
|
||||||
{ t } [ 0o4000 uid? ] unit-test
|
{ t } [ 0o4000 uid? ] unit-test
|
||||||
{ t } [ 0o2000 gid? ] unit-test
|
{ t } [ 0o2000 gid? ] unit-test
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue