com 1.2.0 → 1.2.1

raw patch · 12 files changed

+55/−26 lines, 12 filesdep −haskell98dep ~base

Dependencies removed: haskell98

Dependency ranges changed: base

Files

CHANGES +7/−0
System/Win32/Com.hs +1/−1
System/Win32/Com/Automation.hs +4/−5
System/Win32/Com/Automation/Base.hs +1/−1
System/Win32/Com/Base.hs +1/−1
System/Win32/Com/Exception.hs +1/−1
System/Win32/Com/HDirect/HDirect.hs +12/−2
System/Win32/Com/Server.hs +2/−2
cbits/PointerSrc.c +2/−1
cbits/WideStringSrc.c +3/−0
com.cabal +17/−12
include/PointerSrc.h +4/−0

+ CHANGES view

@@ -0,0 +1,7 @@+Version 1.2.1 - released 2009-01-19; changes from 1.2.0
+
+  * fix bad mix of allocators, the accidental introduction of the
+    combined use of the CRT one (malloc()) and the COM task allocaotr
+    led to spurious MM crashes.
+  * drop 'haskell98' dependencies
+

System/Win32/Com.hs view

@@ -224,7 +224,7 @@ import Foreign.ForeignPtr
 import Foreign.Storable
 import Data.Bits
-import IO         ( bracket ) 
+import Control.Exception ( bracket ) 
 
 infixl 1 #
 infixl 0 ##

System/Win32/Com/Automation.hs view

@@ -138,9 +138,8 @@     ) where
 
 import System.Win32.Com.HDirect.HDirect as HDirect
-import IO          ( ioeGetErrorString )
-import Data.Char   ( chr, ord )
-import System.Time ( ClockTime(..) )
+import System.IO.Error ( ioeGetErrorString )
+import System.Time     ( ClockTime(..) )
 
 import Data.Word ( Word8, Word16, Word32 )
 import Data.Int  ( Int32, Int16, Int8, Int64 )
@@ -729,10 +728,10 @@ defaultChar            = '\0'
 
 inChar :: ArgIn Char
-inChar i               = writeVarByte (fromIntegral (ord i))
+inChar i               = writeVarByte (fromIntegral (fromEnum i))
 
 resChar :: ArgRes Char
-resChar  p             = readVarByte p >>= \ x -> return (chr (fromIntegral x))
+resChar  p             = readVarByte p >>= \ x -> return (toEnum (fromIntegral x))
 
 inoutChar i            = (inChar i,resChar)
 outChar                = inoutChar defaultChar

System/Win32/Com/Automation/Base.hs view

@@ -21,7 +21,7 @@ import Data.Int  (Int32, Int16)
 import Data.Word (Word8, Word32)
 import Foreign.ForeignPtr ( ForeignPtr, withForeignPtr )
-import Foreign.Ptr
+import Foreign.Ptr ( castPtr ) 
 
 data VARIANT_ = VARIANT_
 type VARIANT = Ptr VARIANT_

System/Win32/Com/Base.hs view

@@ -17,7 +17,7 @@ import System.IO.Unsafe ( unsafePerformIO )
 import System.Win32.Com.HDirect.WideString ( WideString, marshallWideString, freeWideString,
 		    readWideString, writeWideString )
-import IO         ( hPutStrLn, stderr )
+import System.IO        ( hPutStrLn, stderr )
 
 import Control.Exception
 import Data.Typeable

System/Win32/Com/Exception.hs view

@@ -22,7 +22,7 @@ import Data.Dynamic
 import Data.Maybe ( isJust, fromMaybe )
 import Numeric ( showHex )
-import IO
+import System.IO.Error ( ioeGetErrorString )
 
 #if BASE == 3
 import GHC.IOBase

System/Win32/Com/HDirect/HDirect.hs view

@@ -54,7 +54,8 @@ import Foreign.Ptr
 import Foreign.C.Types ( CChar )
 import Foreign.C.String
-import Foreign.Marshal.Alloc (mallocBytes, free)
+import Foreign.Marshal.Alloc (mallocBytes)
+import qualified Foreign.Marshal.Alloc as Alloc (free)
 
 import Data.Bits
 #if __GLASGOW_HASKELL__ >= 505
@@ -407,9 +408,18 @@ allocWords :: Int -> IO (Ptr a)
 allocWords len = alloc (4 * fromIntegral len)
 
+alloc_malloc :: Word32 -> IO (Ptr a)
+alloc_malloc s = mallocBytes (fromIntegral s)
 
