[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit 4017f8cae2a9cf0414608bec524a8d6f39ba9b2c
Author: John Goerzen <jgoerzen at complete.org>
Date:   Mon Dec 26 09:48:18 2005 +0100

    Make the streamHandler use locking to keep log messages from stomping over each other

diff --git a/MissingH/Logging/Handler/Simple.hs b/MissingH/Logging/Handler/Simple.hs
index 792349f..c5e6db9 100644
--- a/MissingH/Logging/Handler/Simple.hs
+++ b/MissingH/Logging/Handler/Simple.hs
@@ -1,5 +1,5 @@
 {- arch-tag: Simple log handlers
-Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
+Copyright (C) 2004-2005 John Goerzen <jgoerzen at complete.org>
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
 {- |
    Module     : MissingH.Logging.Handler.Simple
-   Copyright  : Copyright (C) 2004 John Goerzen
+   Copyright  : Copyright (C) 2004-2005 John Goerzen
    License    : GNU GPL, version 2 or above
 
    Maintainer : John Goerzen <jgoerzen at complete.org> 
@@ -36,6 +36,7 @@ module MissingH.Logging.Handler.Simple(streamHandler, fileHandler)
 import MissingH.Logging
 import MissingH.Logging.Handler
 import IO
+import Control.Concurrent.MVar
 
 
 data GenericHandler a = GenericHandler {priority :: Priority,
@@ -57,10 +58,14 @@ instance LogHandler (GenericHandler a) where
 
 streamHandler :: Handle -> Priority -> IO (GenericHandler Handle)
 streamHandler h pri = 
-    return (GenericHandler {priority = pri,
-                            privData = h,
-                            writeFunc = hPutStrLn,
-                            closeFunc = \x -> return ()})
+    do lock <- newMVar ()
+       let mywritefunc hdl msg = withMVar lock (\_ -> do hPutStrLn hdl msg
+                                                         hFlush hdl
+                                               )
+       return (GenericHandler {priority = pri,
+                               privData = h,
+                               writeFunc = mywritefunc,
+                               closeFunc = \x -> return ()})
 
 {- | Create a file log handler.  Log messages sent to this handler
    will be sent to the filename specified, which will be opened

-- 
haskell-testpack