From 338ac0efb3d2e2a258d949268ed6b27b3ecae1a0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Thu, 15 May 2025 20:20:25 +0200 Subject: Extra arguments for the spawned tool Changelog: Added `args` parameter to `spawn` command to pass extra command-line arguments to the spawend tool --- README.md | 3 ++- src/Parser/Statement.hs | 1 + src/Run.hs | 6 ++++-- src/Test.hs | 2 +- 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 [on ] Create a node on network `` (or context network if omitted) and assign the new node to the variable ``. ``` -spawn as [on ( | )] +spawn as [on ( | )] [args ] ``` Spawn a new test process on `` or `` (or one from context) and assign the new process to variable ``. When spawning on network, create a new node for this process. +Extra `` to the tool can be given as a list of strings using the `args` keyword. The process is terminated when the variable `` 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 -- cgit v1.2.3