Add timeouts to hanging tests

Author: sjakobi

tests/Properties/HashMapLazy.hs

@@ -255,31 +255,42 @@ tests =
       [ testProperty "model" $
         \(x :: HMKI) y -> HM.isSubmapOf x y === M.isSubmapOf (toOrdMap x) (toOrdMap y)
       , testProperty "m ⊆ m" $
-        \(x :: HMKI) -> HM.isSubmapOf x x
+        \(x :: HMKI) -> QC.within 1000000 $ HM.isSubmapOf x x
       , testProperty "m1 ⊆ m1 ∪ m2" $
-        \(x :: HMKI) y -> HM.isSubmapOf x (HM.union x y)
+        \(x :: HMKI) y -> QC.within 1000000 $ HM.isSubmapOf x (HM.union x y)
       , testProperty "m1 ⊈ m2  ⇒  m1 ∪ m2 ⊈ m1" $
-        \(m1 :: HMKI) m2 -> not (HM.isSubmapOf m1 m2) ==> HM.isSubmapOf m1 (HM.union m1 m2)
+        \(m1 :: HMKI) m2 ->
+          QC.within 1000000 $
+          not (HM.isSubmapOf m1 m2) ==> HM.isSubmapOf m1 (HM.union m1 m2)
       , testProperty "m1\\m2 ⊆ m1" $
-        \(m1 :: HMKI) (m2 :: HMKI) -> HM.isSubmapOf (HM.difference m1 m2) m1
+        \(m1 :: HMKI) (m2 :: HMKI) ->
+          QC.within 1000000 $
+          HM.isSubmapOf (HM.difference m1 m2) m1
       , testProperty "m1 ∩ m2 ≠ ∅  ⇒  m1 ⊈ m1\\m2 " $
         \(m1 :: HMKI) (m2 :: HMKI) ->
+          QC.within 1000000 $
           not (HM.null (HM.intersection m1 m2)) ==>
           not (HM.isSubmapOf m1 (HM.difference m1 m2))
       , testProperty "delete k m ⊆ m" $
         \(m :: HMKI) ->
+          QC.within 1000000 $
           not (HM.null m) ==>
           QC.forAll (QC.elements (HM.keys m)) $ \k ->
           HM.isSubmapOf (HM.delete k m) m
       , testProperty "m ⊈ delete k m " $
         \(m :: HMKI) ->
+          QC.within 1000000 $
           not (HM.null m) ==>
           QC.forAll (QC.elements (HM.keys m)) $ \k ->
           not (HM.isSubmapOf m (HM.delete k m))
       , testProperty "k ∉ m  ⇒  m ⊆ insert k v m" $
-        \k v (m :: HMKI) -> not (HM.member k m) ==> HM.isSubmapOf m (HM.insert k v m)
+        \k v (m :: HMKI) ->
+          QC.within 1000000 $
+          not (HM.member k m) ==> HM.isSubmapOf m (HM.insert k v m)
       , testProperty "k ∉ m  ⇒  insert k v m ⊈ m" $
-        \k v (m :: HMKI) -> not (HM.member k m) ==> not (HM.isSubmapOf (HM.insert k v m) m)
+        \k v (m :: HMKI) ->
+          QC.within 1000000 $
+          not (HM.member k m) ==> not (HM.isSubmapOf (HM.insert k v m) m)
       ]
     -- Combine
     , testGroup "union"

tests/Regressions.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE BinaryLiterals      #-}
 {-# LANGUAGE CPP                 #-}
 {-# LANGUAGE MagicHash           #-}
+{-# LANGUAGE NumericUnderscores  #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
 {-# LANGUAGE UnboxedTuples       #-}
@@ -20,7 +21,7 @@ import System.Mem.Weak       (deRefWeak, mkWeakPtr)
 import System.Random         (randomIO)
 import Test.HUnit            (Assertion, assert)
 import Test.QuickCheck
-import Test.Tasty            (TestTree, testGroup)
+import Test.Tasty            (TestTree, localOption, mkTimeout, testGroup)
 import Test.Tasty.HUnit      (testCase)
 import Test.Tasty.QuickCheck (testProperty)
 
@@ -267,7 +268,7 @@ issue420 = do
 -- Issue 491
 
 issue491 :: TestTree
-issue491 = testGroup "issue491" $
+issue491 = localOption (mkTimeout 1_000_000) $ testGroup "issue491" $
     [ testCase "1" $ assert $ m [0, -1] `HML.isSubmapOf` m [0, -1]
     , testCase "2" $ assert $ m [1, 0b11111] `HML.isSubmapOf` m [1, 0b11111]
     , testCase "3" $ assert $ m [1, 0b11111] `HML.isSubmapOf` m [1, 0b11111, 42]