[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 2be0ec6b75202dd25dc552a850424e918f6171ef
Author: John Goerzen <jgoerzen at complete.org>
Date:   Sun Apr 17 21:01:37 2005 +0100

    Trying to fix pipeTo/pipeBoth

diff --git a/MissingH/Cmd.hs b/MissingH/Cmd.hs
index 4cee812..73e25ba 100644
--- a/MissingH/Cmd.hs
+++ b/MissingH/Cmd.hs
@@ -32,8 +32,23 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 Written by John Goerzen, jgoerzen\@complete.org
 
 Please note: Most of this module is not compatible with Hugs.
+
+Command lines executed will be logged using "MissingH.Logging.Logger" at the
+DEBUG level.  Failure messages will be logged at the WARNING level in addition
+to being raised as an exception.  Both are logged under
+\"MissingH.Cmd.funcname\" -- for instance,
+\"MissingH.Cmd.safeSystem\".  If you wish to suppress these messages
+globally, you can simply run:
+
+> updateGlobalLogger "MissingH.Cmd.safeSystem"
+>                     (setLevel CRITICAL)
+
+See also: 'MissingH.Logging.Logger.updateGlobalLogger',
+"MissingH.Logging.Logger".
+
 -}
 
+
 module MissingH.Cmd(-- * High-Level Tools
                     PipeHandle(..),
                     safeSystem,
@@ -65,25 +80,6 @@ data PipeMode = ReadFromPipe | WriteToPipe
 
 logbase = "MissingH.Cmd"
 
-{- | Invokes the specified command in a subprocess, waiting for the result.
-If the command terminated successfully, return normally.  Otherwise,
-raises a userError with the problem.
-
-Command lines executed will be logged using "MissingH.Logging.Logger" at the
-DEBUG level.  Failure messages will be logged at the WARNING level in addition
-to being raised as an exception.  Both are logged under
-\"MissingH.Cmd.funcname\" -- for instance,
-\"MissingH.Cmd.safeSystem\".  If you wish to suppress these messages
-globally, you can simply run:
-
-> updateGlobalLogger "MissingH.Cmd.safeSystem"
->                     (setLevel CRITICAL)
-
-See also: 'MissingH.Logging.Logger.updateGlobalLogger',
-"MissingH.Logging.Logger".
-
--}
-
 {- | Return value from 'pipeFrom', 'pipeLinesFrom', 'pipeTo', or
 'pipeBoth'.  Contains both a ProcessID and the original command that was
 executed.  If you prefer not to use 'forceSuccess' on the result of one
@@ -156,7 +152,7 @@ pipeTo fp args message =
        closeFd (fst pipepair)
        h <- fdToHandle (snd pipepair)
        finally (hPutStr h message)
-               (hClose h)
+               (hClose h >> closeFd (snd pipepair))
        return (PipeHandle pid fp args "pipeTo")
 
 {- | Like a combination of 'pipeTo' and 'pipeFrom'; forks an IO thread
@@ -183,7 +179,7 @@ pipeBoth fp args message =
        fromh <- fdToHandle (fst frompair)
        toh <- fdToHandle (snd topair)
        forkIO $ finally (hPutStr toh message)
-                        (hClose toh)
+                        (hClose toh >> closeFd (snd topair))
        c <- hGetContents fromh
        return (PipeHandle pid fp args "pipeBoth", c)
 
@@ -206,6 +202,10 @@ forceSuccess (PipeHandle pid fp args funcname) =
                 Just (Stopped sig) -> 
                     warnfail fp args $ "Stopped by signal " ++ show sig 
 
+{- | Invokes the specified command in a subprocess, waiting for the result.
+If the command terminated successfully, return normally.  Otherwise,
+raises a userError with the problem.
+-}
 safeSystem :: FilePath -> [String] -> IO ()
 safeSystem command args = 
     do

-- 
haskell-testpack