make user-read? work in file-info objects

db4
Doug Coleman 2008-10-18 17:48:33 -05:00
parent 6aadd70623
commit d6784bdb46
3 changed files with 54 additions and 41 deletions

View File

@ -38,37 +38,37 @@ HELP: group-execute?
{ $values
{ "obj" "a pathname string or an integer" }
{ "?" "a boolean" } }
{ $description "Tests whether the " { $snippet "group execute" } " bit is set on a file." } ;
{ $description "Tests whether the " { $snippet "group execute" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
HELP: group-read?
{ $values
{ "obj" "a pathname string or an integer" }
{ "obj" "a pathname string, file-info object, or an integer" }
{ "?" "a boolean" } }
{ $description "Tests whether the " { $snippet "group read" } " bit is set on a file or an integer." } ;
{ $description "Tests whether the " { $snippet "group read" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
HELP: group-write?
{ $values
{ "obj" "a pathname string or an integer" }
{ "obj" "a pathname string, file-info object, or an integer" }
{ "?" "a boolean" } }
{ $description "Tests whether the " { $snippet "group write" } " bit is set on a file or an integer." } ;
{ $description "Tests whether the " { $snippet "group write" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
HELP: other-execute?
{ $values
{ "obj" "a pathname string or an integer" }
{ "obj" "a pathname string, file-info object, or an integer" }
{ "?" "a boolean" } }
{ $description "Tests whether the " { $snippet "other execute" } " bit is set on a file or an integer." } ;
{ $description "Tests whether the " { $snippet "other execute" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
HELP: other-read?
{ $values
{ "obj" "a pathname string or an integer" }
{ "obj" "a pathname string, file-info object, or an integer" }
{ "?" "a boolean" } }
{ $description "Tests whether the " { $snippet "other read" } " bit is set on a file or an integer." } ;
{ $description "Tests whether the " { $snippet "other read" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
HELP: other-write?
{ $values
{ "obj" "a pathname string or an integer" }
{ "obj" "a pathname string, file-info object, or an integer" }
{ "?" "a boolean" } }
{ $description "Tests whether the " { $snippet "other write" } " bit is set on a file or an integer." } ;
{ $description "Tests whether the " { $snippet "other write" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
HELP: set-file-access-time
{ $values
@ -124,9 +124,9 @@ HELP: set-gid
HELP: gid?
{ $values
{ "obj" "a pathname string or an integer" }
{ "obj" "a pathname string, file-info object, or an integer" }
{ "?" "a boolean" } }
{ $description "Tests whether the " { $snippet "gid" } " bit is set on a file or an integer." } ;
{ $description "Tests whether the " { $snippet "gid" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
HELP: set-group-execute
{ $values
@ -165,9 +165,9 @@ HELP: set-sticky
HELP: sticky?
{ $values
{ "obj" "a pathname string or an integer" }
{ "obj" "a pathname string, file-info object, or an integer" }
{ "?" "a boolean" } }
{ $description "Tests whether the " { $snippet "sticky" } " bit is set on a file or an integer." } ;
{ $description "Tests whether the " { $snippet "sticky" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
HELP: set-uid
{ $values
@ -176,9 +176,9 @@ HELP: set-uid
HELP: uid?
{ $values
{ "obj" "a pathname string or an integer" }
{ "obj" "a pathname string, file-info object, or an integer" }
{ "?" "a boolean" } }
{ $description "Tests whether the " { $snippet "uid" } " bit is set on a file or an integer." } ;
{ $description "Tests whether the " { $snippet "uid" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
HELP: set-user-execute
{ $values
@ -197,21 +197,21 @@ HELP: set-user-write
HELP: user-execute?
{ $values
{ "obj" "a pathname string or an integer" }
{ "obj" "a pathname string, file-info object, or an integer" }
{ "?" "a boolean" } }
{ $description "Tests whether the " { $snippet "user execute" } " bit is set on a file or an integer." } ;
{ $description "Tests whether the " { $snippet "user execute" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
HELP: user-read?
{ $values
{ "obj" "a pathname string or an integer" }
{ "obj" "a pathname string, file-info object, or an integer" }
{ "?" "a boolean" } }
{ $description "Tests whether the " { $snippet "user read" } " bit is set on a file or an integer." } ;
{ $description "Tests whether the " { $snippet "user read" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
HELP: user-write?
{ $values
{ "obj" "a pathname string or an integer" }
{ "obj" "a pathname string, file-info object, or an integer" }
{ "?" "a boolean" } }
{ $description "Tests whether the " { $snippet "user write" } " bit is set on a file or an integer." } ;
{ $description "Tests whether the " { $snippet "user write" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
ARTICLE: "unix-file-permissions" "Unix file permissions"
"Reading all file permissions:"

View File

@ -55,32 +55,32 @@ prepare-test-file
[ t ] [ test-file other-write? ] unit-test
[ t ] [ test-file other-execute? ] unit-test
[ t ]
[ test-file f set-other-execute perms OCT: 776 = ] unit-test
[ t ] [ test-file f set-other-execute perms OCT: 776 = ] unit-test
[ f ] [ test-file file-info other-execute? ] unit-test
[ t ]
[ test-file f set-other-write perms OCT: 774 = ] unit-test
[ t ] [ test-file f set-other-write perms OCT: 774 = ] unit-test
[ f ] [ test-file file-info other-write? ] unit-test
[ t ]
[ test-file f set-other-read perms OCT: 770 = ] unit-test
[ t ] [ test-file f set-other-read perms OCT: 770 = ] unit-test
[ f ] [ test-file file-info other-read? ] unit-test
[ t ]
[ test-file f set-group-execute perms OCT: 760 = ] unit-test
[ t ] [ test-file f set-group-execute perms OCT: 760 = ] unit-test
[ f ] [ test-file file-info group-execute? ] unit-test
[ t ]
[ test-file f set-group-write perms OCT: 740 = ] unit-test
[ t ] [ test-file f set-group-write perms OCT: 740 = ] unit-test
[ f ] [ test-file file-info group-write? ] unit-test
[ t ]
[ test-file f set-group-read perms OCT: 700 = ] unit-test
[ t ] [ test-file f set-group-read perms OCT: 700 = ] unit-test
[ f ] [ test-file file-info group-read? ] unit-test
[ t ]
[ test-file f set-user-execute perms OCT: 600 = ] unit-test
[ t ] [ test-file f set-user-execute perms OCT: 600 = ] unit-test
[ f ] [ test-file file-info other-execute? ] unit-test
[ t ]
[ test-file f set-user-write perms OCT: 400 = ] unit-test
[ t ] [ test-file f set-user-write perms OCT: 400 = ] unit-test
[ f ] [ test-file file-info other-write? ] unit-test
[ t ]
[ test-file f set-user-read perms OCT: 000 = ] unit-test
[ t ] [ test-file f set-user-read perms OCT: 000 = ] unit-test
[ f ] [ test-file file-info other-read? ] unit-test
[ t ]
[ test-file { USER-ALL GROUP-ALL OTHER-EXECUTE } flags set-file-permissions perms OCT: 771 = ] unit-test

View File

@ -192,6 +192,19 @@ M: integer other-read? ( integer -- ? ) OTHER-READ mask? ;
M: integer other-write? ( integer -- ? ) OTHER-WRITE mask? ;
M: integer other-execute? ( integer -- ? ) OTHER-EXECUTE mask? ;
M: file-info uid? ( file-info -- ? ) permissions>> uid? ;
M: file-info gid? ( file-info -- ? ) permissions>> gid? ;
M: file-info sticky? ( file-info -- ? ) permissions>> sticky? ;
M: file-info user-read? ( file-info -- ? ) permissions>> user-read? ;
M: file-info user-write? ( file-info -- ? ) permissions>> user-write? ;
M: file-info user-execute? ( file-info -- ? ) permissions>> user-execute? ;
M: file-info group-read? ( file-info -- ? ) permissions>> group-read? ;
M: file-info group-write? ( file-info -- ? ) permissions>> group-write? ;
M: file-info group-execute? ( file-info -- ? ) permissions>> group-execute? ;
M: file-info other-read? ( file-info -- ? ) permissions>> other-read? ;
M: file-info other-write? ( file-info -- ? ) permissions>> other-write? ;
M: file-info other-execute? ( file-info -- ? ) permissions>> other-execute? ;
M: string uid? ( path -- ? ) UID file-mode? ;
M: string gid? ( path -- ? ) GID file-mode? ;
M: string sticky? ( path -- ? ) STICKY file-mode? ;