quickcheck/RunTests.hs

   1 module RunTests where
   2
   3 import Test.QuickCheck.Batch hiding (runTests)
   4 import System.Exit
   5 import System.Environment
   6
   7 import HeaderInfoTests as HI
   8
   9 runUnitTests :: Bool -> IO ()
  10 runUnitTests debug = exitWith =<< performTests debug
  11
  12 performTests :: Bool -> IO ExitCode
  13 performTests debug =
  14     do e1 <- exeTests "HeaderInfo" opts
  15                    [ run HI.prop_optionsIdentity
  16                    , run HI.prop_languageParse
  17                    , run HI.prop_languageError ]
  18        return (foldr1 cat [e1])
  19     where opts = TestOptions 100 10 debug
  20           cat (e@(ExitFailure _)) _ = e
  21           cat _ e = e
  22
  23 exeTests :: String -> TestOptions -> [TestOptions -> IO TestResult] -> IO ExitCode
  24 exeTests name scale actions =
  25     do putStr (rjustify 25 name ++ " : ")
  26        tr 1 actions [] 0 False
  27     where
  28       rjustify n s = replicate (max 0 (n - length s)) ' ' ++ s
  29       tr n [] xs c e = do
  30                      putStr (rjustify (max 0 (35-n)) " (" ++ show c ++ ")\n")
  31                      mapM_ fa xs
  32                      if e
  33                         then return (ExitFailure 1)
  34                         else return ExitSuccess
  35       tr n (action:actions) others c e =
  36           do r <- action scale
  37              case r of
  38                (TestOk _ m _)
  39                    -> do { putStr "." ;
  40                            tr (n+1) actions others (c+m) e }
  41                (TestExausted s m ss)
  42                    -> do { putStr "?" ;
  43                            tr (n+1) actions others (c+m) e }
  44                (TestAborted e)
  45                    -> do { print e;
  46                            putStr "*" ;
  47                            tr (n+1) actions others c True }
  48                (TestFailed f num)
  49                    -> do { putStr "#" ;
  50                            tr (n+1) actions ((f,n,num):others) (c+num) True }
  51       fa :: ([String],Int,Int) -> IO ()
  52       fa (f,n,no) =
  53           do putStr "\n"
  54              putStr ("    ** test "
  55                      ++ show (n  :: Int)
  56                      ++ " of "
  57                      ++ name
  58                      ++ " failed with the binding(s)\n")
  59              sequence_ [putStr ("    **   " ++ v ++ "\n")
  60                         | v <- f ]
  61              putStr "\n"
  62