summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2025-05-15 20:20:25 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2025-05-15 20:20:25 +0200
commit338ac0efb3d2e2a258d949268ed6b27b3ecae1a0 (patch)
treed75471dbec089455c4f0c9539c0d38299cfe66c8
parentbe0e2017b46e981060b1f9f5fd764571ad2dc2a1 (diff)
Extra arguments for the spawned tool
Changelog: Added `args` parameter to `spawn` command to pass extra command-line arguments to the spawend tool
-rw-r--r--README.md3
-rw-r--r--src/Parser/Statement.hs1
-rw-r--r--src/Run.hs6
-rw-r--r--src/Test.hs2
4 files changed, 8 insertions, 4 deletions
diff --git a/README.md b/README.md
index 15fb488..e64f148 100644
--- a/README.md
+++ b/README.md
@@ -243,11 +243,12 @@ node <name> [on <network>]
Create a node on network `<network>` (or context network if omitted) and assign the new node to the variable `<name>`.
```
-spawn as <name> [on (<node> | <network>)]
+spawn as <name> [on (<node> | <network>)] [args <arguments>]
```
Spawn a new test process on `<node>` or `<network>` (or one from context) and assign the new process to variable `<name>`.
When spawning on network, create a new node for this process.
+Extra `<arguments>` to the tool can be given as a list of strings using the `args` keyword.
The process is terminated when the variable `<name>` goes out of scope (at the end of the block in which it was created) by closing its stdin.
When the process fails to terminate successfully within a timeout, the test fails.
diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs
index d843fc8..27e7b92 100644
--- a/src/Parser/Statement.hs
+++ b/src/Parser/Statement.hs
@@ -424,6 +424,7 @@ testSpawn :: TestParser (Expr (TestBlock ()))
testSpawn = command "spawn" $ Spawn
<$> param "as"
<*> (bimap fromExprParam fromExprParam <$> paramOrContext "on")
+ <*> (maybe [] fromExprParam <$> param "args")
<*> innerBlockFun
testExpect :: TestParser (Expr (TestBlock ()))
diff --git a/src/Run.hs b/src/Run.hs
index bc64721..329dc78 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -121,7 +121,7 @@ evalBlock (TestBlockStep prev step) = evalBlock prev >> case step of
DeclNode name net inner -> do
withNode net (Left name) $ evalBlock . inner
- Spawn tvname@(TypedVarName (VarName tname)) target inner -> do
+ Spawn tvname@(TypedVarName (VarName tname)) target args inner -> do
case target of
Left net -> withNode net (Right tvname) go
Right node -> go node
@@ -130,7 +130,9 @@ evalBlock (TestBlockStep prev step) = evalBlock prev >> case step of
opts <- asks $ teOptions . fst
let pname = ProcName tname
tool = fromMaybe (optDefaultTool opts) (lookup pname $ optProcTools opts)
- withProcess (Right node) pname Nothing tool $ evalBlock . inner
+ cmd = unwords $ tool : map (T.unpack . escape) args
+ escape = ("'" <>) . (<> "'") . T.replace "'" "'\\''"
+ withProcess (Right node) pname Nothing cmd $ evalBlock . inner
SpawnShell mbname node script inner -> do
let tname | Just (TypedVarName (VarName name)) <- mbname = name
diff --git a/src/Test.hs b/src/Test.hs
index 198b7e6..ff51ebe 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -33,7 +33,7 @@ instance Monoid (TestBlock ()) where
data TestStep a where
Subnet :: TypedVarName Network -> Network -> (Network -> TestBlock a) -> TestStep a
DeclNode :: TypedVarName Node -> Network -> (Node -> TestBlock a) -> TestStep a
- Spawn :: TypedVarName Process -> Either Network Node -> (Process -> TestBlock a) -> TestStep a
+ Spawn :: TypedVarName Process -> Either Network Node -> [ Text ] -> (Process -> TestBlock a) -> TestStep a
SpawnShell :: Maybe (TypedVarName Process) -> Node -> ShellScript -> (Process -> TestBlock a) -> TestStep a
Send :: Process -> Text -> TestStep ()
Expect :: SourceLine -> Process -> Traced Regex -> [ TypedVarName Text ] -> ([ Text ] -> TestBlock a) -> TestStep a