diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2025-05-31 16:54:42 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2025-05-31 16:54:42 +0200 |
| commit | 17fb83b2289f527d4242a7b66df963b56f850f2e (patch) | |
| tree | b64d549ddc4e681471d8f89ea6cae5faea89907e /src | |
| parent | 3a314a0b236d975033a329e98c27e9f35677e2df (diff) | |
Diffstat (limited to 'src')
| -rw-r--r-- | src/Parser/Shell.hs | 2 | ||||
| -rw-r--r-- | src/Script/Shell.hs | 5 |
2 files changed, 6 insertions, 1 deletions
diff --git a/src/Parser/Shell.hs b/src/Parser/Shell.hs index 09f953c..89595e8 100644 --- a/src/Parser/Shell.hs +++ b/src/Parser/Shell.hs @@ -67,11 +67,13 @@ parseArguments = foldr (liftA2 (:)) (Pure []) <$> many parseArgument shellStatement :: TestParser (Expr [ ShellStatement ]) shellStatement = label "shell statement" $ do + line <- getSourceLine command <- parseArgument args <- parseArguments return $ fmap (: []) $ ShellStatement <$> command <*> args + <*> pure line shellScript :: TestParser (Expr ShellScript) shellScript = do diff --git a/src/Script/Shell.hs b/src/Script/Shell.hs index 8f25ab5..b00dc5f 100644 --- a/src/Script/Shell.hs +++ b/src/Script/Shell.hs @@ -23,18 +23,20 @@ import Network import Output import Process import Run.Monad +import Script.Var data ShellStatement = ShellStatement { shellCommand :: Text , shellArguments :: [ Text ] + , shellSourceLine :: SourceLine } newtype ShellScript = ShellScript [ ShellStatement ] executeScript :: Node -> ProcName -> MVar ExitCode -> Handle -> Handle -> Handle -> ShellScript -> TestRun () -executeScript node _ statusVar pstdin pstdout pstderr (ShellScript statements) = do +executeScript node pname statusVar pstdin pstdout pstderr (ShellScript statements) = do forM_ statements $ \ShellStatement {..} -> case shellCommand of "echo" -> liftIO $ do T.hPutStrLn pstdout $ T.intercalate " " shellArguments @@ -51,6 +53,7 @@ executeScript node _ statusVar pstdin pstdout pstderr (ShellScript statements) = liftIO (waitForProcess phandle) >>= \case ExitSuccess -> return () status -> do + outLine OutputChildFail (Just $ textProcName pname) $ "failed at: " <> textSourceLine shellSourceLine liftIO $ putMVar statusVar status throwError Failed liftIO $ putMVar statusVar ExitSuccess |