Test.hs

-- Copyright (C) 2009 Reinier Lamers
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; see the file COPYING.  If not, write to
-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-- Boston, MA 02110-1301, USA.

module Main where

import System.Exit ( exitWith, ExitCode(..) )
import Test.HUnit ( runTestTT, Test(..), Counts(..), Assertion, assertEqual,
                    assertFailure, assertBool )

import Test.Runner.Backends ( TestRunnerTest(..), runWithQuickCheck )
import Test.Runner.Driver ( runTests, Result(Result), runTestsParallel )

main :: IO ()
main = do
    counts <- runTestTT tests
    if errors counts == 0 && failures counts == 0
      then exitWith ExitSuccess
      else exitWith (ExitFailure 1)

tests :: Test
tests = TestList [ TestLabel "Checking that empty list of tests does not fail" (TestCase emptyListTest)
                 , TestLabel "Checking singleton success" (TestCase singletonSuccess)
                 , TestLabel "Checking singleton failure" (TestCase singletonFailure)
                 , TestLabel "Checking parallel testing" (TestCase parallelNumber)
                 ]


-- | Verify that testrunner does the right thing when given an empty list
emptyListTest :: Assertion
emptyListTest = do
    res <- runTests [] 
    assertEqual "result for empty list" (Result 0 []) res

singletonSuccess :: Assertion
singletonSuccess = do
    res <- runTests [("success", TestRunnerTest True)]
    assertEqual "result for singleton success" (Result 1 []) res
    resHUnit <- runTests [("HUnit success", TestRunnerTest (TestCase (assertBool "success" True)))]
    assertEqual "result for singleton success with HUnit" (Result 1 []) resHUnit
    resQC <- runTests [("QuickCheck success", runWithQuickCheck True)]
    assertEqual "result for singleton success with QuickCheck" (Result 1 []) resQC
    resIO <- runTests [("IO success", TestRunnerTest (return True :: IO Bool))]
    assertEqual "result for singleton success with IO" (Result 1 []) resIO

singletonFailure :: Assertion
singletonFailure = do
    (Result numPassed fails) <- runTests [("failure", TestRunnerTest False)]
    assertEqual "no successes in singleton failure list" 0 numPassed
    assertEqual "one failure in singleton failure list" 1 (length fails)
    (Result numPassedHU failsHU) <- runTests [("HUnit failure", TestRunnerTest (TestCase (assertFailure "failure")))]
    assertEqual "no successes in singleton failure list for HUnit" 0 numPassedHU
    assertEqual "one failure in singleton failure list for HUnit" 1 (length failsHU)
    (Result numPassedQC failsQC) <- runTests [("QuickCheck failure", runWithQuickCheck False)]
    assertEqual "no successes in singleton failure list for QuickCheck" 0 numPassedQC
    assertEqual "one failure in singleton failure list for QuickCheck" 1 (length failsQC)
    (Result numPassedIO failsIO) <- runTests [("IO failure", TestRunnerTest (return False :: IO Bool))]
    assertEqual "no success in singleton failure list for IO" 0 numPassedIO
    assertEqual "one failure in singleton failure list for QuickCheck" 1 (length failsIO)

-- | Checks that the number of tests executed by the parallel runner is equal to
--   the number of tests given (this may easily go wrong in the case of race
--   conditions).
parallelNumber :: Assertion
parallelNumber = do
    let twoTests = [("success", TestRunnerTest True), ("failure", TestRunnerTest False)]
    (Result numPassed fails) <- runTestsParallel 8 (concat $ replicate 500 twoTests)
    let numRun = numPassed + length fails
    assertEqual "Number of tests run equals number of tests given" 1000 numRun