diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Parser/Shell.hs | 5 | ||||
| -rw-r--r-- | src/Parser/Statement.hs | 11 | ||||
| -rw-r--r-- | src/Run.hs | 10 | ||||
| -rw-r--r-- | src/Test.hs | 4 |
4 files changed, 18 insertions, 12 deletions
diff --git a/src/Parser/Shell.hs b/src/Parser/Shell.hs index 0f34fee..a61352d 100644 --- a/src/Parser/Shell.hs +++ b/src/Parser/Shell.hs @@ -22,6 +22,7 @@ import Script.Shell parseArgument :: TestParser (Expr Text) parseArgument = lexeme $ fmap (App AnnNone (Pure T.concat) <$> foldr (liftA2 (:)) (Pure [])) $ some $ choice [ doubleQuotedString + , singleQuotedString , escapedChar , stringExpansion , unquotedString @@ -44,6 +45,10 @@ parseArgument = lexeme $ fmap (App AnnNone (Pure T.concat) <$> foldr (liftA2 (:) ] App AnnNone (Pure T.concat) . foldr (liftA2 (:)) (Pure []) <$> inner + singleQuotedString :: TestParser (Expr Text) + singleQuotedString = do + Pure . TL.toStrict <$> (char '\'' *> takeWhileP Nothing (/= '\'') <* char '\'') + escapedChar :: TestParser (Expr Text) escapedChar = do void $ char '\\' diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs index 812c559..27e7b92 100644 --- a/src/Parser/Statement.hs +++ b/src/Parser/Statement.hs @@ -98,12 +98,6 @@ shellStatement = do , do off <- stateOffset <$> getParserState symbol ":" - pname <- case mbpname of - Just pname -> return pname - Nothing -> do - registerParseError $ FancyError off $ S.singleton $ ErrorFail $ - "missing parameter with keyword ‘as’" - return $ TypedVarName (VarName "") node <- case mbnode of Just node -> return node Nothing -> do @@ -115,8 +109,10 @@ shellStatement = do void $ L.indentGuard scn GT ref script <- shellScript cont <- testBlock ref + let expr | Just pname <- mbpname = LambdaAbstraction pname cont + | otherwise = const <$> cont return $ TestBlockStep EmptyTestBlock <$> - (SpawnShell pname <$> node <*> script <*> LambdaAbstraction pname cont) + (SpawnShell mbpname <$> node <*> script <*> expr) ] exprStatement :: TestParser (Expr (TestBlock ())) @@ -428,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 ())) @@ -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,9 +130,13 @@ 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 (TypedVarName (VarName tname)) node script inner -> do + SpawnShell mbname node script inner -> do + let tname | Just (TypedVarName (VarName name)) <- mbname = name + | otherwise = "shell" let pname = ProcName tname withShellProcess node pname script $ evalBlock . inner diff --git a/src/Test.hs b/src/Test.hs index b8c5049..ff51ebe 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -33,8 +33,8 @@ 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 - SpawnShell :: TypedVarName Process -> Node -> ShellScript -> (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 Flush :: Process -> Maybe Regex -> TestStep () |