{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE ScopedTypeVariables #-}
-------------------------------------------------------------------------------
-- |
-- Module      :  BroadcastChan.Test
-- Copyright   :  (C) 2014-2022 Merijn Verstraaten
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Merijn Verstraaten <merijn@inconsistent.nl>
-- Stability   :  experimental
-- Portability :  haha
--
-- Module containing testing helpers shared across all broadcast-chan packages.
-------------------------------------------------------------------------------
module BroadcastChan.Test
    ( (@?)
    , expect
    , genStreamTests
    , runTests
    , withLoggedOutput
    , MonadIO(..)
    , mapHandler
    -- * Re-exports of @tasty@ and @tasty-hunit@
    , module Test.Tasty
    , module Test.Tasty.HUnit
    ) where

import Prelude hiding (seq)
import Control.Concurrent (forkIO, setNumCapabilities, threadDelay)
import Control.Concurrent.Async (wait, withAsync)
import Control.Concurrent.MVar
import Control.Concurrent.QSemN
import Control.Concurrent.STM
import Control.Monad (void, when)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Exception (Exception, throwIO, try)
import Data.Bifunctor (second)
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import Data.List (sort)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Proxy (Proxy(Proxy))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Tagged (Tagged, untag)
import Data.Typeable (Typeable)
import Options.Applicative (flag', long, help)
import System.Clock
    (Clock(Monotonic), TimeSpec, diffTimeSpec, getTime, toNanoSecs)
import System.Environment (setEnv)
import System.IO (Handle, SeekMode(AbsoluteSeek), hPrint, hSeek)
import System.IO.Temp (withSystemTempFile)
import Test.Tasty
import Test.Tasty.Ingredients.Basic (consoleTestReporter, listingTests)
import Test.Tasty.Golden.Advanced (goldenTest)
import Test.Tasty.HUnit hiding ((@?))
import qualified Test.Tasty.HUnit as HUnit
import Test.Tasty.Options

import BroadcastChan.Extra (Action(..), Handler(..), mapHandler)
import ParamTree

data TestException = TestException deriving (TestException -> TestException -> Bool
(TestException -> TestException -> Bool)
-> (TestException -> TestException -> Bool) -> Eq TestException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestException -> TestException -> Bool
== :: TestException -> TestException -> Bool
$c/= :: TestException -> TestException -> Bool
/= :: TestException -> TestException -> Bool
Eq, Int -> TestException -> ShowS
[TestException] -> ShowS
TestException -> String
(Int -> TestException -> ShowS)
-> (TestException -> String)
-> ([TestException] -> ShowS)
-> Show TestException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestException -> ShowS
showsPrec :: Int -> TestException -> ShowS
$cshow :: TestException -> String
show :: TestException -> String
$cshowList :: [TestException] -> ShowS
showList :: [TestException] -> ShowS
Show, Typeable)
instance Exception TestException

infix 0 @?
-- | Monomorphised version of 'Test.Tasty.HUnit.@?' to avoid ambiguous type
-- errors when combined with predicates that are @MonadIO m => m Bool@.
--
-- @since 0.2.0
(@?) :: IO Bool -> String -> Assertion
@? :: IO Bool -> String -> Assertion
(@?) = IO Bool -> String -> Assertion
forall t.
(AssertionPredicable t, HasCallStack) =>
t -> String -> Assertion
(HUnit.@?)

-- | Test which fails if the expected exception is not thrown by the 'IO'
-- action.
--
-- @since 0.2.0
expect :: (Eq e, Exception e) => e -> IO a -> Assertion
expect :: forall e a. (Eq e, Exception e) => e -> IO a -> Assertion
expect e
err IO a
act = do
    Either e a
result <- IO a -> IO (Either e a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
act
    case Either e a
result of
        Left e
e | e
e e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
err -> () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
               | Bool
otherwise -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$
                                String
"Expected: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ e -> String
forall a. Show a => a -> String
show e
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nGot: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ e -> String
forall a. Show a => a -> String
show e
e
        Right a
_ -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ String
"Expected exception, got success."

-- | Pauses a number of microseconds before returning its input.
doNothing :: Int -> a -> IO a
doNothing :: forall a. Int -> a -> IO a
doNothing Int
threadPause a
x = do
    Int -> Assertion
threadDelay Int
threadPause
    a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Print a value, then return it.
doPrint :: Show a => Handle -> a -> IO a
doPrint :: forall a. Show a => Handle -> a -> IO a
doPrint Handle
hnd a
x = do
    Handle -> a -> Assertion
forall a. Show a => Handle -> a -> Assertion
hPrint Handle
hnd a
x
    a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

doDrop :: Show a => (a -> Bool) -> Handle -> a -> IO a
doDrop :: forall a. Show a => (a -> Bool) -> Handle -> a -> IO a
doDrop a -> Bool
predicate Handle
hnd a
val
    | a -> Bool
predicate a
val = TestException -> IO a
forall e a. Exception e => e -> IO a
throwIO TestException
TestException
    | Bool
otherwise = Handle -> a -> IO a
forall a. Show a => Handle -> a -> IO a
doPrint Handle
hnd a
val

doRace :: MVar () -> QSemN -> a -> IO a
doRace :: forall a. MVar () -> QSemN -> a -> IO a
doRace MVar ()
mvar QSemN
sem a
_ = do
    Maybe ()
result <- MVar () -> IO (Maybe ())
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar ()
mvar
    case Maybe ()
result of
        Maybe ()
Nothing -> QSemN -> Int -> Assertion
signalQSemN QSemN
sem Int
1 Assertion -> Assertion -> Assertion
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVar () -> Assertion
forall a. MVar a -> IO a
readMVar MVar ()
mvar
        Just () -> () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    TestException -> IO a
forall e a. Exception e => e -> IO a
throwIO TestException
TestException

fromTimeSpec :: Fractional n => TimeSpec -> n
fromTimeSpec :: forall n. Fractional n => TimeSpec -> n
fromTimeSpec = Integer -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> n) -> (TimeSpec -> Integer) -> TimeSpec -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeSpec -> Integer
toNanoSecs

speedupTest
    :: forall r . (Eq r, Show r)
    => IO (TVar (Map ([Int], Int) (MVar (r, Double))))
    -> ([Int] -> (Int -> IO Int) -> IO r)
    -> ([Int] -> (Int -> IO Int) -> Int -> IO r)
    -> Int
    -> [Int]
    -> Int
    -> String
    -> TestTree
speedupTest :: forall r.
(Eq r, Show r) =>
IO (TVar (Map ([Int], Int) (MVar (r, Double))))
-> ([Int] -> (Int -> IO Int) -> IO r)
-> ([Int] -> (Int -> IO Int) -> Int -> IO r)
-> Int
-> [Int]
-> Int
-> String
-> TestTree
speedupTest IO (TVar (Map ([Int], Int) (MVar (r, Double))))
getCache [Int] -> (Int -> IO Int) -> IO r
seqSink [Int] -> (Int -> IO Int) -> Int -> IO r
parSink Int
n [Int]
inputs Int
pause String
name = String -> Assertion -> TestTree
testCase String
name (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    IO (r, Double) -> (Async (r, Double) -> Assertion) -> Assertion
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync IO (r, Double)
cachedSequential ((Async (r, Double) -> Assertion) -> Assertion)
-> (Async (r, Double) -> Assertion) -> Assertion
forall a b. (a -> b) -> a -> b
$ \Async (r, Double)
seqAsync ->
      IO (r, Double) -> (Async (r, Double) -> Assertion) -> Assertion
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (IO r -> IO (r, Double)
forall a. IO a -> IO (a, Double)
timed (IO r -> IO (r, Double)) -> IO r -> IO (r, Double)
forall a b. (a -> b) -> a -> b
$ [Int] -> (Int -> IO Int) -> Int -> IO r
parSink [Int]
inputs Int -> IO Int
testFun Int
n) ((Async (r, Double) -> Assertion) -> Assertion)
-> (Async (r, Double) -> Assertion) -> Assertion
forall a b. (a -> b) -> a -> b
$ \Async (r, Double)
parAsync -> do
        (r
seqResult, Double
seqTime) <- Async (r, Double) -> IO (r, Double)
forall a. Async a -> IO a
wait Async (r, Double)
seqAsync
        (r
parResult, Double
parTime) <- Async (r, Double) -> IO (r, Double)
forall a. Async a -> IO a
wait Async (r, Double)
parAsync
        r
seqResult r -> r -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=? r
parResult
        let lowerBound :: Double
            lowerBound :: Double
lowerBound = Double
seqTime Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1)

            upperBound :: Double
            upperBound :: Double
upperBound = Double
seqTime Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1)

            errorMsg :: String
            errorMsg :: String
errorMsg = [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                [ String
"Parallel time should be 1/"
                , Int -> String
forall a. Show a => a -> String
show Int
n
                , String
"th of sequential time!\n"
                , String
"Actual time was 1/"
                , Int -> String
forall a. Show a => a -> String
show (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
seqTime Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
parTime :: Int)
                , String
"th (", Double -> String
forall a. Show a => a -> String
show (Double
seqTimeDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
parTime), String
")"
                ]
        HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
errorMsg (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Double
lowerBound Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
parTime Bool -> Bool -> Bool
&& Double
parTime Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
upperBound
  where
    testFun :: Int -> IO Int
    testFun :: Int -> IO Int
testFun = Int -> Int -> IO Int
forall a. Int -> a -> IO a
doNothing Int
pause

    timed :: IO a -> IO (a, Double)
    timed :: forall a. IO a -> IO (a, Double)
timed = ((a, TimeSpec) -> (a, Double))
-> IO (a, TimeSpec) -> IO (a, Double)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
x, TimeSpec
t) -> (a
x, TimeSpec -> Double
forall n. Fractional n => TimeSpec -> n
fromTimeSpec TimeSpec
t)) (IO (a, TimeSpec) -> IO (a, Double))
-> (IO a -> IO (a, TimeSpec)) -> IO a -> IO (a, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (a, TimeSpec)
forall a. IO a -> IO (a, TimeSpec)
withTime

    cachedSequential :: IO (r, Double)
    cachedSequential :: IO (r, Double)
cachedSequential = do
        MVar (r, Double)
mvar <- IO (MVar (r, Double))
forall a. IO (MVar a)
newEmptyMVar
        TVar (Map ([Int], Int) (MVar (r, Double)))
cacheTVar <- IO (TVar (Map ([Int], Int) (MVar (r, Double))))
getCache
        Maybe (MVar (r, Double))
result <- STM (Maybe (MVar (r, Double))) -> IO (Maybe (MVar (r, Double)))
forall a. STM a -> IO a
atomically (STM (Maybe (MVar (r, Double))) -> IO (Maybe (MVar (r, Double))))
-> STM (Maybe (MVar (r, Double))) -> IO (Maybe (MVar (r, Double)))
forall a b. (a -> b) -> a -> b
$ do
            Map ([Int], Int) (MVar (r, Double))
cacheMap <- TVar (Map ([Int], Int) (MVar (r, Double)))
-> STM (Map ([Int], Int) (MVar (r, Double)))
forall a. TVar a -> STM a
readTVar TVar (Map ([Int], Int) (MVar (r, Double)))
cacheTVar
            let (Maybe (MVar (r, Double))
oldVal, Map ([Int], Int) (MVar (r, Double))
newMap) = (([Int], Int)
 -> MVar (r, Double) -> MVar (r, Double) -> MVar (r, Double))
-> ([Int], Int)
-> MVar (r, Double)
-> Map ([Int], Int) (MVar (r, Double))
-> (Maybe (MVar (r, Double)), Map ([Int], Int) (MVar (r, Double)))
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
M.insertLookupWithKey
                    (\([Int], Int)
_ MVar (r, Double)
_ MVar (r, Double)
v -> MVar (r, Double)
v)
                    ([Int]
inputs, Int
pause)
                    MVar (r, Double)
mvar
                    Map ([Int], Int) (MVar (r, Double))
cacheMap
            TVar (Map ([Int], Int) (MVar (r, Double)))
-> Map ([Int], Int) (MVar (r, Double)) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Map ([Int], Int) (MVar (r, Double)))
cacheTVar Map ([Int], Int) (MVar (r, Double))
newMap
            Maybe (MVar (r, Double)) -> STM (Maybe (MVar (r, Double)))
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MVar (r, Double))
oldVal

        case Maybe (MVar (r, Double))
