Mark ignored output lines

Changelog: Mark flushed or ignored output lines

6 files changed, 113 insertions, 10 deletions

diff --git a/src/Output.hs b/src/Output.hs
index 01c0b4b..2cddabf 100644
--- a/src/Output.hs
+++ b/src/Output.hs
@@ -58,6 +58,7 @@ data OutputType
     | OutputChildFail
     | OutputMatch
     | OutputMatchFail CallStack
+    | OutputIgnored
     | OutputError
     | OutputAlways
     | OutputTestRaw
@@ -89,6 +90,7 @@ outColor OutputChildInfo = T.pack "0"
 outColor OutputChildFail = T.pack "31"
 outColor OutputMatch = T.pack "32"
 outColor OutputMatchFail {} = T.pack "31"
+outColor OutputIgnored = "90"
 outColor OutputError = T.pack "31"
 outColor OutputAlways = "0"
 outColor OutputTestRaw = "0"
@@ -102,6 +104,7 @@ outSign OutputChildInfo = T.pack "."
 outSign OutputChildFail = T.pack "!!"
 outSign OutputMatch = T.pack "+"
 outSign OutputMatchFail {} = T.pack "/"
+outSign OutputIgnored = "-"
 outSign OutputError = T.pack "!!"
 outSign OutputAlways = T.empty
 outSign OutputTestRaw = T.empty
@@ -120,6 +123,7 @@ outTestLabel = \case
     OutputChildFail -> "child-fail"
     OutputMatch -> "match"
     OutputMatchFail {} -> "match-fail"
+    OutputIgnored -> "ignored"
     OutputError -> "error"
     OutputAlways -> "other"
     OutputTestRaw -> ""
diff --git a/src/Process.hs b/src/Process.hs
index 7d09b61..3cf0938 100644
--- a/src/Process.hs
+++ b/src/Process.hs
@@ -23,6 +23,7 @@ import Control.Monad.Except
 import Control.Monad.Reader
 
 import Data.Function
+import Data.List
 import Data.Maybe
 import Data.Scientific
 import Data.Text (Text)
@@ -115,10 +116,14 @@ startProcessIOLoops process@Process {..} hout herr = do
 
     void $ forkTest $ lineReadingLoop process hout $ \line -> do
         outProc OutputChildStdout process line
-        liftIO $ atomically $ do
+        ignored <- liftIO $ atomically $ do
             ignores <- map snd . snd <$> readTVar procIgnore
-            when (not $ any (matches line) ignores) $ do
+            let ignored = any (matches line) ignores
+            when (not ignored) $ do
                 modifyTVar procOutput (++ [ line ])
+            return ignored
+        when ignored $ do
+            outProc OutputIgnored process line
 
     void $ forkTest $ lineReadingLoop process herr $ \line -> do
         case procName of
@@ -218,18 +223,23 @@ instance ObjectType TestRun IgnoreProcessOutput where
     textObjectValue _ (IgnoreProcessOutput _ _) = "<IgnoreProcessOutput>"
 
     createObject oid ( process@Process {..}, regex ) = do
-        liftIO $ atomically $ do
-            flushProcessOutput process regex
+        ( obj, flushed ) <- liftIO $ atomically $ do
+            flushed <- flushProcessOutput process regex
             ( iid, list ) <- readTVar procIgnore
             writeTVar procIgnore ( iid + 1, ( iid, regex ) : list )
-            return $ Object oid $ IgnoreProcessOutput process iid
+            return ( Object oid $ IgnoreProcessOutput process iid, flushed )
+        mapM_ (outProc OutputIgnored process) flushed
+        return obj
 
     destroyObject Object { objImpl = IgnoreProcessOutput Process {..} iid } = do
         liftIO $ atomically $ do
             writeTVar procIgnore . fmap (filter ((iid /=) . fst)) =<< readTVar procIgnore
 
