git.iko.soy/streamly
on master help sign in
pass stream-size parameter to child process
54a1fc7Harendra Kumar
benchmark/Common.hs+26−13
compare with master
unifiedsplit
@@ -13,7 +13,7 @@ import Data.List (scanl')
13import Data.Maybe (catMaybes)
13import Data.Maybe (catMaybes)
14import System.Console.GetOpt
14import System.Console.GetOpt
15 (OptDescr(..), ArgDescr(..), ArgOrder(..), getOpt')
15 (OptDescr(..), ArgDescr(..), ArgOrder(..), getOpt')
16−import System.Environment (getArgs)
16+import System.Environment (getArgs, lookupEnv, setEnv)
17import Text.Read (readMaybe)
17import Text.Read (readMaybe)
18
18
19import Gauge
19import Gauge
@@ -24,6 +24,12 @@ import Gauge
24
24
25data BenchOpts = StreamSize Int deriving Show
25data BenchOpts = StreamSize Int deriving Show
26
26
27+getStreamSize :: String -> Int
28+getStreamSize size =
29+ case (readMaybe size :: Maybe Int) of
30+ Just x -> x
31+ Nothing -> error "Stream size must be numeric"
32+
27options :: [OptDescr BenchOpts]
33options :: [OptDescr BenchOpts]
28options =
34options =
29 [
35 [
@@ -32,11 +38,7 @@ options =
32
38
33 where
39 where
34
40
35− getSize :: String -> BenchOpts
36− getSize size =
37− case (readMaybe size :: Maybe Int) of
38− Just x -> StreamSize x
41+ getSize = StreamSize . getStreamSize
39− Nothing -> error "Stream size must be numeric"
40
42
41deleteOptArgs
43deleteOptArgs
42 :: (Maybe String, Maybe String) -- (prev, yielded)
44 :: (Maybe String, Maybe String) -- (prev, yielded)
@@ -59,18 +61,29 @@ parseCLIOpts defaultStreamSize = do
59 -- Parse custom options
61 -- Parse custom options
60 let (opts, _, _, errs) = getOpt' Permute options args
62 let (opts, _, _, errs) = getOpt' Permute options args
61 when (not $ null errs) $ error $ concat errs
63 when (not $ null errs) $ error $ concat errs
62− (streamSize, args') <- evaluate $
64+ (streamSize, args') <-
63 case opts of
65 case opts of
64− StreamSize x : _ ->
66+ StreamSize x : _ -> do
67+ -- When using the gauge "--measure-with" option we need to make
68+ -- sure that we pass the stream size to child process forked by
69+ -- gauge. So we use this env var for that purpose.
70+ setEnv "STREAM_SIZE" (show x)
65 -- Hack! remove the option and its argument from args
71 -- Hack! remove the option and its argument from args
66 -- getOpt should have a way to return the unconsumed args in
72 -- getOpt should have a way to return the unconsumed args in
67 -- correct order.
73 -- correct order.
68− let newArgs =
74+ newArgs <-
75+ evaluate
69− catMaybes
76+ $ catMaybes
70 $ map snd
77 $ map snd
71 $ scanl' deleteOptArgs (Nothing, Nothing) args
78 $ scanl' deleteOptArgs (Nothing, Nothing) args
72− in (x, newArgs)
79+ return (x, newArgs)
80+ _ -> do
81+ r <- lookupEnv "STREAM_SIZE"
82+ case r of
83+ Just x -> do
84+ s <- evaluate $ getStreamSize x
85+ return (s, args)
73− _ -> (defaultStreamSize, args)
86+ Nothing -> return (defaultStreamSize, args)
74
87
75 -- Parse gauge options
88 -- Parse gauge options
76 let config = defaultConfig
89 let config = defaultConfig
@@ -79,4 +92,4 @@ parseCLIOpts defaultStreamSize = do
79 , includeFirstIter = streamSize > defaultStreamSize
92 , includeFirstIter = streamSize > defaultStreamSize
80 }
93 }
81 let (cfg, benches) = parseWith config args'
94 let (cfg, benches) = parseWith config args'
82− return (streamSize, cfg, benches)
95+ streamSize `seq` return (streamSize, cfg, benches)