1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Spec.Stateful where
import Control.Concurrent.STM
import Control.Monad.ST
import Control.Monad.Trans.State.Strict
import Data.Proxy
import Data.Typeable
import System.Random.Stateful
import Test.SmallCheck.Series
import Test.Tasty
import Test.Tasty.SmallCheck as SC
instance Monad m => Serial m StdGen where
series = mkStdGen <$> series
instance (Monad m, Serial m g) => Serial m (AtomicGen g) where
series = AtomicGen <$> series
instance (Monad m, Serial m g) => Serial m (IOGen g) where
series = IOGen <$> series
instance (Monad m, Serial m g) => Serial m (STGen g) where
series = STGen <$> series
instance (Monad m, Serial m g) => Serial m (TGen g) where
series = TGen <$> series
instance (Monad m, Serial m g) => Serial m (StateGen g) where
series = StateGen <$> series
matchRandomGenSpec ::
forall b f m. (FrozenGen f m, Eq f, Show f, Eq b)
=> (forall a. m a -> IO a)
-> (MutableGen f m -> m b)
-> (StdGen -> (b, StdGen))
-> (f -> StdGen)
-> f
-> Property IO
matchRandomGenSpec toIO genM gen toStdGen frozen =
monadic $ do
(x1, fg1) <- toIO $ withMutableGen frozen genM
let (x2, g2) = gen $ toStdGen frozen
pure $ x1 == x2 && toStdGen fg1 == g2
withMutableGenSpec ::
forall f m. (FrozenGen f m, Eq f, Show f)
=> (forall a. m a -> IO a)
-> f
-> Property IO
withMutableGenSpec toIO frozen =
forAll $ \n -> monadic $ do
let gen = uniformListM n
x :: ([Word], f) <- toIO $ withMutableGen frozen gen
y <- toIO $ withMutableGen frozen gen
pure $ x == y
statefulSpecFor ::
forall f m. (FrozenGen f m, Eq f, Show f, Serial IO f, Typeable f)
=> (forall a. m a -> IO a)
-> (f -> StdGen)
-> TestTree
statefulSpecFor toIO toStdGen =
testGroup
(showsTypeRep (typeRep (Proxy :: Proxy f)) "")
[ testProperty "withMutableGen" $
forAll $ \(f :: f) -> withMutableGenSpec toIO f
, testGroup
"matchRandomGenSpec"
[ testProperty "uniformWord8/genWord8" $
forAll $ \(f :: f) ->
matchRandomGenSpec toIO uniformWord8 genWord8 toStdGen f
, testProperty "uniformWord16/genWord16" $
forAll $ \(f :: f) ->
matchRandomGenSpec toIO uniformWord16 genWord16 toStdGen f
, testProperty "uniformWord32/genWord32" $
forAll $ \(f :: f) ->
matchRandomGenSpec toIO uniformWord32 genWord32 toStdGen f
, testProperty "uniformWord64/genWord64" $
forAll $ \(f :: f) ->
matchRandomGenSpec toIO uniformWord64 genWord64 toStdGen f
, testProperty "uniformWord32R/genWord32R" $
forAll $ \(w32, f :: f) ->
matchRandomGenSpec toIO (uniformWord32R w32) (genWord32R w32) toStdGen f
, testProperty "uniformWord64R/genWord64R" $
forAll $ \(w64, f :: f) ->
matchRandomGenSpec toIO (uniformWord64R w64) (genWord64R w64) toStdGen f
, testProperty "uniformShortByteString/genShortByteString" $
forAll $ \(n', f :: f) ->
let n = abs n' `mod` 1000 -- Ensure it is not too big
in matchRandomGenSpec toIO (uniformShortByteString n) (genShortByteString n) toStdGen f
]
]
statefulSpec :: TestTree
statefulSpec =
testGroup
"Stateful"
[ statefulSpecFor id unIOGen
, statefulSpecFor id unAtomicGen
, statefulSpecFor stToIO unSTGen
, statefulSpecFor atomically unTGen
, statefulSpecFor (`evalStateT` mkStdGen 0) unStateGen
]
|
