git.iko.soy/typeable/ether
on master help sign in
Test-suite update (T11) (#23)
9beca53Index Int
ether.cabal+1
compare with master
unifiedsplit
@@ -109,6 +109,7 @@ test-suite regression
109 Regression.T8
109 Regression.T8
110 Regression.T9
110 Regression.T9
111 Regression.T10
111 Regression.T10
112+ Regression.T11
112
113
113 type: exitcode-stdio-1.0
114 type: exitcode-stdio-1.0
114 hs-source-dirs: test
115 hs-source-dirs: test
test/Regression.hs+2
@@ -12,6 +12,7 @@ import Regression.T7
12import Regression.T8
12import Regression.T8
13import Regression.T9
13import Regression.T9
14import Regression.T10
14import Regression.T10
15+import Regression.T11
15
16
16main :: IO ()
17main :: IO ()
17main = defaultMain suite
18main = defaultMain suite
@@ -28,4 +29,5 @@ suite = testGroup "Ether"
28 , test8
29 , test8
29 , test9
30 , test9
30 , test10
31 , test10
32+ , test11
31 ]
33 ]
test/Regression/T11.hsnew file+50
@@ -0,0 +1,50 @@
1+module Regression.T11 (test11) where
2+
3+import Data.Bool
4+import Control.Monad.Ether
5+
6+import qualified Control.Monad.State as T
7+import qualified Control.Monad.Reader as T
8+
9+import Test.Tasty
10+import Test.Tasty.QuickCheck
11+
12+data STag
13+
14+testEther
15+ :: ( MonadState STag [Integer] m
16+ , T.MonadState Bool m
17+ , T.MonadReader Integer m )
18+ => m ()
19+testEther = do
20+ T.modify not
21+ f <- bool negate id <$> T.get
22+ n <- T.ask
23+ T.local succ testEther
24+ modify @STag (f n:)
25+
26+model :: Integer -> [Integer]
27+model n = zipWith ($) (cycle [id, negate]) [n..]
28+
29+runner1 n
30+ = flip (T.runReader) n
31+ . flip (execStateT @STag) []
32+ . flip T.evalStateT False
33+
34+runner2 n
35+ = flip T.evalState False
36+ . flip (execStateT @STag) []
37+ . flip T.runReaderT n
38+
39+test11 :: TestTree
40+test11 = testGroup "T11: Lazy sequence"
41+ [ testProperty "runner₁ works"
42+ $ \l n -> property
43+ $ take l (runner1 n testEther) == take l (model n)
44+ , testProperty "runner₂ works"
45+ $ \l n -> property
46+ $ take l (runner2 n testEther) == take l (model n)
47+ , testProperty "runner₁ == runner₂"
48+ $ \l n -> property
49+ $ take l (runner1 n testEther) == take l (runner2 n testEther)
50+ ]
test/Regression/T2.hs+3−3
@@ -9,7 +9,7 @@ import Test.Tasty.QuickCheck
9
9
10testEther :: Ether '[I.R Integer, I.R Bool] m => m String
10testEther :: Ether '[I.R Integer, I.R Bool] m => m String
11testEther = I.local (succ :: Integer -> Integer) $ do
11testEther = I.local (succ :: Integer -> Integer) $ do
12− n :: Integer <- I.ask
12+ n :: Integer <- I.asks (*2)
13 b <- I.local not I.ask
13 b <- I.local not I.ask
14 return (if b then "" else show n)
14 return (if b then "" else show n)
15
15
@@ -20,10 +20,10 @@ test2 :: TestTree
20test2 = testGroup "T2: Implicit tags"
20test2 = testGroup "T2: Implicit tags"
21 [ testProperty "runner₁ works"
21 [ testProperty "runner₁ works"
22 $ \n -> property
22 $ \n -> property
23− $ runner1 n testEther == show (succ n)
23+ $ runner1 n testEther == show (succ n * 2)
24 , testProperty "runner₂ works"
24 , testProperty "runner₂ works"
25 $ \n -> property
25 $ \n -> property
26− $ runner2 n testEther == show (succ n)
26+ $ runner2 n testEther == show (succ n * 2)
27 , testProperty "runner₁ == runner₂"
27 , testProperty "runner₁ == runner₂"
28 $ \n -> property
28 $ \n -> property
29 $ runner1 n testEther == runner2 n testEther
29 $ runner1 n testEther == runner2 n testEther
test/Regression/T7.hs+3−2
@@ -18,8 +18,9 @@ testEther
18 => [a] -> m ()
18 => [a] -> m ()
19testEther xs = do
19testEther xs = do
20 forM_ xs $ \x -> do
20 forM_ xs $ \x -> do
21− T.tell (Sum x)
21+ u1 <- T.tell (Sum x)
22− tell @WTag (Sum 1)
22+ u2 <- tell @WTag (Sum 1)
23+ when (u1 /= u2) $ error "Impossible"
23
24
24runner1 :: Num a => [a] -> (a, a)
25runner1 :: Num a => [a] -> (a, a)
25runner1 xs =
26runner1 xs =