Permalink
Browse files

Add a fuzzing tool

  • Loading branch information...
batterseapower committed Dec 17, 2010
1 parent aff59e4 commit aef1601ad2407da961172dbf3524741dfc752391
Showing with 65 additions and 0 deletions.
  1. +50 −0 Control/Concurrent/ParallelIO/Fuzz.hs
  2. +15 −0 parallel-io.cabal
@@ -0,0 +1,50 @@
+module Main where
+
+import Data.IORef
+import qualified Numeric
+
+import System.Random
+
+import Control.Concurrent
+import Control.Concurrent.ParallelIO.Local
+
+import Control.Monad
+
+
+-- | Range for number of threads to spawn
+sPAWN_RANGE = (0, 100)
+
+-- | Delay range in microseconds
+dELAY_RANGE = (0, 1000000)
+
+-- | Out of 100 parallel actions, how many should recursively spawn?
+sPAWN_PERCENTAGE :: Int
+sPAWN_PERCENTAGE = 2
+
+-- | Number of threads to have processing work items
+mAX_WORKERS = 3
+
+
+showFloat2 :: RealFloat a => a -> String
+showFloat2 x = Numeric.showFFloat (Just 2) x ""
+
+
+expected :: Fractional b => (Int, Int) -> b
+expected (top, bottom) = fromIntegral (top + bottom) / 2
+
+main :: IO ()
+main = do
+ -- Birth rate is the rate at which new work items enter the queue
+ putStrLn $ "Expected birth rate: " ++ showFloat2 ((expected sPAWN_RANGE * (fromIntegral sPAWN_PERCENTAGE / 100) * fromIntegral mAX_WORKERS) / expected dELAY_RANGE :: Double)
+ -- Service rate is the rate at which work items are removed from the pool
+ putStrLn $ "Expected service rate: " ++ showFloat2 (fromIntegral mAX_WORKERS / expected dELAY_RANGE :: Double)
+ -- We are balanced on average if birth rate == service rate, i.e. expected sPAWN_RANGE * (fromIntegral sPAWN_PERCENTAGE / 100) == 1
+ putStrLn $ "Balance factor (should be 1): " ++ showFloat2 (expected sPAWN_RANGE * (fromIntegral sPAWN_PERCENTAGE / 100) :: Double)
+ withPool mAX_WORKERS $ \pool -> forever (fuzz pool)
+
+fuzz pool = do
+ n <- randomRIO sPAWN_RANGE
+ parallel_ pool $ replicate n $ do
+ should_spawn <- fmap (<= sPAWN_PERCENTAGE) $ randomRIO (1, 100)
+ randomRIO dELAY_RANGE >>= threadDelay
+ when should_spawn $ fuzz pool
View
@@ -26,6 +26,10 @@ Flag Benchmark
Description: Build the benchmarking tool
Default: False
+Flag Fuzz
+ Description: Build the fuzzing tool for discovering deadlocks
+ Default: False
+
Flag Tests
Description: Build the test runner
Default: False
@@ -61,3 +65,14 @@ Executable tests
test-framework >= 0.1.1, test-framework-hunit >= 0.1.1, HUnit >= 1.2 && < 2
Ghc-Options: -threaded
+
+Executable fuzz
+ Main-Is: Control/Concurrent/ParallelIO/Fuzz.hs
+
+ if !flag(fuzz)
+ Buildable: False
+ else
+ Build-Depends: base >= 4 && < 5, extensible-exceptions > 0.1.0.1, containers >= 0.2 && < 0.4, random >= 1.0 && < 1.1,
+ test-framework >= 0.1.1, test-framework-hunit >= 0.1.1, HUnit >= 1.2 && < 2
+
+ Ghc-Options: -threaded

0 comments on commit aef1601

Please sign in to comment.