pqc 0.4.1 → 0.4.2

raw patch · 2 files changed

+43/−18 lines, 2 filesdep +stm

Dependencies added: stm

Files

• Test/QuickCheck/Parallel.hs +35/−14
• pqc.cabal +8/−4

@@ -30,12 +30,15 @@  import Control.Concurrent #if   __GLASGOW_HASKELL__ < 702-import GHC.Conc           (numCapabilities)+import GHC.Conc           (numCapabilities, forkOnIO) #elif __GLASGOW_HASKELL__ < 704 #else import GHC.Conc           (getNumProcessors, setNumCapabilities) #endif-import Control.Monad      (forM_, unless)++import Control.Concurrent.STM (atomically)+import Control.Concurrent.STM.TVar+import Control.Monad      (forM_, unless, when) import System.Random import System.Exit import System.IO          (hFlush,stdout)@@ -70,20 +73,25 @@ #else     let num = numCapabilities #endif-    pRun num depth tests+    pRunWithNum num depth tests  -- | Variant of 'pRunWithNum'. Run a list of QuickCheck properties in parallel -- chunks, using all Processors. pRunAllProcessors  :: Int -> [Test] -> IO ()-#if __GLASGOW_HASKELL__ < 704-pRunAllProcessors = pRun'+#if   __GLASGOW_HASKELL__ < 702+pRunAllProcessors depth tests+  = pRunInternal forkOnIO numCapabilities depth tests+#elif __GLASGOW_HASKELL__ < 704+pRunAllProcessors depth tests = do+    num <- getNumCapabilities+    pRunInternal forkOn num depth tests #else pRunAllProcessors depth tests = do     caps <- getNumCapabilities     pros <- getNumProcessors     unless (caps == pros)       $ setNumCapabilities pros-    pRun pros depth tests+    pRunInternal forkOn pros depth tests #endif  -- | Run a list of QuickCheck properties in parallel chunks, using@@ -103,13 +111,16 @@ -- this function. -- pRunWithNum :: Int -> Int -> [Test] -> IO ()-pRunWithNum n depth tests = do+pRunWithNum = pRunInternal (\_ -> forkIO)++pRunInternal :: (Int -> IO () -> IO ThreadId) -> Int -> Int -> [Test] -> IO ()+pRunInternal fork n depth tests = do     chan <- newChan     ps   <- getChanContents chan     work <- newMVar tests-    ec'  <- newMVar ExitSuccess+    ec'  <- newTVarIO ExitSuccess -    forM_ [1..n] $ forkIO . thread work chan ec'+    forM_ [1..n] $ \num -> fork num $ thread work chan ec' num      let wait xs i             | i >= n    = return () -- done@@ -117,11 +128,11 @@                     Nothing : ys -> wait ys $! i+1                     Just s  : ys -> putStr s >> hFlush stdout >> wait ys i     wait ps 0-    ec <- takeMVar ec'+    ec <- readTVarIO ec'     exitWith ec    where-    thread :: MVar [Test] -> Chan (Maybe String) -> (MVar ExitCode) -> Int -> IO ()+    thread :: MVar [Test] -> Chan (Maybe String) -> (TVar ExitCode) -> Int -> IO ()     thread work chan ec' me = loop       where         loop = do@@ -135,12 +146,22 @@                     doesAnyFailureTest v ec'                     writeChan chan . Just $ printf "%d: %-25s: %s" me name $ output v                     loop-    doesAnyFailureTest :: Result -> MVar (ExitCode) -> IO ()++    doesAnyFailureTest :: Result -> TVar (ExitCode) -> IO ()     doesAnyFailureTest v ec'       = case v of-          (GaveUp _ _ _)          -> modifyMVar_ ec' (\_ -> return $ ExitFailure 1)-          (Failure _ _ _ _ _ _ _) -> modifyMVar_ ec' (\_ -> return $ ExitFailure 1)+          (GaveUp _ _ _)          -> noticeFailureTest ec'+          (Failure _ _ _ _ _ _ _) -> noticeFailureTest ec'           _                       -> return ()++    testFailure :: ExitCode+    testFailure = ExitFailure 1++    noticeFailureTest :: TVar (ExitCode) -> IO ()+    noticeFailureTest ec' = atomically $ do+        ec <- readTVar ec'+        when (ec == ExitSuccess)+          $ writeTVar ec' testFailure  -- | Wrap a property, and run it on a deterministic set of data pDet :: Testable a => a -> Int -> IO Result

@@ -1,5 +1,5 @@ name:                pqc-version:             0.4.1+version:             0.4.2 description:         Parallel batch driver for QuickCheck synopsis:            Parallel batch driver for QuickCheck category:            Testing@@ -20,9 +20,10 @@  library   if flag(split-base)-    build-depends:     base >= 3 && < 5, random, QuickCheck > 2.1 && < 3+    build-depends:     base >= 3 && < 5, random, stm+                     , QuickCheck > 2.1 && < 3   else-    build-depends:     base < 3, QuickCheck > 2.1 && < 3+    build-depends:     base < 3, stm, QuickCheck > 2.1 && < 3   default-language: Haskell2010   exposed-modules:  Test.QuickCheck.Parallel   ghc-options:      -Wall -O2@@ -33,7 +34,10 @@   buildable:       False   hs-source-dirs:  examples   default-language: Haskell2010-  build-depends:    base < 5, pqc, ChasingBottoms+  build-depends:    base < 5, pqc+                    -- If you want to test code involving bottoms,+                    -- use ChasingBottoms package.+                  , ChasingBottoms   -- for GHC 7.4.1 with pRunAllProcessors   -- ghc-options:      -threaded   -- for GHC 7.2.1 or higher