From d6784bdb466b15414c88183c9a86edf3d477edcc Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 18 Oct 2008 17:48:33 -0500
Subject: [PATCH] make user-read? work in file-info objects
---
basis/io/unix/files/files-docs.factor | 46 +++++++++++++-------------
basis/io/unix/files/files-tests.factor | 36 ++++++++++----------
basis/io/unix/files/files.factor | 13 ++++++++
3 files changed, 54 insertions(+), 41 deletions(-)
diff --git a/basis/io/unix/files/files-docs.factor b/basis/io/unix/files/files-docs.factor
index 5649b56abd..3798380e0f 100644
--- a/basis/io/unix/files/files-docs.factor
+++ b/basis/io/unix/files/files-docs.factor
@@ -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:"
diff --git a/basis/io/unix/files/files-tests.factor b/basis/io/unix/files/files-tests.factor
index 21a4d18759..78a80ad969 100644
--- a/basis/io/unix/files/files-tests.factor
+++ b/basis/io/unix/files/files-tests.factor
@@ -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
diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor
index b5fa7783d0..e253e77748 100644
--- a/basis/io/unix/files/files.factor
+++ b/basis/io/unix/files/files.factor
@@ -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? ;