diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2022-08-10 23:36:32 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2022-08-13 13:06:41 +0200 |
| commit | ff46d84b08fed346156c1b67478d4090a0b83f7d (patch) | |
| tree | 2ca845d723c857ae8c251055405c126ac9ece8bf /src/Main.hs | |
| parent | efaed91a6007772acf066e7876c06462f4e68fd4 (diff) | |
Integer expressions and variables
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 12 |
1 files changed, 6 insertions, 6 deletions
diff --git a/src/Main.hs b/src/Main.hs index 7c6d587..bb5ec02 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -76,7 +76,7 @@ data TestEnv = TestEnv } data TestState = TestState - { tsVars :: [(VarName, Text)] + { tsVars :: [(VarName, SomeVarValue)] } newtype TestRun a = TestRun { fromTestRun :: ReaderT TestEnv (StateT TestState (ExceptT () IO)) a } @@ -96,7 +96,7 @@ instance MonadError () TestRun where catchError (TestRun act) handler = TestRun $ catchError act $ fromTestRun . handler instance MonadEval TestRun where - lookupStringVar name = maybe (fail $ "variable not in scope: '" ++ unpackVarName name ++ "'") return =<< gets (lookup name . tsVars) + lookupVar name = maybe (fail $ "variable not in scope: '" ++ unpackVarName name ++ "'") return =<< gets (lookup name . tsVars) instance MonadOutput TestRun where getOutput = asks teOutput @@ -203,7 +203,7 @@ getNode net nname@(NodeName tnname) = (find ((nname==).nodeName) <$> liftIO (rea callOn node $ "ip link set dev lo up" return $ (node : nodes, ip) - modify $ \s -> s { tsVars = (VarName [tnname, T.pack "ip"], T.pack ip) : tsVars s } + modify $ \s -> s { tsVars = (VarName [tnname, T.pack "ip"], SomeVarValue (T.pack ip)) : tsVars s } return node callOn :: Node -> String -> IO () @@ -291,13 +291,13 @@ expect (SourceLine sline) p expr vars = do outLine OutputError (Just $ procName p) $ T.pack "variable '" `T.append` textVarName name `T.append` T.pack "' already exists on " `T.append` sline throwError () - modify $ \s -> s { tsVars = zip vars capture ++ tsVars s } + modify $ \s -> s { tsVars = zip vars (map SomeVarValue capture) ++ tsVars s } outLine OutputMatch (Just $ procName p) line Nothing -> do outLine OutputMatchFail (Just $ procName p) $ T.pack "expect failed on " `T.append` sline exprVars <- gatherVars expr forM_ exprVars $ \(name, value) -> - outLine OutputMatchFail (Just $ procName p) $ T.concat [T.pack " ", textVarName name, T.pack " = ", T.pack (show value)] + outLine OutputMatchFail (Just $ procName p) $ T.concat [T.pack " ", textVarName name, T.pack " = ", textSomeVarValue value] throwError () testStepGuard :: SourceLine -> Expr Bool -> TestRun () @@ -342,7 +342,7 @@ runTest out opts test = do outLine OutputError Nothing $ T.pack "variable '" `T.append` textVarName name `T.append` T.pack "' already exists on " `T.append` sline throwError () value <- eval expr - modify $ \s -> s { tsVars = (name, value) : tsVars s } + modify $ \s -> s { tsVars = (name, SomeVarValue value) : tsVars s } Spawn pname nname -> do node <- getNode net nname |