result of
            Just MVar (r, Double)
var -> MVar (r, Double) -> IO (r, Double)
forall a. MVar a -> IO a
readMVar MVar (r, Double)
var
            Maybe (MVar (r, Double))
Nothing -> do
                IO r -> IO (r, Double)
forall a. IO a -> IO (a, Double)
timed ([Int] -> (Int -> IO Int) -> IO r
seqSink [Int]
inputs Int -> IO Int
testFun) IO (r, Double) -> ((r, Double) -> Assertion) -> Assertion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar (r, Double) -> (r, Double) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (r, Double)
mvar
                MVar (r, Double) -> IO (r, Double)
forall a. MVar a -> IO a
readMVar MVar (r, Double)
mvar

-- | Run an IO action while logging the output to a @Handle@. Returns the
-- result and the logged output.
--
-- @since 0.2.0
withLoggedOutput :: FilePath -> (Handle -> IO r) -> IO (r, Text)
withLoggedOutput :: forall r. String -> (Handle -> IO r) -> IO (r, Text)
withLoggedOutput String
filename Handle -> IO r
act = String -> (String -> Handle -> IO (r, Text)) -> IO (r, Text)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
filename ((String -> Handle -> IO (r, Text)) -> IO (r, Text))
-> (String -> Handle -> IO (r, Text)) -> IO (r, Text)
forall a b. (a -> b) -> a -> b
$ \String
_ Handle
hnd ->
  (,) (r -> Text -> (r, Text)) -> IO r -> IO (Text -> (r, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO r
act Handle
hnd IO (Text -> (r, Text)) -> IO Text -> IO (r, Text)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Handle -> IO Text
rewindAndRead Handle
hnd
  where
    rewindAndRead :: Handle -> IO Text
    rewindAndRead :: Handle -> IO Text
rewindAndRead Handle
hnd = do
        Handle -> SeekMode -> Integer -> Assertion
hSeek Handle
hnd SeekMode
AbsoluteSeek Integer
0
        Handle -> IO Text
T.hGetContents Handle
hnd

nonDeterministicGolden
    :: forall r
     . (Eq r, Show r)
    => String
    -> (Handle -> IO r)
    -> (Handle -> IO r)
    -> TestTree
nonDeterministicGolden :: forall r.
(Eq r, Show r) =>
String -> (Handle -> IO r) -> (Handle -> IO r) -> TestTree
nonDeterministicGolden String
label Handle -> IO r
controlAction Handle -> IO r
testAction =
  String
-> IO (r, Text)
-> IO (r, Text)
-> ((r, Text) -> (r, Text) -> IO (Maybe String))
-> ((r, Text) -> Assertion)
-> TestTree
forall a.
String
-> IO a
-> IO a
-> (a -> a -> IO (Maybe String))
-> (a -> Assertion)
-> TestTree
goldenTest String
label (IO (r, Text) -> IO (r, Text)
forall (m :: * -> *) a. MonadIO m => IO (a, Text) -> m (a, Text)
normalise IO (r, Text)
control) (IO (r, Text) -> IO (r, Text)
forall (m :: * -> *) a. MonadIO m => IO (a, Text) -> m (a, Text)
normalise IO (r, Text)
test) (r, Text) -> (r, Text) -> IO (Maybe String)
diff (r, Text) -> Assertion
update
  where
    normalise :: MonadIO m => IO (a, Text) -> m (a, Text)
    normalise :: forall (m :: * -> *) a. MonadIO m => IO (a, Text) -> m (a, Text)
normalise = IO (a, Text) -> m (a, Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, Text) -> m (a, Text))
-> (IO (a, Text) -> IO (a, Text)) -> IO (a, Text) -> m (a, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Text) -> (a, Text)) -> IO (a, Text) -> IO (a, Text)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Text) -> (a, Text) -> (a, Text)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Text -> Text
T.strip (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines))

    control :: IO (r, Text)
    control :: IO (r, Text)
