git.iko.soy/reflex
on develop help sign in
Add cross-impl test suite to cabal file
commit4930de2aa199671346b992c9a13995c8279055d7 authorRyan Trinkle <ryan.trinkle@gmail.com> dateSat 25 Jul 2015, 03:51 (11 years ago) parent0675c70
3 files changed+29−8
compare with develop
unifiedsplit
reflex.cabal+14 test/Reflex/Pure.hs+1−1 test/Reflex/Test/CrossImpl.hs+14−7
reflex.cabal+14
@@ -44,6 +44,20 @@ library
4444 ghc-prof-options: -fprof-auto
4545 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
4646
47+test-suite cross-impl
48+ type: exitcode-stdio-1.0
49+ main-is: Reflex/Test/CrossImpl.hs
50+ ghc-options: -O2 -main-is Reflex.Test.CrossImpl.test
51+ hs-source-dirs: test
52+ build-depends:
53+ base,
54+ reflex,
55+ ref-tf,
56+ mtl,
57+ containers,
58+ dependent-map,
59+ MemoTrie == 0.6.*
60+
4761benchmark spider-bench
4862 type: exitcode-stdio-1.0
4963 hs-source-dirs: bench
test/Reflex/Pure.hs+1−1
@@ -1,6 +1,6 @@
11{- | This module provides a pure implementation of Reflex, which is intended to serve as a reference for the semantics of the Reflex class. All implementations of Reflex should produce the same results as this implementation, although performance and laziness/strictness may differ.
22-}
3−{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}
3+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, EmptyDataDecls #-}
44module Reflex.Pure where
55
66import Reflex.Class
test/Reflex/Test/CrossImpl.hs+14−7
@@ -21,6 +21,7 @@ import Control.Monad.State.Strict hiding (mapM, mapM_, forM, forM_, sequence, se
2121import Control.Monad.Writer hiding (mapM, mapM_, forM, forM_, sequence, sequence_)
2222import Data.Dependent.Map (DSum (..))
2323import System.Mem
24+import System.Exit
2425
2526import System.IO.Unsafe
2627
@@ -85,16 +86,20 @@ testSpider builder (bMap, eMap) = unsafePerformIO $ S.runSpiderHost $ do
8586tracePerf :: Show a => a -> b -> b
8687tracePerf = flip const
8788
88−testAgreement :: (Eq c, Eq d, Show c, Show d) => (forall m t. TestCaseConstraint t m => (Behavior t a, Event t b) -> m (Behavior t c, Event t d)) -> (Map Int a, Map Int b) -> IO ()
89+testAgreement :: (Eq c, Eq d, Show c, Show d) => (forall m t. TestCaseConstraint t m => (Behavior t a, Event t b) -> m (Behavior t c, Event t d)) -> (Map Int a, Map Int b) -> IO Bool
8990testAgreement builder inputs = do
9091 let identityResult = testPure builder inputs
9192 tracePerf "---------" $ return ()
9293 let spiderResult = testSpider builder inputs
9394 tracePerf "---------" $ return ()
94− if identityResult == spiderResult then putStrLn "Success:" >> print identityResult else do
95− putStrLn "Failure:"
96− putStrLn $ "Pure result: " <> show identityResult
97− putStrLn $ "Spider result: " <> show spiderResult
95+ let resultsAgree = identityResult == spiderResult
96+ if resultsAgree
97+ then do putStrLn "Success:"
98+ print identityResult
99+ else do putStrLn "Failure:"
100+ putStrLn $ "Pure result: " <> show identityResult
101+ putStrLn $ "Spider result: " <> show spiderResult
102+ return resultsAgree
98103
99104type TestCaseConstraint t m = (Reflex t, MonadSample t m, MonadHold t m, MonadFix m, MonadFix (PushM t))
100105
@@ -215,7 +220,9 @@ testCases =
215220
216221test :: IO ()
217222test = do
218− forM_ testCases $ \(name, TestCase inputs builder) -> do
223+ results <- forM testCases $ \(name, TestCase inputs builder) -> do
219224 putStrLn $ "Test: " <> name
220225 testAgreement builder inputs
221− return ()
226+ exitWith $ if and results
227+ then ExitSuccess
228+ else ExitFailure 1