module TestFramework where
import Test.QuickCheck (Testable(..))
import Test.QuickCheck.Test
import Text.Printf
import System.Environment
import Control.Monad
import Control.Exception
type TestName = String
type Test = [(TestName, Int -> IO (Bool, Int))]
testGroup :: String -> [Test] -> Test
testGroup _ = concat
testProperty :: Testable a => String -> a -> Test
testProperty name p = [(name, runQcTest)]
where
runQcTest n = do
result <- quickCheckWithResult testArgs p
case result of
Success {} -> return (True, numTests result)
_ -> return (False, numTests result)
where
testArgs = stdArgs {
maxSuccess = n
}
assertBool :: String -> Bool -> Bool
assertBool _ = id
testCase :: String -> Bool -> Test
testCase name tst = [(name, runPlainTest)]
where
runPlainTest _ = do
r <- evaluate tst
putStrLn "+++ OK, passed test."
return (r, 1)
defaultMain :: [Test] -> IO ()
defaultMain = runTests . concat
runTests :: [(String, Int -> IO (Bool,Int))] -> IO ()
runTests tests = do
x <- getArgs
let n = if null x then 100 else read . head $ x
(results, passed) <- liftM unzip $ mapM (\(s,a) -> printf "%-40s: " s >> a n) tests
_ <- printf "Passed %d tests!\n" (sum passed)
when (not . and $ results) $ fail "Not all tests passed!"