From: Max Bolingbroke <batterseapower@hotmail.com>
Date: Sun, 3 Apr 2011 21:36:39 +0000 (+0100)
Subject: Change some uses of CString functions to CAString instead
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=a8927d235f8189bcd05df3bc4c130a9a184672e4;p=ghc-base.git

Change some uses of CString functions to CAString instead

This prevents potential loops in future if we implement
FFI spec behaviour where the CString family use the locale encoding.
---

diff --git a/GHC/IO/Encoding/Iconv.hs b/GHC/IO/Encoding/Iconv.hs
index 440344a..6d87595 100644
--- a/GHC/IO/Encoding/Iconv.hs
+++ b/GHC/IO/Encoding/Iconv.hs
@@ -57,7 +57,8 @@ iconv_trace s
  | otherwise    = return ()
 
 puts :: String -> IO ()
-puts s = do _ <- withCStringLen (s ++ "\n") $ \(p, len) ->
+puts s = do _ <- withCAStringLen (s ++ "\n") $ \(p, len) ->
+                      -- In reality should be withCString, but assume ASCII to avoid loop
                      c_write 1 (castPtr p) (fromIntegral len)
             return ()
 
@@ -96,14 +97,17 @@ utf32le = unsafePerformIO (mkTextEncoding "UTF32LE")
 utf32be :: TextEncoding
 utf32be = unsafePerformIO (mkTextEncoding "UTF32BE")
 
-{-# NOINLINE localeEncoding #-}
-localeEncoding :: TextEncoding
-localeEncoding = unsafePerformIO $ do
+{-# NOINLINE localeEncodingName #-}
+localeEncodingName :: String
+localeEncodingName = unsafePerformIO $ do
    -- Use locale_charset() or nl_langinfo(CODESET) to get the encoding
    -- if we have either of them.
    cstr <- c_localeEncoding
-   r <- peekCString cstr
-   mkTextEncoding r
+   peekCAString cstr -- Assume charset names are ASCII
+
+{-# NOINLINE localeEncoding #-}
+localeEncoding :: TextEncoding
+localeEncoding = unsafePerformIO $ mkTextEncoding localeEncodingName
 
 -- We hope iconv_t is a storable type.  It should be, since it has at least the
 -- value -1, which is a possible return value from iconv_open.
@@ -139,8 +143,8 @@ mkTextEncoding :: String -> IO TextEncoding
 mkTextEncoding charset = do
   return (TextEncoding { 
                 textEncodingName = charset,
-		mkTextDecoder = newIConv raw_charset (haskellChar ++ suffix) (iconvDecode cfm),
-		mkTextEncoder = newIConv haskellChar charset (iconvEncode cfm)})
+		mkTextDecoder = newIConv raw_charset (haskellChar ++ suffix) iconvDecode,
+		mkTextEncoder = newIConv haskellChar charset iconvEncode})
   where
     -- An annoying feature of GNU iconv is that the //PREFIXES only take
     -- effect when they appear on the tocode parameter to iconv_open:
@@ -150,8 +154,9 @@ newIConv :: String -> String
    -> (IConv -> Buffer a -> Buffer b -> IO (Buffer a, Buffer b))
    -> IO (BufferCodec a b ())
 newIConv from to fn =
-  withCString from $ \ from_str ->
-  withCString to   $ \ to_str -> do
+  -- Assume charset names are ASCII
+  withCAString from $ \ from_str ->
+  withCAString to   $ \ to_str -> do
     iconvt <- throwErrnoIfMinus1 "mkTextEncoding" $ hs_iconv_open to_str from_str
     let iclose = throwErrnoIfMinus1_ "Iconv.close" $ hs_iconv_close iconvt
     return BufferCodec{
diff --git a/GHC/IO/Encoding/UTF16.hs b/GHC/IO/Encoding/UTF16.hs
index c3b3847..5cc55f5 100644
--- a/GHC/IO/Encoding/UTF16.hs
+++ b/GHC/IO/Encoding/UTF16.hs
@@ -57,7 +57,8 @@ import GHC.Show
 import GHC.Ptr
 
 puts :: String -> IO ()
-puts s = do withCStringLen (s++"\n") $ \(p,len) -> 
+ -- In reality should be withCString, but assume ASCII to avoid possible loop
+puts s = do withCAStringLen (s++"\n") $ \(p,len) ->
                 c_write 1 (castPtr p) (fromIntegral len)
             return ()
 #endif