control = String -> (Handle -> IO r) -> IO (r, Text)
forall r. String -> (Handle -> IO r) -> IO (r, Text)
withLoggedOutput String
"control.out" Handle -> IO r
controlAction

    test :: IO (r, Text)
    test :: IO (r, Text)
test = String -> (Handle -> IO r) -> IO (r, Text)
forall r. String -> (Handle -> IO r) -> IO (r, Text)
withLoggedOutput String
"test.out" Handle -> IO r
testAction

    diff :: (r, Text) -> (r, Text) -> IO (Maybe String)
    diff :: (r, Text) -> (r, Text) -> IO (Maybe String)
diff (r
controlResult, Text
controlOutput) (r
testResult, Text
testOutput) =
        Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ Maybe String
resultDiff Maybe String -> Maybe String -> Maybe String
forall a. Monoid a => a -> a -> a
`mappend` Maybe String
outputDiff
      where
        resultDiff :: Maybe String
        resultDiff :: Maybe String
resultDiff
            | r
controlResult r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
testResult = Maybe String
forall a. Maybe a
Nothing
            | Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just String
"Results differ!\n"

        outputDiff :: Maybe String
        outputDiff :: Maybe String
outputDiff
            | Text
controlOutput Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
testOutput = Maybe String
forall a. Maybe a
Nothing
            | Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([String] -> String) -> [String] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$
                [ String
"Outputs differ!\n"
                , String
"Expected:\n\"", Text -> String
T.unpack Text
controlOutput, String
"\"\n\n"
                , String
"Got:\n\"", Text -> String
T.unpack Text
testOutput, String
"\"\n"
                ]

    update :: (r, Text) -> IO ()
    update :: (r, Text) -> Assertion
