Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

81 lines (63 sloc) 3.611 kb
{-# LANGUAGE UndecidableInstances, DeriveDataTypeable #-}
module Test.Framework.Core where
import Test.Framework.Improving
import Test.Framework.Options
import Control.Arrow (first, second)
import Control.Concurrent.MVar
import Data.Typeable
-- | Something like the result of a test: works in concert with 'Testlike'.
-- The type parameters are the type that is used for progress reports and the
-- type of the final output of the test respectively.
class (Show i, Show r) => TestResultlike i r | r -> i where
testSucceeded :: r -> Bool
-- | Something test-like in its behaviour. The type parameters are the type that
-- is used for progress reports, the type of the final output of the test and the
-- data type encapsulating the whole potential to do a test respectively.
class TestResultlike i r => Testlike i r t | t -> i r, r -> i where
runTest :: CompleteTestOptions -> t -> IO (i :~> r, IO ())
testTypeName :: t -> TestTypeName
-- | Test names or descriptions. These are shown to the user
type TestName = String
-- | The name of a type of test, such as "Properties" or "Test Cases". Tests of
-- types of the same names will be grouped together in the test run summary.
type TestTypeName = String
-- | Main test data type: builds up a list of tests to be run. Users should use the
-- utility functions in e.g. the test-framework-hunit and test-framework-quickcheck
-- packages to create instances of 'Test', and then build them up into testsuites
-- by using 'testGroup' and lists.
--
-- For an example of how to use test-framework, please see
-- <http://github.com/batterseapower/test-framework/raw/master/example/Test/Framework/Example.lhs>
data Test = forall i r t.
(Testlike i r t, Typeable t) => Test TestName t -- ^ A single test of some particular type
| TestGroup TestName [Test] -- ^ Assemble a number of tests into a cohesive group
| PlusTestOptions TestOptions Test -- ^ Add some options to child tests
| BuildTestBracketed (IO (Test, IO ())) -- ^ Convenience for creating tests from an 'IO' action, with cleanup
-- | Assemble a number of tests into a cohesive group
testGroup :: TestName -> [Test] -> Test
testGroup = TestGroup
-- | Add some options to child tests
plusTestOptions :: TestOptions -> Test -> Test
plusTestOptions = PlusTestOptions
-- | Convenience for creating tests from an 'IO' action
buildTest :: IO Test -> Test
buildTest mx = BuildTestBracketed (fmap (flip (,) (return ())) mx)
-- | Convenience for creating tests from an 'IO' action, with a cleanup handler for when tests are finished
buildTestBracketed :: IO (Test, IO ()) -> Test
buildTestBracketed = BuildTestBracketed
data MutuallyExcluded t = ME (MVar ()) t
deriving Typeable
-- This requires UndecidableInstances, but I think it can't be made inconsistent?
instance Testlike i r t => Testlike i r (MutuallyExcluded t) where
runTest cto (ME mvar x) = fmap (second (\act -> withMVar mvar $ \() -> act)) $ runTest cto x
testTypeName ~(ME _ x) = testTypeName x
-- | Mark all tests in this portion of the tree as mutually exclusive, so only one runs at a time
{-# NOINLINE mutuallyExclusive #-}
mutuallyExclusive :: Test -> Test
mutuallyExclusive init_t = buildTest $ do
mvar <- newMVar ()
let go (Test tn t) = Test tn (ME mvar t)
go (TestGroup tn ts) = TestGroup tn (map go ts)
go (PlusTestOptions to t) = PlusTestOptions to (go t)
go (BuildTestBracketed build) = BuildTestBracketed (fmap (first go) build)
return (go init_t)
Jump to Line
Something went wrong with that request. Please try again.