add processGroup001/processGroup002
[packages/unix.git] / tests / fileStatus.hs
1
2 -- GHC trac #2969
3
4 import System.Posix.Files
5 import System.Posix.Directory
6 import System.Posix.IO
7 import Control.Exception as E
8 import Control.Monad
9
10 main = do
11 cleanup
12 fs <- testRegular
13 ds <- testDir
14 testSymlink fs ds
15 cleanup
16
17 testRegular = do
18 createFile "regular" ownerReadMode
19 (fs, _) <- getStatus "regular"
20 let expected = (False,False,False,True,False,False,False)
21 actual = snd (statusElements fs)
22 when (actual /= expected) $
23 fail "unexpected file status bits for regular file"
24 return fs
25
26 testDir = do
27 createDirectory "dir" ownerReadMode
28 (ds, _) <- getStatus "dir"
29 let expected = (False,False,False,False,True,False,False)
30 actual = snd (statusElements ds)
31 when (actual /= expected) $
32 fail "unexpected file status bits for directory"
33 return ds
34
35 testSymlink fs ds = do
36 createSymbolicLink "regular" "link-regular"
37 createSymbolicLink "dir" "link-dir"
38 (fs', ls) <- getStatus "link-regular"
39 (ds', lds) <- getStatus "link-dir"
40
41 let expected = (False,False,False,False,False,True,False)
42 actualF = snd (statusElements ls)
43 actualD = snd (statusElements lds)
44
45 when (actualF /= expected) $
46 fail "unexpected file status bits for symlink to regular file"
47
48 when (actualD /= expected) $
49 fail "unexpected file status bits for symlink to directory"
50
51 when (statusElements fs /= statusElements fs') $
52 fail "status for a file does not match when it's accessed via a symlink"
53
54 when (statusElements ds /= statusElements ds') $
55 fail "status for a directory does not match when it's accessed via a symlink"
56
57 cleanup = do
58 ignoreIOExceptions $ removeDirectory "dir"
59 mapM_ (ignoreIOExceptions . removeLink)
60 ["regular", "link-regular", "link-dir"]
61
62 ignoreIOExceptions io = io `E.catch`
63 ((\_ -> return ()) :: IOException -> IO ())
64
65 getStatus f = do
66 fs <- getFileStatus f
67 ls <- getSymbolicLinkStatus f
68
69 fd <- openFd f ReadOnly Nothing defaultFileFlags
70 fs' <- getFdStatus fd
71
72 when (statusElements fs /= statusElements fs') $
73 fail "getFileStatus and getFdStatus give inconsistent results"
74
75 when (not (isSymbolicLink ls) && statusElements fs /= statusElements fs') $
76 fail $ "getFileStatus and getSymbolicLinkStatus give inconsistent results "
77 ++ "on a file that is not a symbolic link"
78
79 return (fs, ls)
80
81 -- Yay for 17-element tuples!
82 statusElements fs = (,)
83 (deviceID fs
84 ,fileMode fs
85 ,linkCount fs
86 ,fileOwner fs
87 ,fileGroup fs
88 ,specialDeviceID fs
89 ,fileSize fs
90 ,accessTime fs
91 ,modificationTime fs
92 ,statusChangeTime fs
93 )
94 (isBlockDevice fs
95 ,isCharacterDevice fs
96 ,isNamedPipe fs
97 ,isRegularFile fs
98 ,isDirectory fs
99 ,isSymbolicLink fs
100 ,isSocket fs
101 )