+free_malloc = Alloc.free
+
+free = freeMemory
+
+-- Note: we want/have to use the COM task allocator here so as to
+-- remain consistent (=> finalization happens by calling one allocator,
+-- it being the COM one.)
 alloc :: Word32 -> IO (Ptr a)
-alloc s = mallocBytes (fromIntegral s)
+alloc s = allocMemory s
 
 doThenFree ::(Ptr a -> IO ()) -> (Ptr b -> IO c) -> Ptr d -> IO c
 doThenFree f act ptr = do

System/Win32/Com/Server.hs view

@@ -100,8 +100,8 @@ import System.Win32.Com.Exception
 import System.Win32.Com.HDirect.WideString
 
-import Monad
-import List
+import Control.Monad
+import Data.List
 
 --Basic types - we're essentially untyped here; safety is provided
 --by the abstraction levels above us.

cbits/PointerSrc.c view

@@ -4,6 +4,7 @@ 
 #if defined(__CYGWIN32__) || defined(__MINGW32__) || defined(__CYGWIN__)
 #define __BASTARDIZED_WIN32__ 1
+#define COM 1
 #endif
 
 /*-----------------------------------------------------------
@@ -120,7 +121,7 @@    if (!p) printf( "freeing null pointer\n" );
  #endif
    if (!p) return;
- #ifdef DEBUG
+ #if defined(DEBUG)
    if (p) nallocs--;
    printf( "free: %p\n", p);
  #endif

cbits/WideStringSrc.c view

@@ -6,6 +6,9 @@ #define DLLEXPORT(res)  extern res
 #endif
 
+#ifndef COM
+#define COM
+#endif
 
 #ifdef COM
 #define COBJMACROS

com.cabal view

@@ -1,5 +1,5 @@ Name: com
-version: 1.2.0
+version: 1.2.1
 Synopsis: Haskell COM support library
 Description: 
     COM + Automation libraries for Haskell.
@@ -19,14 +19,15 @@           include/safeArrayPrim.h
           include/SafeArray.h
           include/StdTypes.h
+          CHANGES
 
 flag old-base
   description: Old, monolithic base
   default: False
 
 library {
-Build-depends: haskell98, old-time
-Exposed-Modules: System.Win32.Com,
+if os(windows)
+ Exposed-Modules: System.Win32.Com,
                  System.Win32.Com.Base,
                  System.Win32.Com.Automation,
                  System.Win32.Com.Automation.Base,
@@ -48,9 +49,9 @@                  System.Win32.Com.HDirect.PointerPrim,
                  System.Win32.Com.HDirect.WideString
                  
-Include-dirs: . cbits include
+ Include-dirs: . cbits include
 
-Includes: include/PointerSrc.h
+ Includes: include/PointerSrc.h
           include/WideStringSrc.h
           include/comPrim.h
           include/autoPrim.h
@@ -59,24 +60,28 @@           include/SafeArray.h
           include/StdTypes.h
 
-C-Sources: cbits/PointerSrc.c
+ C-Sources: cbits/PointerSrc.c
            cbits/WideStringSrc.c
            cbits/ComPrimSrc.c
            cbits/AutoPrimSrc.c
            cbits/Registry.c
            cbits/SafeArrayPrim.c
 
-Extra-libraries: kernel32, user32, ole32, oleaut32, advapi32
-GHC-Options: -fglasgow-exts -fvia-C 
+ Extra-libraries: kernel32, user32, ole32, oleaut32, advapi32
+ GHC-Options: -fglasgow-exts -fvia-C 
 -- I can't seem to feed this into the 'ld' invocation that creates the
 -- relocatable object file.
-Ld-options: --enable-stdcall-fixup --disable-stdcall-fixup
-Extensions: CPP
+ Ld-options: --enable-stdcall-fixup --disable-stdcall-fixup
+ Extensions: CPP
 
-if flag(old-base)
+ Build-depends: old-time
+ if flag(old-base)
   Build-Depends: base < 4
   CPP-Options: -DBASE=3
-else
+ else
   Build-Depends: base >= 4
   CPP-Options: -DBASE=4
+else
+ Build-Depends: base
+
 }

include/PointerSrc.h view

@@ -9,6 +9,10 @@ #define SUPPORT_COM 1
 #endif
 
+#ifndef COM
+#define COM 1
+#endif
+
 extern void   primNoFree(void* p);
 extern void   primPointerCheck();
 extern void   primFinalise(void* f, void* a);