diff options
| -rw-r--r-- | src/Parser/Statement.hs | 5 | ||||
| -rw-r--r-- | test/asset/network/disconnect_node.et | 27 | ||||
| -rw-r--r-- | test/asset/network/disconnect_nodes.et | 46 | ||||
| -rw-r--r-- | test/script/network.et | 28 |
4 files changed, 105 insertions, 1 deletions
diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs index 67f2f88..1c1b805 100644 --- a/src/Parser/Statement.hs +++ b/src/Parser/Statement.hs @@ -295,7 +295,7 @@ instance ExprType a => ParamType (InnerBlock a) where combine _ [] = error "inner block parameter count mismatch" innerBlock :: CommandDef (TestStep ()) -innerBlock = ($ ([] :: [ Void ])) <$> innerBlockFun +innerBlock = ($ ([] :: [ Void ])) <$> innerBlockFunList innerBlockFun :: ExprType a => CommandDef (a -> TestStep ()) innerBlockFun = (\f x -> f [ x ]) <$> innerBlockFunList @@ -336,6 +336,9 @@ command name (CommandDef types ctor) = do , Just (Refl :: p :~: InnerBlock a) <- eqT -> SomeParam p . Identity . ( vars, ) <$> restOfParts cmdi partials + | Just (Refl :: p :~: InnerBlock Void) <- eqT + -> SomeParam p . Identity . ( [], ) <$> restOfParts cmdi partials + (sym, SomeParam p Nothing) -> choice [ SomeParam p . Identity <$> paramDefault p , fail $ "missing " ++ (if null sym then "" else "'" ++ sym ++ "' ") ++ showParamType p diff --git a/test/asset/network/disconnect_node.et b/test/asset/network/disconnect_node.et new file mode 100644 index 0000000..a9450a7 --- /dev/null +++ b/test/asset/network/disconnect_node.et @@ -0,0 +1,27 @@ +test Test: + node n1 + node n2 + node n3 + + local: + shell on n1: + ping ${n3.ip} -c 1 + + shell on n2: + ping ${n3.ip} -c 1 + + local: + disconnect_node n1 + + shell on n1: + ! ping ${n3.ip} -c 1 + + shell on n2: + ping ${n3.ip} -c 1 + + local: + shell on n1: + ping ${n3.ip} -c 1 + + shell on n2: + ping ${n3.ip} -c 1 diff --git a/test/asset/network/disconnect_nodes.et b/test/asset/network/disconnect_nodes.et new file mode 100644 index 0000000..9469024 --- /dev/null +++ b/test/asset/network/disconnect_nodes.et @@ -0,0 +1,46 @@ +test Test: + subnet s1 + node n1_1 on s1 + node n1_2 on s1 + + subnet s2 + node n2_1 on s2 + node n2_2 on s2 + + subnet s3 + node n3 on s3 + + local: + shell on n1_1: + ping ${n1_2.ip} -c 1 -W 0.001 + ping ${n2_2.ip} -c 1 -W 0.001 + ping ${n3.ip} -c 1 -W 0.001 + + shell on n2_1: + ping ${n1_2.ip} -c 1 -W 0.001 + ping ${n2_2.ip} -c 1 -W 0.001 + ping ${n3.ip} -c 1 -W 0.001 + + local: + disconnect_nodes s1 + + shell on n1_1: + ! ping ${n1_2.ip} -c 1 -W 0.001 + ! ping ${n2_2.ip} -c 1 -W 0.001 + ! ping ${n3.ip} -c 1 -W 0.001 + + shell on n2_1: + ! ping ${n1_2.ip} -c 1 -W 0.001 + ping ${n2_2.ip} -c 1 -W 0.001 + ping ${n3.ip} -c 1 -W 0.001 + + local: + shell on n1_1: + ping ${n1_2.ip} -c 1 -W 0.001 + ping ${n2_2.ip} -c 1 -W 0.001 + ping ${n3.ip} -c 1 -W 0.001 + + shell on n2_1: + ping ${n1_2.ip} -c 1 -W 0.001 + ping ${n2_2.ip} -c 1 -W 0.001 + ping ${n3.ip} -c 1 -W 0.001 diff --git a/test/script/network.et b/test/script/network.et new file mode 100644 index 0000000..62006ad --- /dev/null +++ b/test/script/network.et @@ -0,0 +1,28 @@ +module network + +asset scripts: + path: ../asset/network + + +def run_test_from using p (file): + guard (file /= "") # TODO: forces (file :: String) + send "" to p # TODO: forces (p :: Process) + + with p: + send "load $file" + expect /load-done/ + + send "run Test" + expect /run-test-result Test (.*)/ capture result + guard (result == "done") + expect /run-done/ + + +test DisconnectNode: + spawn as p + run_test_from using p "${scripts.path}/disconnect_node.et" + + +test DisconnectNodes: + spawn as p + run_test_from using p "${scripts.path}/disconnect_nodes.et" |