Add a test for DiscardTrace

[barrucadu]

The current Discard tests don't check that traces are correctly discarded, only that results can be discarded.

There should be a test that DiscardTrace gives results with empty traces.

[qrilka]

@barrucadu as I understand dejafu doesn't have anything like gives but for inspecting traces, right? Also it looks like to get a trace you need to have a failure, any canonical example of such a case?

[barrucadu]

Every execution gives a trace, regardless of whether it fails or not.

For example:

import Control.Concurrent.Classy
import Test.DejaFu.Defaults
import Test.DejaFu.SCT
import Test.DejaFu.Types

example :: MonadConc m => m String
example = do
  var <- newEmptyMVar
  fork (putMVar var "hello")
  fork (putMVar var "world")
  readMVar var

traces :: IO [(Either Failure String, Trace)]
traces = runSCTDiscard discarder defaultWay defaultMemType example where
  discarder (Right "hello") = Just DiscardTrace
  discarder _ = Nothing

main :: IO ()
main = mapM_ print =<< traces

Running that program gives:

(Right "hello",[])                                                                                                                    
(Right "hello",[])                                                                                                                    
(Right "hello",[])                                                                                                                    
(Right "hello",[])                                                                                                                    
(Right "hello",[])                                                                                                                    
(Right "hello",[])                                                                                                                    
(Right "world",[(Start main,[],NewMVar 1),(Continue,[],Fork 1),(Continue,[(1,WillPutMVar 1)],Fork 2),(Continue,[(1,WillPutMVar 1),(2,Wi
llPutMVar 1)],BlockedReadMVar 1),(Start 2,[(1,WillPutMVar 1)],PutMVar 1 [main]),(Continue,[(main,WillReadMVar 1),(1,WillPutMVar 1)],Stop),(Start main,[(1,WillPutMVar 1)],ReadMVar 1),(SwitchTo 1,[(main,WillStop)],BlockedPutMVar 1),(Start main,[],Stop)])                 
(Right "world",[(Start main,[],NewMVar 1),(Continue,[],Fork 1),(Continue,[(1,WillPutMVar 1)],Fork 2),(Continue,[(1,WillPutMVar 1),(2,WillPutMVar 1)],BlockedReadMVar 1),(Start 2,[(1,WillPutMVar 1)],PutMVar 1 [main]),(Continue,[(main,WillReadMVar 1),(1,WillPutMVar 1)],Sto
p),(Start main,[(1,WillPutMVar 1)],ReadMVar 1),(Continue,[(1,WillPutMVar 1)],Stop)])                                                  
(Right "world",[(Start main,[],NewMVar 1),(Continue,[],Fork 1),(Continue,[(1,WillPutMVar 1)],Fork 2),(Continue,[(1,WillPutMVar 1),(2,Wi
llPutMVar 1)],BlockedReadMVar 1),(Start 2,[(1,WillPutMVar 1)],PutMVar 1 [main]),(SwitchTo 1,[(main,WillReadMVar 1),(2,WillStop)],BlockedPutMVar 1),(Start main,[(2,WillStop)],ReadMVar 1),(SwitchTo 1,[(main,WillStop),(2,WillStop)],BlockedPutMVar 1),(Start main,[(2,WillSto
p)],Stop)])                                                                                                                           
(Right "world",[(Start main,[],NewMVar 1),(Continue,[],Fork 1),(Continue,[(1,WillPutMVar 1)],Fork 2),(Continue,[(1,WillPutMVar 1),(2,WillPutMVar 1)],BlockedReadMVar 1),(Start 2,[(1,WillPutMVar 1)],PutMVar 1 [main]),(SwitchTo 1,[(main,WillReadMVar 1),(2,WillStop)],BlockedPutMVar 1),(Start main,[(2,WillStop)],ReadMVar 1),(Continue,[(1,WillPutMVar 1),(2,WillStop)],Stop)])

So a test for DiscardTrace would look something like:

testDiscardTrace = do
  results <- runSCTDiscard discarder defaultWay defaultMemType action
  for_ results $ \(efa, trace) -> case discarder efa of
    Just DiscardResultAndTrace -> fail test with "expected result to be discarded"
    Just DiscardTrace
      | null trace -> pass test
      | otherwise -> fail test with "expected trace to be discarded"
    Nothing -> pass test

...but put into a format which tasty can run.