{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} import Test.Simple import System.Environment (getArgs) import System.Environment.Executable (getExecutablePath) import System.Process (readProcessWithExitCode) import Control.Monad.Trans (liftIO) import System.Exit (ExitCode(ExitSuccess)) import Control.Monad (guard) locTest :: TestSimpleT IO Bool locTest = $loc >> ok False testOk1 :: ExitCode -> String -> String -> TestSimpleT IO Bool testOk1 ec out err = do is ec ExitSuccess is out "1..1\nok 1\n" is err "" testUnknown :: ExitCode -> String -> String -> TestSimpleT IO Bool testUnknown ec out err = do isnt ec ExitSuccess is out "" like err "Unknown" testNOk1 :: ExitCode -> String -> String -> TestSimpleT IO Bool testNOk1 ec out err = do isnt ec ExitSuccess like out "not ok 1" like err "# Hello\n" testMismatch :: ExitCode -> String -> String -> TestSimpleT IO Bool testMismatch ec _ err = do isnt ec ExitSuccess is err "# Looks like you planned 2 tests but ran 1.\n" testIsFailure :: ExitCode -> String -> String -> TestSimpleT IO Bool testIsFailure ec _ err = do isnt ec ExitSuccess like err " got: '1'\n" like err "expected: '2'\n" testLikeFailure :: ExitCode -> String -> String -> TestSimpleT IO Bool testLikeFailure ec _ err = do isnt ec ExitSuccess like err "# '\"a\"'\n" like err "# doesn't match '\"b\"'\n" testUnlikeFailure :: ExitCode -> String -> String -> TestSimpleT IO Bool testUnlikeFailure ec _ err = do isnt ec ExitSuccess like err "# '\"abc\"'" like err "# matches '\"b\"'\n" testLocationPrint :: ExitCode -> String -> String -> TestSimpleT IO Bool testLocationPrint ec _ err = do isnt ec ExitSuccess like err " Failed test at tests/Main.hs line 12" like err "# Looks like you failed 1 test of 1.\n" testMPlus :: ExitCode -> String -> String -> TestSimpleT IO Bool testMPlus ec out err = do is ec ExitSuccess is err "" like out "1..2" testMPlusFail :: ExitCode -> String -> String -> TestSimpleT IO Bool testMPlusFail ec out err = do isnt ec ExitSuccess like err "failed 1 test of 2" like out "1..2" testGuard :: ExitCode -> String -> String -> TestSimpleT IO Bool testGuard ec out err = do isnt ec ExitSuccess like out "1..1" unlike err "DIAG" like err "# got: '1'\n" like err "# expected: anything else\n" testEither :: ExitCode -> String -> String -> TestSimpleT IO Bool testEither ec out err = do isnt ec ExitSuccess like out "1..2" like out "ok 1" like err "got Left: '\"badleft\"'" testRunTS :: ExitCode -> String -> String -> TestSimpleT IO Bool testRunTS ec out err = do is ec ExitSuccess is err "" is out "True\n1..1\n# Bar\nok 1\n" testAll :: IO () testAll = testSimpleMain $ do plan 47 pn <- liftIO getExecutablePath mapM_ (runMyself pn) [ ("bbbf", testUnknown), ("ok1", testOk1), ("nok1", testNOk1) , ("mism", testMismatch), ("isf", testIsFailure) , ("likef", testLikeFailure), ("qloc", testLocationPrint) , ("unlike", testOk1), ("fail_unlike", testUnlikeFailure) , ("guard", testOk1), ("mplus", testMPlus), ("fail_mplus", testMPlusFail) , ("guardisnt", testGuard), ("either", testEither) , ("runts", testRunTS) ] where runMyself pn (arg, act) = do (ec, out, err) <- liftIO $ readProcessWithExitCode pn [ arg ] "" act ec out err main :: IO () main = do as <- getArgs case as of [] -> testAll [ "ok1" ] -> testSimpleMain $ plan 1 >> ok True [ "nok1" ] -> testSimpleMain $ plan 1 >> diag "Hello" >> ok False [ "mism" ] -> testSimpleMain $ ok True >> plan 2 [ "isf" ] -> testSimpleMain $ is 1 (2::Int) >> plan 1 [ "likef" ] -> testSimpleMain $ plan 1 >> like "a" "b" [ "qloc" ] -> testSimpleMain $ plan 1 >> locTest [ "unlike" ] -> testSimpleMain $ plan 1 >> unlike "abc" "d" [ "fail_unlike" ] -> testSimpleMain $ unlike "abc" "b" [ "guard" ] -> testSimpleMain $ plan 1 >> ok True >> guard False >> ok False [ "mplus" ] -> testSimpleMain $ (plan 1 >> ok True) >> (plan 1 >> ok True) [ "fail_mplus" ] -> testSimpleMain $ (plan 1 >> ok False) >> (plan 1 >> ok True) [ "guardisnt" ] -> testSimpleMain $ plan 1 >> (isnt (1::Int) 1 >>= guard) >> diag "DIAG" [ "either" ] -> testSimpleMain $ do plan 2 isRight (Right "hhh" :: Either Int String) isRight (Left "badleft" :: Either String Int) [ "runts" ] -> do (b, lg) <- runTestSimple $ plan 1 >> diag "Bar" >> ok True putStrLn $ show b mapM_ putStrLn lg _ -> error $ "Unknown: " ++ show as