diff options
| -rw-r--r-- | README.md | 3 | ||||
| -rw-r--r-- | src/Script/Shell.hs | 16 | ||||
| -rw-r--r-- | test/asset/shell/error-exit.et | 18 | ||||
| -rw-r--r-- | test/script/shell.et | 26 |
4 files changed, 61 insertions, 2 deletions
@@ -416,6 +416,9 @@ Where `<node>` is the network node on which to run the script (it will be run in and `<name>`, if given, is the name of the variable that will refer to the shell process (this can be used e.g. in the `expect` command to check the standard output of the script). As with the `spawn` command, the resulting process is terminated at the end of the current scope. +By default the shell process exists with failure whenever any command exits with non-zero status. +This behavior can be disabled using the `set +e` command (and re-enabled with `set -e`). + ### Functions diff --git a/src/Script/Shell.hs b/src/Script/Shell.hs index 983e40f..29e2324 100644 --- a/src/Script/Shell.hs +++ b/src/Script/Shell.hs @@ -46,6 +46,7 @@ newtype ShellScript = ShellScript [ ShellStatement ] data ShellState = ShellState { shellWorkingDirectory :: FilePath , shellOldWorkingDirectory :: FilePath + , shellExitOnError :: Bool } data ShellStatement = ShellStatement @@ -135,8 +136,9 @@ executeCommand sei@ShellExecInfo {..} st pstdin pstdout pstderr scmd@ShellComman ( getExitStatus, state' ) <- executeCommandProcess sei st (handledHandle pstdin') (handledHandle pstdout') (handledHandle pstderr') args cmdCommand let failedWithStatus status = do - liftIO $ putMVar seiStatusVar status - () <- throwError Failed + when (shellExitOnError st) $ do + liftIO $ putMVar seiStatusVar status + throwError Failed return state' mapM_ closeIfRequested [ pstdin', pstdout', pstderr' ] @@ -191,6 +193,15 @@ executeCommandProcess ShellExecInfo {..} st@ShellState {..} pstdin pstdout pstde liftIO $ hPutStrLn pstderr $ "pwd: too many arguments" return ( return (Exited (ExitFailure (-1))), st ) + "set" + | [ "+e" ] <- args -> do + return ( return (Exited ExitSuccess), st { shellExitOnError = False } ) + | [ "-e" ] <- args -> do + return ( return (Exited ExitSuccess), st { shellExitOnError = True } ) + | otherwise -> do + liftIO $ hPutStrLn pstderr $ "set: " <> T.unpack (T.unwords args) <> ": not implemented" + return ( return (Exited (ExitFailure (-1))), st ) + cmd -> liftIO $ do (_, _, _, phandle) <- createProcess_ "shell" (proc (T.unpack cmd) (map T.unpack args)) @@ -231,6 +242,7 @@ executeScript sei@ShellExecInfo {..} pstdin pstdout pstderr (ShellScript stateme let initialState = ShellState { shellWorkingDirectory = nodeDir seiNode , shellOldWorkingDirectory = nodeDir seiNode + , shellExitOnError = True } _ <- (\f -> foldM f initialState statements) $ \st ShellStatement {..} -> do executePipeline sei st (KeepHandle pstdin) (KeepHandle pstdout) (KeepHandle pstderr) shellPipeline diff --git a/test/asset/shell/error-exit.et b/test/asset/shell/error-exit.et new file mode 100644 index 0000000..feddf64 --- /dev/null +++ b/test/asset/shell/error-exit.et @@ -0,0 +1,18 @@ +test Default: + node n + shell on n as sh: + false + +test Disabled: + node n + shell on n as sh: + set +e + false + +test Enabled: + node n + shell on n as sh: + set +e + false + set -e + false diff --git a/test/script/shell.et b/test/script/shell.et index fbf385d..e63093b 100644 --- a/test/script/shell.et +++ b/test/script/shell.et @@ -123,3 +123,29 @@ test ShellWorkingDirectory: "$home" "$home" "/tmp" + + +test ShellExitOnError: + spawn as p + with p: + send "load ${scripts.path}/error-exit.et" + local: + expect /(load-.*)/ capture done + guard (done == "load-done") + + send "run Default" + expect /child-fail sh failed at: .*error-exit.et:4:9: false/ + expect /run-test-result Default failed/ + expect /run-done/ + flush + + send "run Disabled" + expect /run-test-result Disabled done/ + expect /run-done/ + flush + + send "run Enabled" + expect /child-fail sh failed at: .*error-exit.et:18:9: false/ + expect /run-test-result Enabled failed/ + expect /run-done/ + flush |