From 34c7bf896f19b182cf6fa104e057f1df9df1254a Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Fri, 11 Nov 2011 16:18:48 +0000 Subject: Provide a raw ByteString version of FilePath and environment APIs The new module System.Posix.ByteString provides exactly the same API as System.Posix, except that: - There is a new type: RawFilePath = ByteString - All functions mentioning FilePath in the System.Posix API use RawFilePath in the System.Posix.ByteString API - RawFilePaths are not subject to Unicode locale encoding and decoding, unlike FilePaths. They are the exact bytes passed to and returned from the underlying POSIX API. - Similarly for functions that deal in environment strings (System.Posix.Env): these use untranslated ByteStrings in System.Posix.Environment - There is a new function System.Posix.ByteString.getArgs :: [ByteString] returning the raw untranslated arguments as passed to exec() when the program was started. --- tests/all.T | 6 +++ tests/fileStatus.hs | 25 ++++++---- tests/fileStatusByteString.hs | 105 ++++++++++++++++++++++++++++++++++++++++++ tests/getEnvironment02.hs | 8 ++++ tests/getEnvironment02.stdout | 1 + 5 files changed, 135 insertions(+), 10 deletions(-) create mode 100644 tests/fileStatusByteString.hs create mode 100644 tests/getEnvironment02.hs create mode 100644 tests/getEnvironment02.stdout (limited to 'tests') diff --git a/tests/all.T b/tests/all.T index 4b888be..8f8a152 100644 --- a/tests/all.T +++ b/tests/all.T @@ -26,6 +26,7 @@ if config.platform == 'i386-unknown-freebsd': test('queryfdoption01', compose(omit_ways(['ghci']), compose(only_compiler_types(['ghc']), conf)), compile_and_run, ['-package unix']) test('getEnvironment01', conf, compile_and_run, ['-package unix']) +test('getEnvironment02', conf, compile_and_run, ['-package unix']) test('getGroupEntryForName', compose(conf, exit_code(1)), compile_and_run, ['-package unix']) test('getUserEntryForName', compose(conf, exit_code(1)), compile_and_run, @@ -46,6 +47,11 @@ test('fileStatus', compile_and_run, ['-package unix']) +test('fileStatusByteString', + extra_clean(['dir', 'regular', 'link-dir', 'link-regular']), + compile_and_run, + ['-package unix']) + test('1185', [ expect_fail_for(['threaded2']) ], compile_and_run, ['-package unix']) diff --git a/tests/fileStatus.hs b/tests/fileStatus.hs index a393d72..e1d1661 100644 --- a/tests/fileStatus.hs +++ b/tests/fileStatus.hs @@ -14,9 +14,14 @@ main = do testSymlink fs ds cleanup +regular = "regular" +dir = "dir" +link_regular = "link-regular" +link_dir = "link-dir" + testRegular = do - createFile "regular" ownerReadMode - (fs, _) <- getStatus "regular" + createFile regular ownerReadMode + (fs, _) <- getStatus regular let expected = (False,False,False,True,False,False,False) actual = snd (statusElements fs) when (actual /= expected) $ @@ -24,8 +29,8 @@ testRegular = do return fs testDir = do - createDirectory "dir" ownerReadMode - (ds, _) <- getStatus "dir" + createDirectory dir ownerReadMode + (ds, _) <- getStatus dir let expected = (False,False,False,False,True,False,False) actual = snd (statusElements ds) when (actual /= expected) $ @@ -33,10 +38,10 @@ testDir = do return ds testSymlink fs ds = do - createSymbolicLink "regular" "link-regular" - createSymbolicLink "dir" "link-dir" - (fs', ls) <- getStatus "link-regular" - (ds', lds) <- getStatus "link-dir" + 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) @@ -55,9 +60,9 @@ testSymlink fs ds = do fail "status for a directory does not match when it's accessed via a symlink" cleanup = do - ignoreIOExceptions $ removeDirectory "dir" + ignoreIOExceptions $ removeDirectory dir mapM_ (ignoreIOExceptions . removeLink) - ["regular", "link-regular", "link-dir"] + [regular, link_regular, link_dir] ignoreIOExceptions io = io `E.catch` ((\_ -> return ()) :: IOException -> IO ()) diff --git a/tests/fileStatusByteString.hs b/tests/fileStatusByteString.hs new file mode 100644 index 0000000..35d52d8 --- /dev/null +++ b/tests/fileStatusByteString.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- GHC trac #2969 + +import System.Posix.ByteString +import Control.Exception as E +import Control.Monad + +main = do + cleanup + fs <- testRegular + ds <- testDir + testSymlink fs ds + cleanup + +regular = "regular2" +dir = "dir2" +link_regular = "link-regular2" +link_dir = "link-dir2" + +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 status 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 status 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 status bits for symlink to regular file" + + when (actualD /= expected) $ + fail "unexpected file status 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 + ignoreIOExceptions $ removeDirectory dir + mapM_ (ignoreIOExceptions . removeLink) + [regular, link_regular, link_dir] + +ignoreIOExceptions io = io `E.catch` + ((\_ -> return ()) :: IOException -> IO ()) + +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 + ) diff --git a/tests/getEnvironment02.hs b/tests/getEnvironment02.hs new file mode 100644 index 0000000..be920df --- /dev/null +++ b/tests/getEnvironment02.hs @@ -0,0 +1,8 @@ + +-- test for trac #781 (GHCi on x86_64, cannot link to static data in +-- shared libs) + +import System.Posix.Env.ByteString + +main = getEnvironment >>= (print . (0 <=) . length) + diff --git a/tests/getEnvironment02.stdout b/tests/getEnvironment02.stdout new file mode 100644 index 0000000..0ca9514 --- /dev/null +++ b/tests/getEnvironment02.stdout @@ -0,0 +1 @@ +True -- cgit v1.2.3