basis/io/files/unix/unix-tests.factor

   1 USING: accessors arrays calendar continuations grouping io.directories
   2 io.files.info io.files.info.unix io.files.temp io.files.unix
   3 io.pathnames kernel literals math math.bitwise math.functions
   4 sequences strings system tools.test unix unix.groups unix.users ;
   5 IN: io.files.unix.tests
   6
   7 { "/usr/libexec/" } [ "/usr/libexec/awk/" parent-directory ] unit-test
   8 { "/etc/" } [ "/etc/passwd" parent-directory ] unit-test
   9 { "/" } [ "/etc/" parent-directory ] unit-test
  10 { "/" } [ "/etc" parent-directory ] unit-test
  11 { "/" } [ "/" parent-directory ] unit-test
  12
  13 { f } [ "" root-directory? ] unit-test
  14 { t } [ "/" root-directory? ] unit-test
  15 { t } [ "//" root-directory? ] unit-test
  16 { t } [ "///////" root-directory? ] unit-test
  17
  18 { "/" } [ "/" file-name ] unit-test
  19 { "///" } [ "///" file-name ] unit-test
  20
  21 { "/" } [ "/" "../.." append-path ] unit-test
  22 { "/" } [ "/" "../../" append-path ] unit-test
  23 { "/lib" } [ "/" "../lib" append-path ] unit-test
  24 { "/lib/" } [ "/" "../lib/" append-path ] unit-test
  25 { "/lib" } [ "/" "../../lib" append-path ] unit-test
  26 { "/lib/" } [ "/" "../../lib/" append-path ] unit-test
  27
  28 { "/lib" } [ "/usr/" "/lib" append-path ] unit-test
  29 { "/lib/" } [ "/usr/" "/lib/" append-path ] unit-test
  30 { "/lib/bux" } [ "/usr" "/lib/bux" append-path ] unit-test
  31 { "/lib/bux/" } [ "/usr" "/lib/bux/" append-path ] unit-test
  32 { t } [ "/foo" absolute-path? ] unit-test
  33
  34 : test-file ( -- path )
  35     "permissions" temp-file ;
  36
  37 : prepare-test-file ( -- )
  38     [ test-file delete-file ] ignore-errors
  39     test-file touch-file ;
  40
  41 : perms ( -- n )
  42     test-file file-permissions 0o7777 mask ;
  43
  44 prepare-test-file
  45
  46 { t }
  47 [ test-file flags{ USER-ALL GROUP-ALL OTHER-ALL } set-file-permissions perms 0o777 = ] unit-test
  48
  49 { t } [ test-file user-read? ] unit-test
  50 { t } [ test-file user-write? ] unit-test
  51 { t } [ test-file user-execute? ] unit-test
  52 { t } [ test-file group-read? ] unit-test
  53 { t } [ test-file group-write? ] unit-test
  54 { t } [ test-file group-execute? ] unit-test
  55 { t } [ test-file other-read? ] unit-test
  56 { t } [ test-file other-write? ] unit-test
  57 { t } [ test-file other-execute? ] unit-test
  58
  59 { t } [ test-file f set-other-execute perms 0o776 = ] unit-test
  60 { f } [ test-file file-info other-execute? ] unit-test
  61
  62 { t } [ test-file f set-other-write perms 0o774 = ] unit-test
  63 { f } [ test-file file-info other-write? ] unit-test
  64
  65 { t } [ test-file f set-other-read perms 0o770 = ] unit-test
  66 { f } [ test-file file-info other-read? ] unit-test
  67
  68 { t } [ test-file f set-group-execute perms 0o760 = ] unit-test
  69 { f } [ test-file file-info group-execute? ] unit-test
  70
  71 { t } [ test-file f set-group-write perms 0o740 = ] unit-test
  72 { f } [ test-file file-info group-write? ] unit-test
  73
  74 { t } [ test-file f set-group-read perms 0o700 = ] unit-test
  75 { f } [ test-file file-info group-read? ] unit-test
  76
  77 { t } [ test-file f set-user-execute perms 0o600 = ] unit-test
  78 { f } [ test-file file-info other-execute? ] unit-test
  79
  80 { t } [ test-file f set-user-write perms 0o400 = ] unit-test
  81 { f } [ test-file file-info other-write? ] unit-test
  82
  83 { t } [ test-file f set-user-read perms 0o000 = ] unit-test
  84 { f } [ test-file file-info other-read? ] unit-test
  85
  86 { t }
  87 [ test-file flags{ USER-ALL GROUP-ALL OTHER-EXECUTE } set-file-permissions perms 0o771 = ] unit-test
  88
  89 prepare-test-file
  90
  91 { t }
  92 [
  93     test-file now
  94     [ set-file-access-time ] 2keep
  95     [ file-info accessed>> ]
  96     [ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* =
  97 ] unit-test
  98
  99 { t }
 100 [
 101     test-file now
 102     [ set-file-modified-time ] 2keep
 103     [ file-info modified>> ]
 104     [ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* =
 105 ] unit-test
 106
 107 { t }
 108 [
 109     test-file now [ dup 2array set-file-times ] 2keep
 110     [ file-info [ modified>> ] [ accessed>> ] bi ] dip
 111     3array
 112     [ [ truncate >integer ] change-second >gmt ] map all-equal?
 113 ] unit-test
 114
 115 { } [ test-file f now 2array set-file-times ] unit-test
 116 { } [ test-file now f 2array set-file-times ] unit-test
 117 { } [ test-file f f 2array set-file-times ] unit-test
 118
 119
 120 { } [ test-file real-user-name set-file-user ] unit-test
 121 { } [ test-file real-user-id set-file-user ] unit-test
 122 { } [ test-file real-group-name set-file-group ] unit-test
 123 { } [ test-file real-group-id set-file-group ] unit-test
 124
 125 { t } [ test-file file-user-name real-user-name = ] unit-test
 126 { t } [ test-file file-group-name real-group-name = ] unit-test
 127
 128 { }
 129 [ test-file real-user-id real-group-id set-file-ids ] unit-test
 130
 131 { }
 132 [ test-file f real-group-id set-file-ids ] unit-test
 133
 134 { }
 135 [ test-file real-user-id f set-file-ids ] unit-test
 136
 137 { }
 138 [ test-file f f set-file-ids ] unit-test
 139
 140 { t } [ 0o4000 uid? ] unit-test
 141 { t } [ 0o2000 gid? ] unit-test
 142 { t } [ 0o1000 sticky? ] unit-test
 143 { t } [ 0o400 user-read? ] unit-test
 144 { t } [ 0o200 user-write? ] unit-test
 145 { t } [ 0o100 user-execute? ] unit-test
 146 { t } [ 0o040 group-read? ] unit-test
 147 { t } [ 0o020 group-write? ] unit-test
 148 { t } [ 0o010 group-execute? ] unit-test
 149 { t } [ 0o004 other-read? ] unit-test
 150 { t } [ 0o002 other-write? ] unit-test
 151 { t } [ 0o001 other-execute? ] unit-test
 152
 153 { f } [ 0 uid? ] unit-test
 154 { f } [ 0 gid? ] unit-test
 155 { f } [ 0 sticky? ] unit-test
 156 { f } [ 0 user-read? ] unit-test
 157 { f } [ 0 user-write? ] unit-test
 158 { f } [ 0 user-execute? ] unit-test
 159 { f } [ 0 group-read? ] unit-test
 160 { f } [ 0 group-write? ] unit-test
 161 { f } [ 0 group-execute? ] unit-test
 162 { f } [ 0 other-read? ] unit-test
 163 { f } [ 0 other-write? ] unit-test
 164 { f } [ 0 other-execute? ] unit-test
 165
 166 ! (cwd)
 167 { t } [ 1 (cwd) string? ] unit-test
 168
 169 os linux? [
 170     { t } [ "/proc/self/exe" read-symbolic-link string? ] unit-test
 171 ] when