update (r, Text)
_ = () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

outputTest
    :: forall r . (Eq r, Show r)
    => ([Int] -> (Int -> IO Int) -> IO r)
    -> ([Int] -> (Int -> IO Int) -> Int -> IO r)
    -> Int
    -> [Int]
    -> String
    -> TestTree
outputTest :: forall r.
(Eq r, Show r) =>
([Int] -> (Int -> IO Int) -> IO r)
-> ([Int] -> (Int -> IO Int) -> Int -> IO r)
-> Int
-> [Int]
-> String
-> TestTree
outputTest [Int] -> (Int -> IO Int) -> IO r
seqSink [Int] -> (Int -> IO Int) -> Int -> IO r
parSink Int
threads [Int]
inputs String
label =
    String -> (Handle -> IO r) -> (Handle -> IO r) -> TestTree
forall r.
(Eq r, Show r) =>
String -> (Handle -> IO r) -> (Handle -> IO r) -> TestTree
nonDeterministicGolden String
label Handle -> IO r
seqTest Handle -> IO r
parTest
  where
    seqTest :: Handle -> IO r
    seqTest :: Handle -> IO r
seqTest = [Int] -> (Int -> IO Int) -> IO r
seqSink [Int]
inputs ((Int -> IO Int) -> IO r)
-> (Handle -> Int -> IO Int) -> Handle -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Int -> IO Int
forall a. Show a => Handle -> a -> IO a
doPrint

    parTest :: Handle -> IO r
    parTest :: Handle -> IO r
parTest Handle
hndl = [Int] -> (Int -> IO Int) -> Int -> IO r
parSink [Int]
inputs (Handle -> Int -> IO Int
forall a. Show a => Handle -> a -> IO a
doPrint Handle
hndl) Int
threads

dropTest
    :: (Eq r, Show r)
    => ([Int] -> (Int -> IO Int) -> IO r)
    -> (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
    -> TestTree
dropTest :: forall r.
(Eq r, Show r) =>
([Int] -> (Int -> IO Int) -> IO r)
-> (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
-> TestTree
dropTest [Int] -> (Int -> IO Int) -> IO r
seqImpl Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r
parImpl = String -> (Handle -> IO r) -> (Handle -> IO r) -> TestTree
forall r.
(Eq r, Show r) =>
String -> (Handle -> IO r) -> (Handle -> IO r) -> TestTree
nonDeterministicGolden String
"drop"
    ([Int] -> (Int -> IO Int) -> IO r
seqImpl [Int]
filteredInputs ((Int -> IO Int) -> IO r)
-> (Handle -> Int -> IO Int) -> Handle -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Int -> IO Int
forall a. Show a => Handle -> a -> IO a
doPrint)
    (\Handle
hnd -> Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r
parImpl (Action -> Handler IO Int
forall (m :: * -> *) a. Action -> Handler m a
Simple Action
Drop) [Int]
inputs ((Int -> Bool) -> Handle -> Int -> IO Int
forall a. Show a => (a -> Bool) -> Handle -> a -> IO a
doDrop Int -> Bool
forall a. Integral a => a -> Bool
even Handle
hnd) Int
2)
  where
    inputs :: [Int]
inputs = [Int
1..Int
100]
    filteredInputs :: [Int]
filteredInputs = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Int -> Bool) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool
forall a. Integral a => a -> Bool
even) [Int]
inputs

terminationTest
    :: (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r) -> TestTree
