From c09312d88164458f17cd44cc40602fa6f342cff2 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 31 Mar 2016 21:31:44 -0700
Subject: [PATCH] io.files.unix: more test cleanup.
---
basis/io/files/unix/unix-tests.factor | 229 +++++++++++++++-----------
1 file changed, 130 insertions(+), 99 deletions(-)
diff --git a/basis/io/files/unix/unix-tests.factor b/basis/io/files/unix/unix-tests.factor
index d816561dec..870c0c971c 100644
--- a/basis/io/files/unix/unix-tests.factor
+++ b/basis/io/files/unix/unix-tests.factor
@@ -1,8 +1,8 @@
-USING: accessors arrays calendar continuations grouping io.directories
-io.files.info io.files.info.unix io.files.temp io.files.unix
-io.pathnames kernel literals math math.bitwise math.functions
-sequences strings system tools.test unix unix.groups unix.users ;
-IN: io.files.unix.tests
+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 ;
{ "/usr/libexec/" } [ "/usr/libexec/awk/" 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
{ 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
- [ set-file-access-time ] 2keep
- [ file-info accessed>> ]
- [ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* =
-] unit-test
+ "permissions-1" ".txt" [| path |
-{ t }
-[
- test-file now
- [ set-file-modified-time ] 2keep
- [ file-info modified>> ]
- [ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* =
-] unit-test
+ { 0o777 } [
+ path flags{ USER-ALL GROUP-ALL OTHER-ALL } set-file-permissions
+ path file-permissions 0o7777 mask
+ ] unit-test
-{ t }
-[
- test-file 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 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
-{ } [ test-file f now 2array set-file-times ] unit-test
-{ } [ test-file now f 2array set-file-times ] unit-test
-{ } [ test-file f f 2array set-file-times ] 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
+ [ 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 [ 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
-{ } [ test-file real-user-name set-file-user ] unit-test
-{ } [ test-file real-user-id set-file-user ] unit-test
-{ } [ test-file real-group-name set-file-group ] unit-test
-{ } [ test-file 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 } [ test-file file-user-name real-user-name = ] unit-test
-{ t } [ test-file 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
-{ }
-[ test-file real-user-id real-group-id set-file-ids ] unit-test
+ { } [ path real-user-id real-group-id set-file-ids ] unit-test
-{ }
-[ test-file f real-group-id set-file-ids ] unit-test
+ { } [ path f real-group-id set-file-ids ] unit-test
-{ }
-[ test-file real-user-id f set-file-ids ] unit-test
+ { } [ path real-user-id f set-file-ids ] unit-test
-{ }
-[ test-file f f set-file-ids ] unit-test
+ { } [ path f f set-file-ids ] unit-test
+
+ ] cleanup-unique-file
+] with-temp-directory
{ t } [ 0o4000 uid? ] unit-test
{ t } [ 0o2000 gid? ] unit-test