From 338ac0efb3d2e2a258d949268ed6b27b3ecae1a0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
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
---
 src/Parser/Statement.hs | 1 +
 src/Run.hs              | 6 ++++--
 src/Test.hs             | 2 +-
 3 files changed, 6 insertions(+), 3 deletions(-)

(limited to 'src')

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