git.iko.soy/typeable/ether
on master help sign in
Test-suite update (T4)
commitde435be84e590c1be69b649c0c18adf765dd4f9c authorIndex Int <vlad.z.4096@gmail.com> dateFri 22 Jan 2016, 23:31 (11 years ago) parent21a27c1
5 files changed+32−28
compare with master
unifiedsplit
test/Regression.hs−16 test/Regression/T1.hs+5−5 test/Regression/T2.hs+3−3 test/Regression/T3.hs+3−3 test/Regression/T4.hs+21−1
test/Regression.hs−16
@@ -23,7 +23,6 @@ import Regression.T5
2323import Regression.T6
2424
2525ethereal "R1" "r1"
26−ethereal "R2" "r2"
2726ethereal "S1" "s1"
2827ethereal "Foo" "foo"
2928ethereal "Bar" "bar"
@@ -41,21 +40,6 @@ suite = testGroup "Ether"
4140 , test6
4241 ]
4342
44−nonUniqueTagsCore :: IO ()
45−nonUniqueTagsCore
46− = flip (runReaderT r1) (1 :: Int)
47− . flip (runReaderT r1) (True :: Bool)
48− . flip (runReaderT r1) (2 :: Int)
49− . flip (runReaderT r1) (3 :: Integer)
50− $ do
51− a :: Integer <- ask r1
52− b :: Int <- ask r1
53− c :: Bool <- ask r1
54− T.liftIO $ do
55− print a
56− print b
57− print c
58−
5943stateCore :: Ether '[S1 <-> Int, R1 --> Int] m => m ()
6044stateCore = do
6145 a <- ask r1
test/Regression/T1.hs+5−5
@@ -26,14 +26,14 @@ runner1 s1 s2 = flip (runReader tag1) s1 . flip (runReaderT tag2) s2
2626runner2 s1 s2 = flip (runReader tag2) s2 . flip (runReaderT tag1) s1
2727
2828test1 :: TestTree
29−test1 = testGroup "T1: Reader.local"
30− [ testProperty "runner1 works"
29+test1 = testGroup "T1: Reader local environment"
30+ [ testProperty "runner₁ works"
3131 $ \s1 s2 -> property
3232 $ runner1 s1 s2 testEther == ((s1, s2), (s1, map succ s2))
33− , testProperty "runner1 works"
33+ , testProperty "runner₂ works"
3434 $ \s1 s2 -> property
35− $ runner1 s1 s2 testEther == ((s1, s2), (s1, map succ s2))
36− , testProperty "runner1 == runner2"
35+ $ runner2 s1 s2 testEther == ((s1, s2), (s1, map succ s2))
36+ , testProperty "runner₁ == runner₂"
3737 $ \s1 s2 -> property
3838 $ runner1 s1 s2 testEther == runner2 s1 s2 testEther
3939 ]
test/Regression/T2.hs+3−3
@@ -18,13 +18,13 @@ runner2 (n :: Integer) = flip I.runReader True . flip I.runReaderT n
1818
1919test2 :: TestTree
2020test2 = testGroup "T2: Implicit tags"
21− [ testProperty "runner1 works"
21+ [ testProperty "runner₁ works"
2222 $ \n -> property
2323 $ runner1 n testEther == show (succ n)
24− , testProperty "runner2 works"
24+ , testProperty "runner₂ works"
2525 $ \n -> property
2626 $ runner2 n testEther == show (succ n)
27− , testProperty "runner1 == runner2"
27+ , testProperty "runner₁ == runner₂"
2828 $ \n -> property
2929 $ runner1 n testEther == runner2 n testEther
3030 ]
test/Regression/T3.hs+3−3
@@ -40,17 +40,17 @@ runner2 s r
4040
4141test3 :: TestTree
4242test3 = testGroup "T3: Tag attachement"
43− [ testProperty "runner1 works"
43+ [ testProperty "runner₁ works"
4444 $ \s r -> property
4545 $ (==)
4646 (runner1 s r testEther)
4747 ((s * r, s + r, negate r * 2), negate (s + r))
48− , testProperty "runner2 works"
48+ , testProperty "runner₂ works"
4949 $ \s r -> property
5050 $ (==)
5151 (runner2 s r testEther)
5252 ((s * r, s + r, negate r * 2), negate (s + r))
53− , testProperty "runner1 == runner2"
53+ , testProperty "runner₁ == runner₂"
5454 $ \s r -> property
5555 $ runner1 s r testEther == runner2 s r testEther
5656 ]
test/Regression/T4.hs+21−1
@@ -1,6 +1,26 @@
11module Regression.T4 (test4) where
22
3+import Control.Ether.Abbr
4+import Control.Monad.Ether
5+
36import Test.Tasty
7+import Test.Tasty.QuickCheck
8+
9+ethereal "RTag" "rTag"
10+
11+testEther :: Ether '[RTag --> Int] m => m Int
12+testEther = ask rTag
13+
14+runner r
15+ = flip (runReader rTag) (r' :: Int)
16+ . flip (runReaderT rTag) (r :: Int)
17+ . flip (runReaderT rTag) (fromIntegral r' :: Integer)
18+ where
19+ r' = negate r
420
521test4 :: TestTree
6−test4 = testGroup "T4:" []
22+test4 = testGroup "T4: Nested same-tag readers"
23+ [ testProperty "runner works"
24+ $ \r -> property
25+ $ runner r testEther == r
26+ ]