terminationTest :: forall r.
(Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
-> TestTree
terminationTest Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r
parImpl = String -> Assertion -> TestTree
testCase String
"termination" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
    TestException -> Assertion -> Assertion
forall e a. (Eq e, Exception e) => e -> IO a -> Assertion
expect TestException
TestException (Assertion -> Assertion)
-> (IO r -> Assertion) -> IO r -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO r -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO r -> Assertion) -> IO r -> Assertion
forall a b. (a -> b) -> a -> b
$
        String -> (String -> Handle -> IO r) -> IO r
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"terminate.out" ((String -> Handle -> IO r) -> IO r)
-> (String -> Handle -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \String
_ Handle
hndl ->
            Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r
parImpl (Action -> Handler IO Int
forall (m :: * -> *) a. Action -> Handler m a
Simple Action
Terminate) [Int
1..Int
100] ((Int -> Bool) -> Handle -> Int -> IO Int
forall a. Show a => (a -> Bool) -> Handle -> a -> IO a
doDrop Int -> Bool
forall a. Integral a => a -> Bool
even Handle
hndl) Int
4

raceTest
    :: (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r) -> TestTree
raceTest :: forall r.
(Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
-> TestTree
raceTest Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r
parImpl = String -> Assertion -> TestTree
testCase String
"race" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
    TestException -> Assertion -> Assertion
forall e a. (Eq e, Exception e) => e -> IO a -> Assertion
expect TestException
TestException (Assertion -> Assertion)
-> (IO r -> Assertion) -> IO r -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO r -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO r -> Assertion) -> IO r -> Assertion
forall a b. (a -> b) -> a -> b
$ do
        QSemN
sem <- Int -> IO QSemN
newQSemN Int
0
        MVar ()
mvar <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
        Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
            QSemN -> Int -> Assertion
waitQSemN QSemN
sem Int
parCount
            MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
mvar ()
        Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r
parImpl (Action -> Handler IO Int
forall (m :: * -> *) a. Action -> Handler m a
Simple Action
Terminate) [Int
1..Int
100] (MVar () -> QSemN -> Int -> IO Int
forall a. MVar () -> QSemN -> a -> IO a
doRace MVar ()
mvar QSemN
sem) Int
parCount
  where
    parCount :: Int
    parCount :: Int
parCount = Int
4

retryTest
    :: (Eq r, Show r)
    => ([Int] -> (Int -> IO Int) -> IO r)
    -> (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
    -> TestTree
retryTest :: forall r.
(Eq r, Show r) =>
([Int] -> (Int -> IO Int) -> IO r)
-> (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
-> TestTree
retryTest [Int] -> (Int -> IO Int) -> IO r
seqImpl Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r
parImpl = (IO (Int -> IO Bool) -> TestTree) -> TestTree
withRetryCheck ((IO (Int -> IO Bool) -> TestTree) -> TestTree)
-> (IO (Int -> IO Bool) -> TestTree) -> TestTree
forall a b. (a -> b) -> a -> b
$ \IO (Int -> IO Bool)
getRetryCheck ->
  String -> (Handle -> IO r) -> (Handle -> IO r) -> TestTree
forall r.
(Eq r, Show r) =>
String -> (Handle -> IO r) -> (Handle -> IO r) -> TestTree
nonDeterministicGolden
    String
"retry"
    ([Int] -> (Int -> IO Int) -> IO r
seqImpl [Int]
seqInputs ((Int -> IO Int) -> IO r)
-> (Handle -> Int -> IO Int) -> Handle -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Int -> IO Int
forall a. Show a => Handle -> a -> IO a
doPrint)
    (\Handle
h -> Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r
parImpl (Action -> Handler IO Int
forall (m :: * -> *) a. Action -> Handler m a
Simple Action
Retry) [Int]
parInputs (IO (Int -> IO Bool) -> Handle -> Int -> IO Int
dropAfterPrint IO (Int -> IO Bool)
getRetryCheck Handle
h) Int
4)
  where
    withRetryCheck :: (IO (Int -> IO Bool) -> TestTree) -> TestTree
withRetryCheck = IO (Int -> IO Bool)
-> ((Int -> IO Bool) -> Assertion)
-> (IO (Int -> IO Bool) -> TestTree)
-> TestTree
forall a.
IO a -> (a -> Assertion) -> (IO a -> TestTree) -> TestTree
withResource IO (Int -> IO Bool)
alloc (Int -> IO Bool) -> Assertion
forall {m :: * -> *} {p}. Monad m => p -> m ()
clean
      where
        alloc :: IO (Int -> IO Bool)
alloc = MVar IntSet -> Int -> IO Bool
updateRetry (MVar IntSet -> Int -> IO Bool)
-> IO (MVar IntSet) -> IO (Int -> IO Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntSet -> IO (MVar IntSet)
forall a. a -> IO (MVar a)
newMVar IntSet
IS.empty
        clean :: p -> m ()
clean p
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    parInputs :: [Int]
parInputs = [Int
1..Int
100]
    seqInputs :: [Int]
seqInputs = [Int]
parInputs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter Int -> Bool
forall a. Integral a => a -> Bool
even [Int]
parInputs

    updateRetry :: MVar IntSet -> Int -> IO Bool
    updateRetry :: MVar IntSet -> Int -> IO Bool
updateRetry MVar IntSet
mvar Int
val = MVar IntSet -> (IntSet -> IO (IntSet, Bool)) -> IO Bool
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar IntSet
mvar IntSet -> IO (IntSet, Bool)
updateSet
      where
        updateSet :: IntSet -> IO (IntSet, Bool)
        updateSet :: IntSet -> IO (IntSet, Bool)
updateSet IntSet
set
          | Int -> IntSet -> Bool
IS.member Int
val IntSet
set = (IntSet, Bool) -> IO (IntSet, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IntSet
set, Bool
False)
          | Bool
otherwise = (IntSet, Bool) -> IO (IntSet, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IntSet -> IntSet
IS.insert Int
val IntSet
set, Bool
True)

    dropAfterPrint :: IO (Int -> IO Bool) -> Handle -> Int -> IO Int
    dropAfterPrint :: IO (Int -> IO Bool) -> Handle -> Int -> IO Int
dropAfterPrint IO (Int -> IO Bool)
checkPresence Handle
hnd Int
val = do
        Handle -> Int -> Assertion
forall a. Show a => Handle -> a -> Assertion
hPrint Handle
hnd Int
val
        Bool -> Assertion -> Assertion
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
forall a. Integral a => a -> Bool
even Int
val) (Assertion -> Assertion) -> Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$ do
            Bool
isNotPresent <- IO (Int -> IO Bool)
checkPresence IO (Int -> IO Bool) -> ((Int -> IO Bool) -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Int -> IO Bool) -> Int -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int
val)
            Bool -> Assertion -> Assertion
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isNotPresent (Assertion -> Assertion) -> Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$ TestException -> Assertion
forall e a. Exception e => e -> IO a
throwIO TestException
TestException
        Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
val

newtype SlowTests = SlowTests Bool
  deriving (SlowTests -> SlowTests -> Bool
(SlowTests -> SlowTests -> Bool)
-> (SlowTests -> SlowTests -> Bool) -> Eq SlowTests
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SlowTests -> SlowTests -> Bool
== :: SlowTests -> SlowTests -> Bool
$c/= :: SlowTests -> SlowTests -> Bool
/= :: SlowTests -> SlowTests -> Bool
Eq, Eq SlowTests
Eq SlowTests =>
(SlowTests -> SlowTests -> Ordering)
-> (SlowTests -> SlowTests -> Bool)
-> (SlowTests -> SlowTests -> Bool)
-> (SlowTests -> SlowTests -> Bool)
-> (SlowTests -> SlowTests -> Bool)
-> (SlowTests -> SlowTests -> SlowTests)
-> (SlowTests -> SlowTests -> SlowTests)
-> Ord SlowTests
SlowTests -> SlowTests -> Bool
SlowTests -> SlowTests -> Ordering
SlowTests -> SlowTests -> SlowTests
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SlowTests -> SlowTests -> Ordering
compare :: SlowTests -> SlowTests -> Ordering
$c< :: SlowTests -> SlowTests -> Bool
< :: SlowTests -> SlowTests -> Bool
$c<= :: SlowTests -> SlowTests -> Bool
<= :: SlowTests -> SlowTests -> Bool
$c> :: SlowTests -> SlowTests -> Bool
> :: SlowTests -> SlowTests -> Bool
$c>= :: SlowTests -> SlowTests -> Bool
>= :: SlowTests -> SlowTests -> Bool
$cmax :: SlowTests -> SlowTests -> SlowTests
max :: SlowTests -> SlowTests -> SlowTests
$cmin :: SlowTests -> SlowTests -> SlowTests
min :: SlowTests -> SlowTests -> SlowTests
Ord, Typeable)

instance IsOption SlowTests where
  defaultValue :: SlowTests
defaultValue = Bool -> SlowTests
SlowTests Bool
False
  parseValue :: String -> Maybe SlowTests
parseValue = (Bool -> SlowTests) -> Maybe Bool -> Maybe SlowTests
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> SlowTests
SlowTests (Maybe Bool -> Maybe SlowTests)
-> (String -> Maybe Bool) -> String -> Maybe SlowTests
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Bool
forall a. Read a => String -> Maybe a
safeRead
  optionName :: Tagged SlowTests String
optionName = String -> Tagged SlowTests String
forall a. a -> Tagged SlowTests a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"slow-tests"
  optionHelp :: Tagged SlowTests String
optionHelp = String -> Tagged SlowTests String
forall a. a -> Tagged SlowTests a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Run slow tests."
  optionCLParser :: Parser SlowTests
optionCLParser = SlowTests -> Mod FlagFields SlowTests -> Parser SlowTests
forall a. a -> Mod FlagFields a -> Parser a
flag' (Bool -> SlowTests
SlowTests Bool
True) (Mod FlagFields SlowTests -> Parser SlowTests)
-> Mod FlagFields SlowTests -> Parser SlowTests
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields SlowTests] -> Mod FlagFields SlowTests
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod FlagFields SlowTests
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Tagged SlowTests String -> String
forall {k} (s :: k) b. Tagged s b -> b
untag (Tagged SlowTests String
forall v. IsOption v => Tagged v String
optionName :: Tagged SlowTests String))
      , String -> Mod FlagFields SlowTests
