[commit: base] encoding: Fix all calls to CString functions on Unix, add FIXMEs for Windows equivalents (43e16e6)
Max Bolingbroke
batterseapower at hotmail.com
Tue Apr 5 10:05:19 CEST 2011
Repository : ssh://darcs.haskell.org//srv/darcs/packages/base
On branch : encoding
http://hackage.haskell.org/trac/ghc/changeset/43e16e6604c99d7aa7364cb15feba6651a3b009a
>---------------------------------------------------------------
commit 43e16e6604c99d7aa7364cb15feba6651a3b009a
Author: Max Bolingbroke <batterseapower at hotmail.com>
Date: Mon Apr 4 16:21:36 2011 +0100
Fix all calls to CString functions on Unix, add FIXMEs for Windows equivalents
>---------------------------------------------------------------
GHC/Environment.hs | 6 +++++-
GHC/IO/Encoding.hs | 7 +++++--
GHC/IO/Encoding.hs-boot | 2 +-
System/Environment.hs | 17 ++++++++++++-----
System/Posix/Internals.hs | 8 ++++++++
5 files changed, 31 insertions(+), 9 deletions(-)
diff --git a/GHC/Environment.hs b/GHC/Environment.hs
index 60325b3..df1d59d 100644
--- a/GHC/Environment.hs
+++ b/GHC/Environment.hs
@@ -7,6 +7,9 @@ import Foreign
import Foreign.C
import Control.Monad
+import GHC.IO.Encoding
+import qualified GHC.Foreign as GHC
+
getFullArgs :: IO [String]
getFullArgs =
alloca $ \ p_argc ->
@@ -14,7 +17,8 @@ getFullArgs =
getFullProgArgv p_argc p_argv
p <- fromIntegral `liftM` peek p_argc
argv <- peek p_argv
- peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString
+ -- FIXME: we should use GetCommandLineW on Windows instead
+ peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString fileSystemEncoding)
foreign import ccall unsafe "getFullProgArgv"
getFullProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
diff --git a/GHC/IO/Encoding.hs b/GHC/IO/Encoding.hs
index ac16ee4..78c8c15 100644
--- a/GHC/IO/Encoding.hs
+++ b/GHC/IO/Encoding.hs
@@ -100,7 +100,10 @@ utf32be = UTF32.utf32be
localeEncoding :: TextEncoding
-- | The Unicode encoding of the current locale, but allowing arbitrary
--- undecodable bytes to be round-tripped through it
+-- undecodable bytes to be round-tripped through it.
+--
+-- This 'TextEncoding' is also used to decode command line arguments
+-- and environment variables.
fileSystemEncoding :: TextEncoding
-- | The Unicode encoding of the current locale, but where undecodable
@@ -114,7 +117,7 @@ fileSystemEncoding = Iconv.localeEncodingFailingWith SurrogateEscapeFailure
foreignEncoding = Iconv.localeEncodingFailingWith IgnoreCodingFailure
#else
localeEncoding = CodePage.localeEncoding
-fileSystemEncoding = CodePage.localeEncoding -- On Windows, this is rarely used. FilePaths will always be Unicode
+fileSystemEncoding = CodePage.localeEncoding -- On Windows, this *should not* be used. Strings should be retrieved via *W APIs instead
foreignEncoding = CodePage.localeEncodingFailingWith IgnoreCodingFailure
#endif
diff --git a/GHC/IO/Encoding.hs-boot b/GHC/IO/Encoding.hs-boot
index 20db97e..9223cc3 100644
--- a/GHC/IO/Encoding.hs-boot
+++ b/GHC/IO/Encoding.hs-boot
@@ -3,4 +3,4 @@ module GHC.IO.Encoding where
import GHC.IO.Encoding.Types
-localeEncoding, foreignEncoding :: TextEncoding
\ No newline at end of file
+localeEncoding, fileSystemEncoding, foreignEncoding :: TextEncoding
\ No newline at end of file
diff --git a/System/Environment.hs b/System/Environment.hs
index 2b6dec2..a9dc7ba 100644
--- a/System/Environment.hs
+++ b/System/Environment.hs
@@ -38,6 +38,8 @@ import Control.Exception.Base ( bracket )
import Control.Monad
-- import GHC.IO
import GHC.IO.Exception
+import GHC.IO.Encoding (fileSystemEncoding)
+import qualified GHC.Foreign as GHC
#endif
#ifdef __HUGS__
@@ -66,7 +68,8 @@ getArgs =
getProgArgv p_argc p_argv
p <- fromIntegral `liftM` peek p_argc
argv <- peek p_argv
- peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString
+ -- FIXME: we should use GetCommandLineW on Windows instead
+ peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString fileSystemEncoding)
foreign import ccall unsafe "getProgArgv"
@@ -92,7 +95,8 @@ getProgName =
unpackProgName :: Ptr (Ptr CChar) -> IO String -- argv[0]
unpackProgName argv = do
- s <- peekElemOff argv 0 >>= peekCString
+ -- FIXME: we should use GetCommandLineW on Windows instead
+ s <- peekElemOff argv 0 >>= GHC.peekCString fileSystemEncoding
return (basename s)
where
basename :: String -> String
@@ -121,10 +125,11 @@ unpackProgName argv = do
getEnv :: String -> IO String
getEnv name =
+ -- FIXME: should use GetEnvironmentVariableW on Windows instead
withCString name $ \s -> do
litstring <- c_getenv s
if litstring /= nullPtr
- then peekCString litstring
+ then GHC.peekCString fileSystemEncoding litstring
else ioException (IOError Nothing NoSuchThing "getEnv"
"no environment variable" Nothing (Just name))
@@ -169,7 +174,8 @@ freeArgv argv = do
setArgs :: [String] -> IO (Ptr CString)
setArgs argv = do
- vs <- mapM newCString argv >>= newArray0 nullPtr
+ -- FIXME: should iterate SetEnvironmentVariable on Windows instead
+ vs <- mapM (GHC.newCString fileSystemEncoding) argv >>= newArray0 nullPtr
setArgsPrim (genericLength argv) vs
return vs
@@ -184,10 +190,11 @@ foreign import ccall unsafe "setProgArgv"
getEnvironment :: IO [(String, String)]
getEnvironment = do
+ -- FIXME: we should use GetEnvironmentStringsW on Windows instead
pBlock <- getEnvBlock
if pBlock == nullPtr then return []
else do
- stuff <- peekArray0 nullPtr pBlock >>= mapM peekCString
+ stuff <- peekArray0 nullPtr pBlock >>= mapM (GHC.peekCString fileSystemEncoding)
return (map divvy stuff)
where
divvy str =
diff --git a/System/Posix/Internals.hs b/System/Posix/Internals.hs
index 9cc56c3..971dc17 100644
--- a/System/Posix/Internals.hs
+++ b/System/Posix/Internals.hs
@@ -52,6 +52,10 @@ import GHC.IO
import GHC.IO.IOMode
import GHC.IO.Exception
import GHC.IO.Device
+#ifndef mingw32_HOST_OS
+import {-# SOURCE #-} GHC.IO.Encoding (fileSystemEncoding)
+import qualified GHC.Foreign as GHC
+#endif
#elif __HUGS__
import Hugs.Prelude (IOException(..), IOErrorType(..))
import Hugs.IO (IOMode(..))
@@ -175,8 +179,12 @@ withFilePath :: FilePath -> (CWString -> IO a) -> IO a
withFilePath = withCWString
#else
withFilePath :: FilePath -> (CString -> IO a) -> IO a
+#if __GLASGOW_HASKELL__
+withFilePath = GHC.withCString fileSystemEncoding
+#else
withFilePath = withCString
#endif
+#endif
-- ---------------------------------------------------------------------------
-- Terminal-related stuff
More information about the Cvs-libraries
mailing list