[commit: process] encoding: Attempt to fix some UNicode errors in process. It is unclear if the old environment-setting code on Windows ever worked (20a230f)

Max Bolingbroke batterseapower at hotmail.com
Tue Apr 5 10:03:21 CEST 2011


Repository : ssh://darcs.haskell.org//srv/darcs/packages/process

On branch  : encoding

http://hackage.haskell.org/trac/ghc/changeset/20a230f433238a8388fee06afa4fc99176861326

>---------------------------------------------------------------

commit 20a230f433238a8388fee06afa4fc99176861326
Author: Max Bolingbroke <batterseapower at hotmail.com>
Date:   Tue Apr 5 00:08:10 2011 +0100

    Attempt to fix some UNicode errors in process. It is unclear if the old environment-setting code on Windows ever worked

>---------------------------------------------------------------

 System/Process/Internals.hs |   21 ++++++++++++++++-----
 cbits/runProcess.c          |    2 +-
 2 files changed, 17 insertions(+), 6 deletions(-)

diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs
index c868d98..49cf69f 100644
--- a/System/Process/Internals.hs
+++ b/System/Process/Internals.hs
@@ -81,6 +81,10 @@ import GHC.IOBase	( haFD, FD, IOException(..) )
 import GHC.Handle
 #endif
 
+#if MIN_VERSION_base(4,3,2) && !defined(mingw32_HOST_OS)
+import qualified GHC.Foreign as GHC
+#endif
+
 # elif __HUGS__
 
 import Hugs.Exception	( IOException(..) )
@@ -228,8 +232,8 @@ runGenProcess_ fun CreateProcess{ cmdspec = cmdsp,
    alloca $ \ pfdStdOutput ->
    alloca $ \ pfdStdError  ->
    maybeWith withCEnvironment mb_env $ \pEnv ->
-   maybeWith withCString mb_cwd $ \pWorkDir ->
-   withMany withCString (cmd:args) $ \cstrs ->
+   maybeWith withFilePathLike mb_cwd $ \pWorkDir ->
+   withMany withFilePathLike (cmd:args) $ \cstrs ->
    withArray0 nullPtr cstrs $ \pargs -> do
      
      fdin  <- mbFd fun fd_stdin  mb_stdin
@@ -350,7 +354,7 @@ foreign import ccall unsafe "runInteractiveProcess"
   c_runInteractiveProcess
         :: CWString
         -> CWString
-        -> Ptr ()
+        -> Ptr CWString
         -> FD
         -> FD
         -> FD
@@ -360,6 +364,13 @@ foreign import ccall unsafe "runInteractiveProcess"
         -> CInt                         -- close_fds
         -> IO PHANDLE
 
+withFilePathLike :: FilePath -> (Ptr CString -> IO a) -> IO a
+#if __GLASGOW_HASKELL__ && MIN_VERSION_base(4,3,2)
+withFilePathLike = GHC.withCString fileSystemEncoding
+#else
+withFilePathLike = withCString
+#endif
+
 #endif /* __GLASGOW_HASKELL__ */
 
 #endif
@@ -591,9 +602,9 @@ withCEnvironment envir act =
   let env' = map (\(name, val) -> name ++ ('=':val)) envir 
   in withMany withCString env' (\pEnv -> withArray0 nullPtr pEnv act)
 #else
-withCEnvironment :: [(String,String)] -> (Ptr () -> IO a) -> IO a
+withCEnvironment :: [(String,String)] -> (Ptr CWString -> IO a) -> IO a
 withCEnvironment envir act =
   let env' = foldr (\(name, val) env -> name ++ ('=':val)++'\0':env) "\0" envir
-  in withCString env' (act . castPtr)
+  in withCWString env' (act . castPtr)
 #endif
 
diff --git a/cbits/runProcess.c b/cbits/runProcess.c
index 3a3d6c2..1b74d68 100644
--- a/cbits/runProcess.c
+++ b/cbits/runProcess.c
@@ -349,7 +349,7 @@ mkAnonPipe (HANDLE* pHandleIn, BOOL isInheritableIn,
 
 ProcHandle
 runInteractiveProcess (wchar_t *cmd, wchar_t *workingDirectory, 
-                       void *environment,
+                       wchar_t *environment,
                        int fdStdIn, int fdStdOut, int fdStdErr,
 		       int *pfdStdInput, int *pfdStdOutput, int *pfdStdError,
                        int close_fds)





More information about the Cvs-libraries mailing list