hsbencher 1.3.1 → 1.3.4
raw patch · 2 files changed
+57/−24 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- HSBencher/App.hs +54/−23
- hsbencher.cabal +3/−1
HSBencher/App.hs view
@@ -282,28 +282,30 @@ ------------------------------------------ -- (3) Produce output to the right places: ------------------------------------------+ let pads n s = take (max 1 (n - length s)) $ repeat ' '+ padl n x = pads n x ++ x + padr n x = x ++ pads n x (t1,t2,t3,p1,p2,p3) <-- if not (all didComplete nruns) then do- log $ "\n >>> MIN/MEDIAN/MAX (TIME,PROD) -- got ERRORS: " ++show nruns+ if all isError nruns then do+ log $ "\n >>> MIN/MEDIAN/MAX (TIME,PROD) -- got only ERRORS: " ++show nruns+ logOn [ResultsFile]$ + printf "# %s %s %s %s %s" (padr 35 testRoot) (padr 20$ intercalate "_" args)+ (padr 8$ sched) (padr 3$ show numthreads) (" ALL_ERRORS"::String) return ("","","","","","")- else do + else do+ let goodruns = filter (not . isError) nruns -- Extract the min, median, and max:- let sorted = sortBy (\ a b -> compare (realtime a) (realtime b)) nruns+ sorted = sortBy (\ a b -> compare (gettime a) (gettime b)) goodruns minR = head sorted maxR = last sorted medianR = sorted !! (length sorted `quot` 2) let ts@[t1,t2,t3] = map (\x -> showFFloat Nothing x "")- [realtime minR, realtime medianR, realtime maxR]- prods@[p1,p2,p3] = map mshow [productivity minR, productivity medianR, productivity maxR]+ [gettime minR, gettime medianR, gettime maxR]+ prods@[p1,p2,p3] = map mshow [getprod minR, getprod medianR, getprod maxR] mshow Nothing = "" mshow (Just x) = showFFloat (Just 2) x "" - let - pads n s = take (max 1 (n - length s)) $ repeat ' '- padl n x = pads n x ++ x - padr n x = x ++ pads n x- -- These are really (time,prod) tuples, but a flat list of -- scalars is simpler and readable by gnuplot: formatted = (padl 15$ unwords $ ts)@@ -321,13 +323,13 @@ , _VARIANT = sched , _ARGS = args , _THREADS = numthreads- , _MINTIME = realtime minR- , _MEDIANTIME = realtime medianR- , _MAXTIME = realtime maxR- , _MINTIME_PRODUCTIVITY = productivity minR- , _MEDIANTIME_PRODUCTIVITY = productivity medianR- , _MAXTIME_PRODUCTIVITY = productivity maxR- , _ALLTIMES = unwords$ map (show . realtime) nruns+ , _MINTIME = gettime minR+ , _MEDIANTIME = gettime medianR+ , _MAXTIME = gettime maxR+ , _MINTIME_PRODUCTIVITY = getprod minR+ , _MEDIANTIME_PRODUCTIVITY = getprod medianR+ , _MAXTIME_PRODUCTIVITY = getprod maxR+ , _ALLTIMES = unwords$ map (show . gettime) goodruns , _TRIALS = trials } result' <- liftIO$ augmentResultWithConfig conf result@@ -403,7 +405,7 @@ ---------------------------------------------------------------------------------------------------- --- | TODO: Eventually this will be parameterized.+-- | TODO: Eventually this will make sense when all config can be read from the environment, args, files. defaultMain :: IO () defaultMain = do -- benchF = get "BENCHLIST" "benchlist.txt"@@ -429,7 +431,7 @@ writeIORef main_threadid id cli_args <- getArgs- let (options,args,errs) = getOpt Permute (concat$ map snd all_cli_options) cli_args+ let (options,plainargs,errs) = getOpt Permute (concat$ map snd all_cli_options) cli_args let recomp = NoRecomp `notElem` options when (ShowVersion `elem` options) $ do@@ -438,18 +440,30 @@ (unwords$ versionTags version) exitSuccess - when (not (null errs && null args) || ShowHelp `elem` options) $ do+ when (not (null errs) || ShowHelp `elem` options) $ do unless (ShowHelp `elem` options) $ putStrLn$ "Errors parsing command line options:" mapM_ (putStr . (" "++)) errs putStrLn$ "\nUSAGE: [set ENV VARS] "++my_name++" [CMDLN OPTIONS]"+ putStrLn$ "USAGE: command line options include patterns that select the benchmarks to run" mapM putStr (map (uncurry usageInfo) all_cli_options) putStrLn$ usageStr if (ShowHelp `elem` options) then exitSuccess else exitFailure conf0 <- getConfig options []- let conf1@Config{envs,benchlist,stdOut} = modConfig conf0 + -- The list of benchmarks can optionally be narrowed to match any of the given patterns.+ let conf1 = modConfig conf0+ cutlist = case plainargs of+ [] -> benchlist conf1+ patterns -> filter (\ Benchmark{target,cmdargs} ->+ any (\pat ->+ isInfixOf pat target ||+ any (isInfixOf pat) cmdargs)+ patterns)+ (benchlist conf1)+ let conf2@Config{envs,benchlist,stdOut} = conf1{benchlist=cutlist}+ hasMakefile <- doesFileExist "Makefile" cabalFile <- runLines "ls *.cabal" let hasCabalFile = (cabalFile /= []) &&@@ -457,6 +471,9 @@ rootDir <- getCurrentDirectory runReaderT (do+ unless (null plainargs) $+ logT$"There were "++show(length cutlist)++" benchmarks matching patterns: "++show plainargs+ logT$"Beginning benchmarking, root directory: "++rootDir let globalBinDir = rootDir </> "bin" when recomp $ do@@ -613,7 +630,7 @@ log$ "--------------------------------------------------------------------------------" liftIO$ exitSuccess )- conf1+ conf2 -- Several different options for how to display output in parallel:@@ -655,6 +672,20 @@ didComplete RunCompleted{} = True didComplete _ = False++isError ExitError{} = True+isError _ = False++getprod RunCompleted{productivity} = productivity+getprod RunTimeOut{} = Nothing+getprod x = error$"Cannot get productivity from: "++show x++gettime RunCompleted{realtime} = realtime+gettime RunTimeOut{} = posInf+gettime x = error$"Cannot get realtime from: "++show x++posInf :: Double+posInf = 1/0 -- Shorthand for tagged version: logT str = log$hsbencher_tag++str
hsbencher.cabal view
@@ -1,6 +1,6 @@ name: hsbencher-version: 1.3.1+version: 1.3.4 -- CHANGELOG: -- 1.0 : Initial release, new flexible benchmark format. -- 1.1 : Change interface to RunInPlace@@ -9,6 +9,8 @@ -- 1.2.1 : Hack to shorten tuples, annoying URL length problem. -- 1.3 : breaking change to Config/RunResult types -- 1.3.1 : bugfix+-- 1.3.2 : change policy for timeouts and errors+-- 1.3.4 : Add ability to prune/select benchmarks with commmand line args synopsis: Flexible benchmark runner for Haskell and non-Haskell benchmarks.