Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

test code to trigger #1 #3

Closed
wants to merge 2 commits into from

1 participant

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Nov 25, 2011
  1. @tmcdonell
  2. @tmcdonell

    wibble

    tmcdonell authored
This page is out of date. Refresh to see the latest.
View
1  test/hashtables-test.cabal
@@ -118,6 +118,7 @@ Executable compute-overhead
hashable >= 1.1 && <2,
mwc-random == 0.8.*,
QuickCheck >= 2.3.0.2,
+ HUnit >= 1.2 && < 2.0,
test-framework >= 0.3.1 && <0.4,
test-framework-quickcheck2 >= 0.2.6 && < 0.3,
test-framework-hunit >= 0.2.6 && <3,
View
18 test/suite/Data/HashTable/Test/Common.hs
@@ -22,12 +22,13 @@ import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import Prelude hiding (lookup, mapM_)
import System.Random.MWC
-import System.Timeout
+import qualified System.Timeout as S
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2
import Test.QuickCheck
import Test.QuickCheck.Monadic
+import Test.HUnit.Lang
------------------------------------------------------------------------------
import qualified Data.HashTable.Class as C
import Data.HashTable.IO
@@ -269,10 +270,13 @@ data Action = Lookup Int
| Delete Int
deriving Show
+timeout :: Int -> IO a -> Assertion
+timeout t m = do
+ maybe (assertFailure "timeout") (\_ -> return ()) =<< timeout_ t m
timeout_ :: Int -> IO a -> IO (Maybe a)
#ifdef PORTABLE
-timeout_ = timeout
+timeout_ = S.timeout
#else
foreign import ccall safe "suicide"
@@ -284,9 +288,9 @@ foreign import ccall safe "suicide"
timeout_ t m = do
ptr <- malloc
poke ptr 1
- forkOS $ suicide ptr
+ _ <- forkOS $ suicide ptr
threadDelay 1000
- r <- timeout t m
+ r <- S.timeout t m
poke ptr 0
return r
where
@@ -308,9 +312,8 @@ testForwardSearch3 prefix dummyArg = testCase (prefix ++ "/forwardSearch3") go
go = do
tbl <- new
forceType tbl dummyArg
- timeout_ 1000000 $
+ timeout 1000000 $
foldM_ (\t k -> applyAction t k >> return t) tbl testData
- return ()
testData =
[ Insert 65
@@ -366,9 +369,8 @@ testNastyFullLookup prefix dummyArg = testCase (prefix ++ "/nastyFullLookup") go
go = do
tbl <- new
forceType tbl dummyArg
- timeout_ 1000000 $
+ timeout 1000000 $
foldM_ (\t k -> applyAction t k >> return t) tbl testData
- return ()
testData =
[ Insert 28
Something went wrong with that request. Please try again.