diff options
| -rw-r--r-- | src/Script/Shell.hs | 12 |
1 files changed, 6 insertions, 6 deletions
diff --git a/src/Script/Shell.hs b/src/Script/Shell.hs index 60ec929..8f25ab5 100644 --- a/src/Script/Shell.hs +++ b/src/Script/Shell.hs @@ -33,8 +33,8 @@ data ShellStatement = ShellStatement newtype ShellScript = ShellScript [ ShellStatement ] -executeScript :: Node -> ProcName -> Handle -> Handle -> Handle -> ShellScript -> TestRun () -executeScript node pname pstdin pstdout pstderr (ShellScript statements) = do +executeScript :: Node -> ProcName -> MVar ExitCode -> Handle -> Handle -> Handle -> ShellScript -> TestRun () +executeScript node _ statusVar pstdin pstdout pstderr (ShellScript statements) = do forM_ statements $ \ShellStatement {..} -> case shellCommand of "echo" -> liftIO $ do T.hPutStrLn pstdout $ T.intercalate " " shellArguments @@ -50,9 +50,10 @@ executeScript node pname pstdin pstdout pstderr (ShellScript statements) = do } liftIO (waitForProcess phandle) >>= \case ExitSuccess -> return () - ExitFailure code -> do - outLine OutputChildFail (Just $ textProcName pname) $ T.pack $ "exit code: " ++ show code + status -> do + liftIO $ putMVar statusVar status throwError Failed + liftIO $ putMVar statusVar ExitSuccess spawnShell :: Node -> ProcName -> ShellScript -> TestRun Process spawnShell procNode procName script = do @@ -62,8 +63,7 @@ spawnShell procNode procName script = do ( hout, pstdout ) <- liftIO $ createPipe ( herr, pstderr ) <- liftIO $ createPipe procHandle <- fmap (Right . (, statusVar)) $ forkTest $ do - executeScript procNode procName pstdin pstdout pstderr script - liftIO $ putMVar statusVar ExitSuccess + executeScript procNode procName statusVar pstdin pstdout pstderr script let procKillWith = Nothing let process = Process {..} |