forall (f :: * -> *) a. String -> Mod f a
help (Tagged SlowTests String -> String
forall {k} (s :: k) b. Tagged s b -> b
untag (Tagged SlowTests String
forall v. IsOption v => Tagged v String
optionHelp :: Tagged SlowTests String))
      ]

-- | Takes a name, a sequential sink, and a parallel sink and generates tasty
-- tests from these.
--
-- The parallel and sequential sink should perform the same tasks so their
-- results can be compared to check correctness.
--
-- The sinks should take a list of input data, a function processing the data,
-- and return a result that can be compared for equality.
--
-- Furthermore the parallel sink should take a number indicating how many
-- concurrent consumers should be used.
--
-- @since 0.2.0
genStreamTests
    :: (Eq r, Show r)
    => String -- ^ Name to group tests under
    -> ([Int] -> (Int -> IO Int) -> IO r) -- ^ Sequential sink
    -> (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
    -- ^ Parallel sink
    -> TestTree
genStreamTests :: forall r.
(Eq r, Show r) =>
String
-> ([Int] -> (Int -> IO Int) -> IO r)
-> (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
-> TestTree
genStreamTests String
name [Int] -> (Int -> IO Int) -> IO r
seq Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r
par = (SlowTests -> TestTree) -> TestTree
forall v. IsOption v => (v -> TestTree) -> TestTree
askOption ((SlowTests -> TestTree) -> TestTree)
-> (SlowTests -> TestTree) -> TestTree
forall a b. (a -> b) -> a -> b
$ \(SlowTests Bool
slow) ->
    IO (TVar (Map ([Int], Int) (MVar (r, Double))))
-> (TVar (Map ([Int], Int) (MVar (r, Double))) -> Assertion)
-> (IO (TVar (Map ([Int], Int) (MVar (r, Double)))) -> TestTree)
-> TestTree
forall a.
IO a -> (a -> Assertion) -> (IO a -> TestTree) -> TestTree
withResource (Map ([Int], Int) (MVar (r, Double))
-> IO (TVar (Map ([Int], Int) (MVar (r, Double))))
forall a. a -> IO (TVar a)
newTVarIO Map ([Int], Int) (MVar (r, Double))
forall k a. Map k a
M.empty) (Assertion
-> TVar (Map ([Int], Int) (MVar (r, Double))) -> Assertion
forall a b. a -> b -> a
const (Assertion
 -> TVar (Map ([Int], Int) (MVar (r, Double))) -> Assertion)
-> Assertion
-> TVar (Map ([Int], Int) (MVar (r, Double)))
-> Assertion
forall a b. (a -> b) -> a -> b
$ () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ((IO (TVar (Map ([Int], Int) (MVar (r, Double)))) -> TestTree)
 -> TestTree)
-> (IO (TVar (Map ([Int], Int) (MVar (r, Double)))) -> TestTree)
-> TestTree
forall a b. (a -> b) -> a -> b
$ \IO (TVar (Map ([Int], Int) (MVar (r, Double))))
getCache ->
    let
        testTree :: String
-> ParamFun l TestTree -> (Params '[] -> Params l) -> TestTree
testTree = Maybe String
-> (String -> [TestTree] -> TestTree)
-> String
-> ParamFun l TestTree
-> (Params '[] -> Params l)
-> TestTree
forall a (l :: [*]).
Maybe String
-> (String -> [a] -> a)
-> String
-> ParamFun l a
-> (Params '[] -> Params l)
-> a
growTree (String -> Maybe String
forall a. a -> Maybe a
Just String
".") String -> [TestTree] -> TestTree
testGroup
        threads :: Params l -> Params (Int : l)
threads = String -> [Int] -> Params l -> Params (Int : l)
forall a (l :: [*]).
(Eq a, Show a) =>
String -> [a] -> Params l -> Params (a : l)
simpleParam String
"threads" [Int
1,Int
2,Int
5]
        bigInputs :: Params l -> Params ([Int] : l)
bigInputs | Bool
slow = (Int -> [Int]) -> String -> [Int] -> Params l -> Params ([Int] : l)
forall r a (l :: [*]).
(Eq r, Show a) =>
(a -> r) -> String -> [a] -> Params l -> Params (r : l)
derivedParam (Int -> Int -> [Int]
forall a. Enum a => a -> a -> [a]
enumFromTo Int
0) String
"inputs" [Int
600]
                  | Bool
otherwise = (Int -> [Int]) -> String -> [Int] -> Params l -> Params ([Int] : l)
forall r a (l :: [*]).
(Eq r, Show a) =>
(a -> r) -> String -> [a] -> Params l -> Params (r : l)
derivedParam (Int -> Int -> [Int]
forall a. Enum a => a -> a -> [a]
enumFromTo Int
0) String
"inputs" [Int
300]
        smallInputs :: Params l -> Params ([Int] : l)
smallInputs = (Int -> [Int]) -> String -> [Int] -> Params l -> Params ([Int] : l)
forall r a (l :: [*]).
(Eq r, Show a) =>
(a -> r) -> String -> [a] -> Params l -> Params (r : l)
derivedParam (Int -> Int -> [Int]
forall a. Enum a => a -> a -> [a]
enumFromTo Int
0) String
"inputs" [Int
0,Int
1,Int
2]
        pause :: Params l -> Params (Int : l)
pause = String -> [Int] -> Params l -> Params (Int : l)
forall a (l :: [*]).
(Eq a, Show a) =>
String -> [a] -> Params l -> Params (a : l)
simpleParam String
"pause" [Int
10Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
4 :: Int)]

    in String -> [TestTree] -> TestTree
testGroup String
name
        [ String
-> ParamFun '[Int, [Int]] TestTree
-> (Params '[] -> Params '[Int, [Int]])
-> TestTree
forall {l :: [*]}.
String
-> ParamFun l TestTree -> (Params '[] -> Params l) -> TestTree
testTree String
"output" (([Int] -> (Int -> IO Int) -> IO r)
-> ([Int] -> (Int -> IO Int) -> Int -> IO r)
-> Int
-> [Int]
-> String
-> TestTree
forall r.
(Eq r, Show r) =>
([Int] -> (Int -> IO Int) -> IO r)
-> ([Int] -> (Int -> IO Int) -> Int -> IO r)
-> Int
-> [Int]
-> String
-> TestTree
outputTest [Int] -> (Int -> IO Int) -> IO r
seq (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r
par Handler IO Int
forall {m :: * -> *} {a}. Handler m a
term)) ((Params '[] -> Params '[Int, [Int]]) -> TestTree)
-> (Params '[] -> Params '[Int, [Int]]) -> TestTree
forall a b. (a -> b) -> a -> b
$
            Params '[[Int]] -> Params '[Int, [Int]]
forall {l :: [*]}. Params l -> Params (Int : l)
threads (Params '[[Int]] -> Params '[Int, [Int]])
-> (Params '[] -> Params '[[Int]])
-> Params '[]
-> Params '[Int, [Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Params '[] -> Params '[[Int]]] -> Params '[] -> Params '[[Int]]
forall (r :: [*]) (l :: [*]).
[Params r -> Params l] -> Params r -> Params l
paramSets [ Params '[] -> Params '[[Int]]
forall {l :: [*]}. Params l -> Params ([Int] : l)
smallInputs, Params '[] -> Params '[[Int]]
forall {l :: [*]}. Params l -> Params ([Int] : l)
bigInputs ]
        , String
-> ParamFun '[Int, [Int], Int] TestTree
-> (Params '[] -> Params '[Int, [Int], Int])
-> TestTree
forall {l :: [*]}.
String
-> ParamFun l TestTree -> (Params '[] -> Params l) -> TestTree
testTree String
"speedup" (IO (TVar (Map ([Int], Int) (MVar (r, Double))))
-> ([Int] -> (Int -> IO Int) -> IO r)
-> ([Int] -> (Int -> IO Int) -> Int -> IO r)
-> Int
-> [Int]
-> Int
-> String
-> TestTree
forall r.
(Eq r, Show r) =>
IO (TVar (Map ([Int], Int) (MVar (r, Double))))
-> ([Int] -> (Int -> IO Int) -> IO r)
-> ([Int] -> (Int -> IO Int) -> Int -> IO r)
-> Int
-> [Int]
-> Int
-> String
-> TestTree
speedupTest IO (TVar (Map ([Int], Int) (MVar (r, Double))))
getCache [Int] -> (Int -> IO Int) -> IO r
seq (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r
par Handler IO Int
forall {m :: * -> *} {a}. Handler m a
term)) ((Params '[] -> Params '[Int, [Int], Int]) -> TestTree)
-> (Params '[] -> Params '[Int, [Int], Int]) -> TestTree
forall a b. (a -> b) -> a -> b
$
            Params '[[Int], Int] -> Params '[Int, [Int], Int]
forall {l :: [*]}. Params l -> Params (Int : l)
threads (Params '[[Int], Int] -> Params '[Int, [Int], Int])
-> (Params '[] -> Params '[[Int], Int])
-> Params '[]
-> Params '[Int, [Int], Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params '[Int] -> Params '[[Int], Int]
forall {l :: [*]}. Params l -> Params ([Int] : l)
bigInputs (Params '[Int] -> Params '[[Int], Int])
-> (Params '[] -> Params '[Int])
-> Params '[]
-> Params '[[Int], Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params '[] -> Params '[Int]
forall {l :: [*]}. Params l -> Params (Int : l)
pause
        , String -> [TestTree] -> TestTree
testGroup String
"exceptions"
            [ ([Int] -> (Int -> IO Int) -> IO r)
-> (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
-> TestTree
forall r.
(Eq r, Show r) =>
([Int] -> (Int -> IO Int) -> IO r)
-> (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
-> TestTree
dropTest [Int] -> (Int -> IO Int) -> IO r
seq Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r
par
            , (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
-> TestTree
forall r.
(Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
-> TestTree
terminationTest Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r
par
            , (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
-> TestTree
forall r.
(Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
-> TestTree
raceTest Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r
par
            , ([Int] -> (Int -> IO Int) -> IO r)
-> (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
-> TestTree
forall r.
(Eq r, Show r) =>
([Int] -> (Int -> IO Int) -> IO r)
-> (Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r)
-> TestTree
retryTest [Int] -> (Int -> IO Int) -> IO r
seq Handler IO Int -> [Int] -> (Int -> IO Int) -> Int -> IO r
par
            ]
        ]
  where
    term :: Handler m a
term = Action -> Handler m a
forall (m :: * -> *) a. Action -> Handler m a
Simple Action
Terminate

-- | Run a list of 'TestTree'​'s and group them under the specified name.
--
-- @since 0.2.0
runTests :: String -> [TestTree] -> IO ()
runTests :: String -> [TestTree] -> Assertion
runTests String
name [TestTree]
tests = do
    Int -> Assertion
setNumCapabilities Int
5
    String -> String -> Assertion
setEnv String
"TASTY_NUM_THREADS" String
"100"
    [Ingredient] -> TestTree -> Assertion
defaultMainWithIngredients [Ingredient]
ingredients (TestTree -> Assertion) -> TestTree -> Assertion
forall a b. (a -> b) -> a -> b
$ String -> [TestTree] -> TestTree
testGroup String
name [TestTree]
tests
  where
    ingredients :: [Ingredient]
ingredients =
      [ [OptionDescription] -> Ingredient
includingOptions [Proxy SlowTests -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy SlowTests
forall {k} (t :: k). Proxy t
Proxy :: Proxy SlowTests)]
      , Ingredient
listingTests
      , Ingredient
consoleTestReporter
      ]

withTime :: IO a -> IO (a, TimeSpec)
withTime :: forall a. IO a -> IO (a, TimeSpec)
withTime IO a
act = do
    TimeSpec
start <- Clock -> IO TimeSpec
getTime Clock
Monotonic
    a
r <- IO a
act
    TimeSpec
end <- Clock -> IO TimeSpec
getTime Clock
Monotonic
    (a, TimeSpec) -> IO (a, TimeSpec)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, TimeSpec) -> IO (a, TimeSpec))
-> (a, TimeSpec) -> IO (a, TimeSpec)
forall a b. (a -> b) -> a -> b
$ (a
r, TimeSpec -> TimeSpec -> TimeSpec
diffTimeSpec TimeSpec
start TimeSpec
end)