-incIORef :: IORef Int -> IO ()
-incIORef ir = atomicModifyIORef ir (\x -> (x + 1, ()))
-
--- | Wrapper over a test runner with error counting
-wrapTest :: IORef Int
- -> (Args -> IO Result)
- -> Args
- -> IO (Result, Char)
-wrapTest ir test opts = do
- r <- test opts
- c <- case r of
- Success {} -> return '.'
- GaveUp {} -> return '?'
- Failure {} -> incIORef ir >> return '#'
- NoExpectedFailure {} -> incIORef ir >> return '*'
- return (r, c)
-
-runTests name opts tests max_count = do
- _ <- printf "%25s : " name
- hFlush stdout
- results <- mapM (\t -> do
- (r, c) <- t opts
- putChar c
- hFlush stdout
- return r
- ) tests
- let alldone = sum . map numTests $ results
- _ <- printf "%*s(%d)\n" (max_count - length tests + 1) " " alldone
- mapM_ (\(idx, r) ->
- case r of
- Failure { output = o, usedSeed = u, usedSize = size } ->
- printf "Test %d failed (seed was %s, test size %d): %s\n"
- idx (show u) size o
- GaveUp { numTests = passed } ->
- printf "Test %d incomplete: gave up with only %d\
- \ passes after discarding %d tests\n"
- idx passed (maxDiscard opts)
- _ -> return ()
- ) $ zip ([1..]::[Int]) results
- return results
-
-allTests :: [(String, Args, [Args -> IO Result])]