Skip to content
This repository
Browse code

Allow tunneling of ImprovingIO and use it to report test count in qui…

…ckcheck2 provider
  • Loading branch information...
commit f03afed662c59478760eb895c6a149359c839a9d 1 parent fc90ecb
Max Bolingbroke authored December 06, 2012
6  core/Test/Framework/Improving.hs
... ...
@@ -1,6 +1,6 @@
1 1
 module Test.Framework.Improving (
2 2
         (:~>)(..), bimapImproving, improvingLast, consumeImproving,
3  
-        ImprovingIO, yieldImprovement, runImprovingIO, liftIO,
  3
+        ImprovingIO, yieldImprovement, runImprovingIO, tunnelImprovingIO, liftIO,
4 4
         timeoutImprovingIO, maybeTimeoutImprovingIO
5 5
     ) where
6 6
 
@@ -49,6 +49,10 @@ yieldImprovement improvement = IIO $ \chan -> do
49 49
     yield
50 50
     writeChan chan (Left improvement)
51 51
 
  52
+-- NB: could have a more general type but it would be impredicative
  53
+tunnelImprovingIO :: ImprovingIO i f (ImprovingIO i f a -> IO a)
  54
+tunnelImprovingIO = IIO $ \chan -> return $ \iio -> unIIO iio chan
  55
+
52 56
 runImprovingIO :: ImprovingIO i f f -> IO (i :~> f, IO ())
53 57
 runImprovingIO iio = do
54 58
     chan <- newChan
2  core/test-framework.cabal
... ...
@@ -1,5 +1,5 @@
1 1
 Name:                test-framework
2  
-Version:             0.7.0
  2
+Version:             0.7.1
3 3
 Cabal-Version:       >= 1.2.3
4 4
 Category:            Testing
5 5
 Synopsis:            Framework for running and organising tests, with HUnit and QuickCheck support
6  quickcheck2/Test/Framework/Providers/QuickCheck2.hs
@@ -8,7 +8,8 @@ module Test.Framework.Providers.QuickCheck2 (
8 8
 
9 9
 import Test.Framework.Providers.API
10 10
 
11  
-import Test.QuickCheck.Property (Testable)
  11
+import Test.QuickCheck.Property (Testable, Callback(PostTest), CallbackKind(NotCounterexample), callback)
  12
+import Test.QuickCheck.State (numSuccessTests)
12 13
 import Test.QuickCheck.Test
13 14
 
14 15
 import Data.Typeable
@@ -80,8 +81,9 @@ runProperty topts testable = do
80 81
                        , chatty = False }
81 82
     -- FIXME: yield gradual improvement after each test
82 83
     runImprovingIO $ do
  84
+        tunnel <- tunnelImprovingIO
83 85
         mb_result <- maybeTimeoutImprovingIO (unK (topt_timeout topts)) $
84  
-          liftIO $ quickCheckWithResult args testable
  86
+          liftIO $ quickCheckWithResult args (callback (PostTest NotCounterexample (\s _r -> tunnel $ yieldImprovement $ numSuccessTests s)) testable)
85 87
         return $ case mb_result of
86 88
             Nothing     -> PropertyResult { pr_status = PropertyTimedOut, pr_used_seed = seed, pr_tests_run = Nothing }
87 89
             Just result -> PropertyResult {
2  quickcheck2/test-framework-quickcheck2.cabal
@@ -22,7 +22,7 @@ Flag Base3
22 22
 Library
23 23
         Exposed-Modules:        Test.Framework.Providers.QuickCheck2
24 24
 
25  
-        Build-Depends:          test-framework >= 0.6, QuickCheck >= 2.4 && < 2.6, extensible-exceptions >= 0.1.1 && < 0.2.0
  25
+        Build-Depends:          test-framework >= 0.7.1, QuickCheck >= 2.4 && < 2.6, extensible-exceptions >= 0.1.1 && < 0.2.0
26 26
         if flag(base3)
27 27
                 Build-Depends:          base >= 3 && < 4, random >= 1
28 28
         else

0 notes on commit f03afed

Please sign in to comment.
Something went wrong with that request. Please try again.