diff options
| -rw-r--r-- | src/Process.hs | 7 | ||||
| -rw-r--r-- | src/Script/Shell.hs | 4 |
2 files changed, 8 insertions, 3 deletions
diff --git a/src/Process.hs b/src/Process.hs index 31641c9..8ea345d 100644 --- a/src/Process.hs +++ b/src/Process.hs @@ -85,9 +85,10 @@ outProc otype p line = outLine otype (Just $ textProcName $ procName p) line lineReadingLoop :: MonadOutput m => Process -> Handle -> (Text -> m ()) -> m () lineReadingLoop process h act = liftIO (tryIOError (T.hGetLine h)) >>= \case - Left err - | isEOFError err -> return () - | otherwise -> outProc OutputChildFail process $ T.pack $ "IO error: " ++ show err + Left err -> do + when (not (isEOFError err)) $ do + outProc OutputChildFail process $ T.pack $ "IO error: " ++ show err + liftIO $ hClose h Right line -> do act line lineReadingLoop process h act diff --git a/src/Script/Shell.hs b/src/Script/Shell.hs index 9bbf06c..95d4fe4 100644 --- a/src/Script/Shell.hs +++ b/src/Script/Shell.hs @@ -69,6 +69,10 @@ spawnShell procNode procName script = do ( herr, pstderr ) <- liftIO $ createPipe procHandle <- fmap (Right . (, statusVar)) $ forkTestUsing forkOS $ do executeScript procNode procName statusVar pstdin pstdout pstderr script + liftIO $ do + hClose pstdin + hClose pstdout + hClose pstderr let procKillWith = Nothing let process = Process {..} |