chp-1.5.0: An implementation of concurrency ideas from Communicating Sequential ProcessesSource codeContentsIndex
Control.Concurrent.CHP.Test
Description

A module containing some useful functions for testing CHP programs, both in the QuickCheck 2 framework and using HUnit.

This whole module was added in version 1.4.0.

Synopsis
data QuickCheckCHP a
qcCHP :: CHP a -> QuickCheckCHP a
qcCHP' :: Trace t => IO (Maybe a, t Unique) -> QuickCheckCHP a
propCHPInOut :: Show a => (a -> b -> Bool) -> (Chanin a -> Chanout b -> CHP ()) -> Gen a -> Property
testCHP :: CHP Bool -> Test
testCHPInOut :: (a -> b -> Bool) -> (Chanin a -> Chanout b -> CHP ()) -> a -> Test
testCHP' :: CHP CHPTestResult -> Test
data CHPTestResult
= CHPTestPass
| CHPTestFail String
(=*=) :: (Eq a, Show a) => a -> a -> CHPTestResult
data CHPTest a
withCheck :: CHP a -> CHPTest () -> CHP CHPTestResult
assertCHP :: CHP () -> String -> Bool -> CHPTest ()
assertCHP' :: String -> Bool -> CHPTest ()
assertCHPEqual :: (Eq a, Show a) => CHP () -> String -> a -> a -> CHPTest ()
assertCHPEqual' :: (Eq a, Show a) => String -> a -> a -> CHPTest ()
Documentation
data QuickCheckCHP a Source

A wrapper around the CHP type that supports some QuickCheck Testable instances. See qcCHP and qcCHP'.

Added in version 1.5.0.

show/hide Instances
qcCHP :: CHP a -> QuickCheckCHP aSource

Turns a CHP program into a QuickCheckCHP for use with Testable instances.

Equivalent to qcCHP' . runCHP_CSPTrace.

Added in version 1.5.0.

qcCHP' :: Trace t => IO (Maybe a, t Unique) -> QuickCheckCHP aSource

Takes the command that runs a CHP program and gives back a QuickCheckCHP item for use with Testable instances.

You use this function like:

 qcCHP' (runCHP_CSPTrace p)

To test process p with a CSP trace if it fails. To turn off the display of tracing when a test fails, use:

 qcCHP' (runCHP_TraceOff p)

Added in version 1.5.0.

propCHPInOut :: Show a => (a -> b -> Bool) -> (Chanin a -> Chanout b -> CHP ()) -> Gen a -> PropertySource

Tests a process that takes a single input and produces a single output, using QuickCheck.

The first parameter is a pure function that takes the input to the process, the output the process gave back, and indicates whether this is okay (True = test pass, False = test fail). The second parameter is the process to test, and the third parameter is the thing to use to generate the inputs (passing arbitrary is the simplest thing to do).

Here are a couple of example uses:

 propCHPInOut (==) Common.id (arbitrary :: Gen Int)
 propCHPInOut (const $ (< 0)) (Common.map (negate . abs)) (arbitrary :: Gen Int)

The test starts the process afresh each time, and shuts it down after the single output has been produced (by poisoning both its channels). Any poison from the process being tested after it has produced its output is consequently ignored, but poison instead of producing an output will cause a test failure. If the process does not produce an output or poison (for example if you test something like the Common.filter process), the test will deadlock.

testCHP :: CHP Bool -> TestSource

Takes a CHP program that returns a Bool (True = test passed, False = test failed) and forms it into an HUnit test.

Note that if the program exits with poison, this is counted as a test failure.

testCHPInOut :: (a -> b -> Bool) -> (Chanin a -> Chanout b -> CHP ()) -> a -> TestSource

Tests a process that takes a single input and produces a single output, using HUnit.

The first parameter is a pure function that takes the input to the process, the output the process gave back, and indicates whether this is okay (True = test pass, False = test fail). The second parameter is the process to test, and the third parameter is the input to send to the process.

The intention is that you will either create several tests with the same first two parameters or use a const function as the first parameter. So for example, here is how you might test the identity process with several tests:

 let check = testCHPInOut (==) Common.id
 in TestList [check 0, check 3, check undefined]

Whereas here is how you could test a slightly different process:

 let check = testCHPInOut (const $ (< 0)) (Common.map (negate . abs))
 in TestList $ map check [-5..5]

