[commit: Cabal] encoding: Attempt to fix occurrences of non-Unicode Windows API (91f2d2a)

[Max Bolingbroke]

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

On branch  : encoding

http://hackage.haskell.org/trac/ghc/changeset/91f2d2a6d8884d6670d3940a7e6ff487e5563051

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

commit 91f2d2a6d8884d6670d3940a7e6ff487e5563051
Author: Max Bolingbroke <batterseapower at hotmail.com>
Date:   Tue Apr 5 07:59:55 2011 +0100

    Attempt to fix occurrences of non-Unicode Windows API

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

 Distribution/Compat/CopyFile.hs          |   11 +++++++++--
 Distribution/Simple/Build/PathsModule.hs |   26 +++++++++++++-------------
 Distribution/Simple/InstallDirs.hs       |   10 +++++-----
 3 files changed, 27 insertions(+), 20 deletions(-)

diff --git a/Distribution/Compat/CopyFile.hs b/Distribution/Compat/CopyFile.hs
index 3f0dba8..c8a5be0 100644
--- a/Distribution/Compat/CopyFile.hs
+++ b/Distribution/Compat/CopyFile.hs
@@ -40,12 +40,15 @@ import Foreign
 #endif /* __GLASGOW_HASKELL__ */
 
 #ifndef mingw32_HOST_OS
+#if __GLASGOW_HASKELL__ >= 611
+import System.Posix.Internals (withFilePath)
+#else
+import Foreign.C              (withCString)
+#endif
 import System.Posix.Types
          ( FileMode )
 import System.Posix.Internals
          ( c_chmod )
-import Foreign.C
-         ( withCString )
 #if __GLASGOW_HASKELL__ >= 608
 import Foreign.C
          ( throwErrnoPathIfMinus1_ )
@@ -66,7 +69,11 @@ setFileExecutable path = setFileMode path 0o755 -- file perms -rwxr-xr-x
 
 setFileMode :: FilePath -> FileMode -> IO ()
 setFileMode name m =
+#if __GLASGOW_HASKELL__ >= 611
+  withFilePath name $ \s -> do
+#else
   withCString name $ \s -> do
+#endif
 #if __GLASGOW_HASKELL__ >= 608
     throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m)
 #else
diff --git a/Distribution/Simple/Build/PathsModule.hs b/Distribution/Simple/Build/PathsModule.hs
index 1edbded..3419c9c 100644
--- a/Distribution/Simple/Build/PathsModule.hs
+++ b/Distribution/Simple/Build/PathsModule.hs
@@ -193,20 +193,20 @@ pkgPathEnvVar pkg_descr var =
 get_prefix_win32 :: String
 get_prefix_win32 =
   "getPrefixDirRel :: FilePath -> IO FilePath\n"++
-  "getPrefixDirRel dirRel = do \n"++
-  "  let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.\n"++
-  "  buf <- mallocArray len\n"++
-  "  ret <- getModuleFileName nullPtr buf len\n"++
-  "  if ret == 0 \n"++
-  "     then do free buf;\n"++
-  "             return (prefix `joinFileName` dirRel)\n"++
-  "     else do exePath <- peekCString buf\n"++
-  "             free buf\n"++
-  "             let (bindir,_) = splitFileName exePath\n"++
-  "             return ((bindir `minusFileName` bindirrel) `joinFileName` dirRel)\n"++
+  "getPrefixDirRel dirRel = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.\n"++
+  "  where\n"++
+  "    try_size size = allocaArray size $ \\buf -> do\n"++
+  "        ret <- c_GetModuleFileName nullPtr buf size\n"++
+  "        case ret of\n"++
+  "          0 -> return (prefix `joinFileName` dirRel)\n"++
+  "          _ | ret < size -> do\n"++
+  "              exePath <- peekCWString buf\n"++
+  "              let (bindir,_) = splitFileName exePath\n"++
+  "              return ((bindir `minusFileName` bindirrel) `joinFileName` dirRel)\n"++
+  "            | otherwise  -> try_size (size * 2)\n"++
   "\n"++
-  "foreign import stdcall unsafe \"windows.h GetModuleFileNameA\"\n"++
-  "  getModuleFileName :: Ptr () -> CString -> Int -> IO Int32\n"
+  "foreign import stdcall unsafe \"windows.h GetModuleFileNameW\"\n"++
+  "  c_GetModuleFileName :: Ptr () -> CWString -> Int -> IO Int32\n"
 
 get_prefix_hugs :: String
 get_prefix_hugs =
diff --git a/Distribution/Simple/InstallDirs.hs b/Distribution/Simple/InstallDirs.hs
index 1d7fb95..c8365d6 100644
--- a/Distribution/Simple/InstallDirs.hs
+++ b/Distribution/Simple/InstallDirs.hs
@@ -558,13 +558,13 @@ shGetFolderPath n =
 # if __HUGS__
   return Nothing
 # else
-  allocaBytes long_path_size $ \pPath -> do
+  allocaArray long_path_size $ \pPath -> do
      r <- c_SHGetFolderPath nullPtr n nullPtr 0 pPath
      if (r /= 0)
         then return Nothing
-        else do s <- peekCString pPath; return (Just s)
+        else do s <- peekCWString pPath; return (Just s)
   where
-    long_path_size      = 1024
+    long_path_size      = 1024 -- MAX_PATH is 260, this should be plenty
 # endif
 
 csidl_PROGRAM_FILES :: CInt
@@ -572,12 +572,12 @@ csidl_PROGRAM_FILES = 0x0026
 -- csidl_PROGRAM_FILES_COMMON :: CInt
 -- csidl_PROGRAM_FILES_COMMON = 0x002b
 
-foreign import stdcall unsafe "shlobj.h SHGetFolderPathA"
+foreign import stdcall unsafe "shlobj.h SHGetFolderPathW"
             c_SHGetFolderPath :: Ptr ()
                               -> CInt
                               -> Ptr ()
                               -> CInt
-                              -> CString
+                              -> CWString
                               -> IO CInt
 #endif