-flushProcessOutput :: Process -> Maybe Regex -> STM ()
+flushProcessOutput :: Process -> Maybe Regex -> STM [ Text ]
 flushProcessOutput p mbre = do
-    writeTVar (procOutput p) =<< case mbre of
-        Nothing -> return []
-        Just re -> filter (either error isNothing . regexMatch re) <$> readTVar (procOutput p)
+    current <- readTVar (procOutput p)
+    let ( ignore, keep ) = case mbre of
+            Nothing -> ( current, [] )
+            Just re -> partition (either error isJust . regexMatch re) current
+    writeTVar (procOutput p) keep
+    return ignore
diff --git a/src/Run.hs b/src/Run.hs
index 54df37b..7cea577 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -209,7 +209,8 @@ runStep = \case
         expect stack line p expr timeout captures $ runStep . inner
 
     Flush p regex -> do
-        atomicallyTest $ flushProcessOutput p regex
+        mapM_ (outProc OutputIgnored p) =<<
+            atomicallyTest (flushProcessOutput p regex)
 
     Guard stack expr -> do
         testStepGuard stack expr
diff --git a/test/asset/output/flush.et b/test/asset/output/flush.et
new file mode 100644
index 0000000..0051dfd
--- /dev/null
+++ b/test/asset/output/flush.et
@@ -0,0 +1,13 @@
+test Test:
+    node n
+    shell on n as p:
+        echo a
+        echo b
+        echo c
+        echo d
+        echo e
+    with p:
+        expect /e/
+        flush matching /[b-z]/
+        expect /.*/
+        expect /.*/ timeout 0.0
diff --git a/test/asset/output/ignore.et b/test/asset/output/ignore.et
new file mode 100644
index 0000000..cc70e3b
--- /dev/null
+++ b/test/asset/output/ignore.et
@@ -0,0 +1,20 @@
+test Test:
+    node n
+    shell on n as p:
+        echo a
+        echo b
+        echo c
+        echo d
+        grep -q .
+        echo e
+        echo F
+        echo g
+        echo H
+    with p:
+        expect /d/
+        ignore matching /[b-z]/
+        send "x"
+        expect /.*/
+        expect /H/
+        expect /F/
+        expect /.*/ timeout 0.0
diff --git a/test/script/output.et b/test/script/output.et
new file mode 100644
index 0000000..d3f0eea
--- /dev/null
+++ b/test/script/output.et
@@ -0,0 +1,55 @@
+module output
+
+asset scripts:
+    path: ../asset/output
+
+test FlushOutput:
+    spawn as p 
+    with p:
+        send "load ${scripts.path}/flush.et"
+        expect /load-done/
+
+        send "run Test"
+        expect /child-stdout p a/
+        expect /child-stdout p b/
+        expect /child-stdout p c/
+        expect /child-stdout p d/
+        expect /child-stdout p e/
+        expect /match p e/
+        expect /ignored p b/
+        expect /ignored p c/
+        expect /ignored p d/
+        expect /match p a/
+        expect /match-fail expect.*/
+
+        expect /(run-.*)/ capture done
+        guard (done == "run-failed")
+
+test IgnoreOutput:
+    spawn as p 
+    with p:
+        send "load ${scripts.path}/ignore.et"
+        expect /load-done/
+
+        send "run Test"
+        expect /child-stdout p a/
+        expect /child-stdout p b/
+        expect /child-stdout p c/
+        expect /child-stdout p d/
+        expect /child-stdin p x/
+        expect /child-stdout p e/
+        expect /child-stdout p F/
+        expect /child-stdout p g/
+        expect /child-stdout p H/
+        expect /match p d/
+        expect /ignored p b/
+        expect /ignored p c/
+        expect /match p a/
+        expect /ignored p e/
+        expect /match p H/
+        expect /ignored p g/
+        expect /match p F/
+        expect /match-fail expect.*/
+
+        expect /(run-.*)/ capture done
+        guard (done == "run-failed")