Print relevant variable values after expect failure

4 files changed, 28 insertions, 5 deletions

diff --git a/erebos-tester.cabal b/erebos-tester.cabal
index 8b66f13..2ed105a 100644
--- a/erebos-tester.cabal
+++ b/erebos-tester.cabal
@@ -38,6 +38,7 @@ executable erebos-tester-core
                        Parser
                        Process
                        Test
+                       Util
   other-extensions:    TemplateHaskell
   default-extensions:  DeriveGeneric
                        ExistentialQuantification
@@ -49,6 +50,8 @@ executable erebos-tester-core
                        LambdaCase
                        MultiParamTypeClasses
                        RankNTypes
+                       ScopedTypeVariables
+                       TupleSections
                        TypeFamilies
                        TypeOperators
   build-depends:       base             >=4.13 && <5,
diff --git a/src/Main.hs b/src/Main.hs
index efab611..dc5ffd4 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -267,8 +267,9 @@ tryMatch re (x:xs) | Right (Just (_, _, _, capture)) <- regexec re x = Just ((x,
                    | otherwise = fmap (x:) <$> tryMatch re xs
 tryMatch _ [] = Nothing
 
-expect :: SourceLine -> Process -> Regex -> [VarName] -> TestRun ()
-expect (SourceLine sline) p re vars = do
+expect :: SourceLine -> Process -> Expr Regex -> [VarName] -> TestRun ()
+expect (SourceLine sline) p expr vars = do
+    re <- eval expr
     timeout <- asks $ optTimeout . teOptions
     delay <- liftIO $ registerDelay $ ceiling $ 1000000 * timeout
     mbmatch <- atomicallyTest $ (Nothing <$ (check =<< readTVar delay)) <|> do
@@ -294,6 +295,9 @@ expect (SourceLine sline) p re vars = do
              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)]
              throwError ()
 
 testStepGuard :: SourceLine -> Expr Bool -> TestRun ()
@@ -344,8 +348,7 @@ runTest out opts test = do
 
             Expect line pname expr captures -> do
                 p <- getProcess net pname
-                regex <- eval expr
-                expect line p regex captures
+                expect line p expr captures
 
             Guard line expr -> do
                 testStepGuard line expr
diff --git a/src/Test.hs b/src/Test.hs
index 25f3c09..e7e1255 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -8,7 +8,7 @@ module Test (
 
     MonadEval(..),
     VarName(..), textVarName, unpackVarName,
-    Expr(..), eval,
+    Expr(..), eval, gatherVars,
     Regex,
 ) where
 
@@ -23,6 +23,7 @@ import Text.Regex.TDFA
 import Text.Regex.TDFA.Text
 
 import Process
+import Util
 
 data Test = Test
     { testName :: Text
@@ -84,3 +85,13 @@ eval (Regex xs) = do
         Left err -> fail err
         Right re -> return re
 eval (BinOp f x y) = f <$> eval x <*> eval y
+
+gatherVars :: forall a m. MonadEval m => Expr a -> m [(VarName, Text)]
+gatherVars = fmap (uniq . sort) . helper
+  where
+    helper :: forall b. Expr b -> m [(VarName, Text)]
+    helper (StringVar var) = (:[]) . (var,) <$> lookupStringVar var
+    helper (StringLit _) = return []
+    helper (Concat es) = concat <$> mapM helper es
+    helper (Regex es) = concat <$> mapM helper es
+    helper (BinOp _ e f) = (++) <$> helper e <*> helper f
diff --git a/src/Util.hs b/src/Util.hs
new file mode 100644
index 0000000..99d51f6
--- /dev/null
+++ b/src/Util.hs
@@ -0,0 +1,6 @@
+module Util where
+
+uniq :: Eq a => [a] -> [a]
+uniq (x:y:xs) | x == y    = uniq (x:xs)
+              | otherwise = x : uniq (y:xs)
+uniq xs = xs