[commit: base] master: Change some uses of CString functions to CAString instead (a8927d2)

3 Apr 2011

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/a8927d235f8189bcd05df3bc4c130a...
...
---------------------------------------------------------------
commit a8927d235f8189bcd05df3bc4c130a9a184672e4
Author: Max Bolingbroke 
Date:   Sun Apr 3 22:36:39 2011 +0100

    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.
...
---------------------------------------------------------------
GHC/IO/Encoding/Iconv.hs |   25 +++++++++++++++----------
 GHC/IO/Encoding/UTF16.hs |    3 ++-
 2 files changed, 17 insertions(+), 11 deletions(-)

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

    

Max Bolingbroke

tags

participants (1)