#2969: unix package built wrong on Solaris
-------------------------+--------------------------------------------------
Reporter: duncan | Owner: duncan
Type: bug | Status: new
Priority: high | Milestone: 6.12.1
Component: Compiler | Version: 6.8.3
Severity: normal | Resolution:
Keywords: | Difficulty: Unknown
Testcase: | Os: Solaris
Architecture: sparc |
-------------------------+--------------------------------------------------
Comment (by duncan):
Seems to be working. I tested in ghc-6.10.4 which also includes the above
patch.
To make sure it keeps working on other ports it'd be good to add a trivial
test of `getFileStatus` and `getSymbolicLinkStatus`.
For example something along the lines of:
{{{
import System.Posix.Files
import System.Posix.Directory
import System.Posix.IO
import Control.Monad (when)
main = do
fs <- testRegular
ds <- testDir
testSymlink fs ds
cleanup
testRegular = do
createFile "regular" ownerReadMode
(fs, _) <- getStatus "regular"
let expected = (False,False,False,True,False,False,False)
actual = snd (statusElements fs)
when (actual /= expected) $
fail "unexpected file ststus bits for regular file"
return fs
testDir = do
createDirectory "dir" ownerReadMode
(ds, _) <- getStatus "dir"
let expected = (False,False,False,False,True,False,False)
actual = snd (statusElements ds)
when (actual /= expected) $
fail "unexpected file ststus bits for directory"
return ds
testSymlink fs ds = do
createSymbolicLink "regular" "link-regular"
createSymbolicLink "dir" "link-dir"
(fs', ls) <- getStatus "link-regular"
(ds', lds) <- getStatus "link-dir"
let expected = (False,False,False,False,False,True,False)
actualF = snd (statusElements ls)
actualD = snd (statusElements lds)
when (actualF /= expected) $
fail "unexpected file ststus bits for symlink to regular file"
when (actualD /= expected) $
fail "unexpected file ststus bits for symlink to directory"
when (statusElements fs /= statusElements fs') $
fail "status for a file does not match when it's accessed via a
symlink"
when (statusElements ds /= statusElements ds') $
fail "status for a directory does not match when it's accessed via a
symlink"
cleanup = do
removeDirectory "dir"
mapM_ removeLink ["regular", "link-regular", "link-dir"]
getStatus f = do
fs <- getFileStatus f
ls <- getSymbolicLinkStatus f
fd <- openFd f ReadOnly Nothing defaultFileFlags
fs' <- getFdStatus fd
when (statusElements fs /= statusElements fs') $
fail "getFileStatus and getFdStatus give inconsistent results"
when (not (isSymbolicLink ls) && statusElements fs /= statusElements
fs') $
fail $ "getFileStatus and getSymbolicLinkStatus give inconsistent
results "
++ "on a file that is not a symbolic link"
return (fs, ls)
-- Yay for 17-element tuples!
statusElements fs = (,)
(deviceID fs
,fileMode fs
,linkCount fs
,fileOwner fs
,fileGroup fs
,specialDeviceID fs
,fileSize fs
,accessTime fs
,modificationTime fs
,statusChangeTime fs
)
(isBlockDevice fs
,isCharacterDevice fs
,isNamedPipe fs
,isRegularFile fs
,isDirectory fs
,isSymbolicLink fs
,isSocket fs
)
}}}
This test works on Linux and Solaris with ghc-6.10.4.
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/2969#comment:4>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
