From 242b66118533881f1123150984a30aa208a115f5 Mon Sep 17 00:00:00 2001
From: Michael Walker <mike@barrucadu.co.uk>
Date: Sun, 1 Feb 2015 21:55:25 +0000
Subject: [PATCH] Filter out duplicate failures in runTest

---
 Test/DejaFu.hs | 27 ++++++++++++++-------------
 1 file changed, 14 insertions(+), 13 deletions(-)

diff --git a/Test/DejaFu.hs b/Test/DejaFu.hs
index aaff06f..51c7ac1 100644
--- a/Test/DejaFu.hs
+++ b/Test/DejaFu.hs
@@ -189,7 +189,7 @@ runTestIO' pb predicate conc = (predicate <$> sctPreBoundIO pb conc) >>= andShri
 
 -- | Strip out duplicates
 uniques :: Eq a => [(Maybe a, Trace)] -> [(Maybe a, Trace)]
-uniques = map head . groupByIsh (==)
+uniques = nubBy resEq . map head . groupByIsh (==)
 
 -- * Predicates
 
@@ -295,24 +295,14 @@ doTest name result = do
   else do
     -- Display a failure message, and the first 5 (simplified) failed traces
     putStrLn ("\27[31m[fail]\27[0m " ++ name ++ " (checked: " ++ show (_casesChecked result) ++ ")")
-    let failures = nubBy reseq $ _failures result
+
+    let failures = _failures result
     mapM_ (\(r, t) -> putStrLn $ "\t" ++ maybe "[deadlock]" show r ++ " " ++ showTrace t) $ take 5 failures
     when (moreThan failures 5) $
       putStrLn "\t..."
 
   return $ _pass result
 
-  where
-    reseq (res, trc) (res', trc') = res == res' && trc `eq` trc'
-    -- Two traces are "equal" if their decisions differ ONLY in
-    -- non-preemptive context switches. This helps filter out some
-    -- false positives.
-    eq [] [] = True
-    eq _ [] = False
-    eq [] _ = False
-    eq ((Start _,_,_):as) ((Start _,_,_):bs) = as `eq` bs
-    eq ((a,_,_):as) ((b,_,_):bs) = a == b && as `eq` bs
-
 -- | Increment the cases checked
 incCC :: Result a -> Result a
 incCC r = r { _casesChecked = _casesChecked r + 1 }
@@ -335,3 +325,14 @@ findFailures2 p xs = findFailures xs 0 [] where
   findFailures ((z1,t1):(z2,t2):zs) l fs
     | p z1 z2 = findFailures ((z2,t2):zs) (l+1) fs
     | otherwise = findFailures ((z2,t2):zs) (l+1) ((z1,t1):(z2,t2):fs)
+
+-- | Check if two failures are \"equal\". Specifically, they have the
+-- same value, and the traces differ only in non-pre-emptive context
+-- switches. This helps filter out some duplicates.
+resEq :: Eq a => (Maybe a, Trace) -> (Maybe a, Trace) -> Bool
+resEq (res, trc) (res', trc') = res == res' && trc `eq` trc' where
+  eq [] [] = True
+  eq _ [] = False
+  eq [] _ = False
+  eq ((Start _,_,_):as) ((Start _,_,_):bs) = as `eq` bs
+  eq ((a,_,_):as) ((b,_,_):bs) = a == b && as `eq` bs