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