The test starts the process afresh each time, and shuts it down after the single output has been produced (by poisoning both its channels). Any poison from the process being tested after it has produced its output is consequently ignored, but poison instead of producing an output will cause a test failure. If the process does not produce an output or poison (for example if you test something like the Common.filter process), the test will deadlock.

testCHP' :: CHP CHPTestResult -> TestSource

Like testCHP but allows you to return the more descriptive CHPTestResult type, rather than a plain Bool.

Added in version 1.5.0.

data CHPTestResult Source

A helper type for describing a more detailed result of a CHP test. You can construct these values manually, or using the '(=*=)' operator.

Added in version 1.5.0.

Constructors
CHPTestPass
CHPTestFail String
show/hide Instances
(=*=) :: (Eq a, Show a) => a -> a -> CHPTestResultSource

Checks if two things are equal; passes the test if they are, otherwise fails and gives an error that shows the two things in question.

Added in version 1.5.0.

data CHPTest a Source
See withCheck. Added in version 1.5.0.
show/hide Instances
withCheck :: CHP a -> CHPTest () -> CHP CHPTestResultSource

A helper function that allows you to create CHP tests in an assertion style, either for use with HUnit or QuickCheck 2.

Any poison thrown by the first argument (the left-hand side when this function is used infix) is trapped and ignored. Poison thrown by the second argument (the right-hand side when used infix) is counted as a test failure.

As an example, imagine that you have a process that should repeatedly output the same value (42), called myProc. There are several ways to test this, but for the purposes of illustration we will start by testing the first two values:

 myTest :: Test
 myTest = testCHP' $ do
   c <- oneToOneChannel
   myProc (writer c)
     `withCheck` do x0 <- liftCHP $ readChannel (reader c)
                    assertCHPEqual (poison (reader c)) "First value" 42 x0
                    x1 <- liftCHP $ readChannel (reader c)
                    poison (reader c) -- Shutdown myProc
                    assertCHPEqual' "Second value" 42 x1

This demonstrates the typical pattern: a do block with some initialisation to begin with (creating channels, enrolling on barriers), then a withCheck call with the thing you want to test on the left-hand side, and the part doing the testing with the asserts on the right-hand side. Most CHP actions must be surrounded by liftCHP, and assertions can then be made about the values.

Poison is used twice in our example. The assertCHPEqual function takes as a first argument the command to execute if the assertion fails. The problem is that if the assertion fails, the right-hand side will finish. But it is composed in parallel with the left-hand side, which does not know to finish (deadlock!). Thus we must pass a command to execute if the assertion fails that will shutdown the right-hand side. The second assertion doesn't need this, because by the time we make the assertion, we have already inserted the poison. Don't forget that you must poison to shut down the left-hand side if your test is successful or else you will again get deadlock.

A better way to test this process is of course to read in a much larger number of samples and check they are all the same, for example:

 myTest :: Test
 myTest = testCHP' $ do
   c <- oneToOneChannel
   myProc (writer c)
     `withCheck` do xs <- liftCHP $ replicateM 1000 $ readChannel (reader c)
                    poison (reader c) -- Shutdown myProc
                    assertCHPEqual' "1000 values" xs (replicate 1000 42)

Added in version 1.5.0.

assertCHP :: CHP () -> String -> Bool -> CHPTest ()Source

Checks that the given Bool is True. If it is, the assertion passes and the test continues. If it is False, the given command is run (which should shut down the left-hand side of withCheck) and the test finishes, failing with the given String.

Added in version 1.5.0.

assertCHP' :: String -> Bool -> CHPTest ()Source

Like assertCHP but issues no shutdown command. You should only use this function if you are sure that the left-hand side of withCheck has already completed.

Added in version 1.5.0.

assertCHPEqual :: (Eq a, Show a) => CHP () -> String -> a -> a -> CHPTest ()Source

Checks that the given values are equal (first is the expected value of the test, second is the actual value). If they are equal, the assertion passes and the test continues. If they are not equal, the given command is run (which should shut down the left-hand side of withCheck) and the test finishes, failing with the a message formed of the given String, and describing the two values.

Added in version 1.5.0.

assertCHPEqual' :: (Eq a, Show a) => String -> a -> a -> CHPTest ()Source

Like assertCHPEqual but issues no shutdown command. You should only use this function if you are sure that the left-hand side of withCheck has already completed.

Added in version 1.5.0.

Produced by Haddock version 2.4.2