hsbencher 1.3.9 → 1.5.1
raw patch · 12 files changed
+475/−159 lines, 12 filesdep +HUnitdep +test-frameworkdep +test-framework-hunitdep ~handa-gdatadep ~io-streamsdep ~process
Dependencies added: HUnit, test-framework, test-framework-hunit, test-framework-th, text
Dependency ranges changed: handa-gdata, io-streams, process
Files
- HSBencher.hs +10/−1
- HSBencher/App.hs +76/−32
- HSBencher/Config.hs +25/−8
- HSBencher/Fusion.hs +64/−22
- HSBencher/MeasureProcess.hs +89/−54
- HSBencher/Methods.hs +23/−2
- HSBencher/Types.hs +70/−21
- HSBencher/Utils.hs +2/−5
- Test.hs +71/−0
- example/cabal/benchmark.hs +1/−1
- example/make_and_ghc/benchmark.hs +2/−2
- hsbencher.cabal +42/−11
HSBencher.hs view
@@ -4,7 +4,16 @@ module HSBencher (- module HSBencher.App,+ -- module HSBencher.App,++ -- Reproducing this here to get around the limitation of haddock 0.2 that it+ -- won't list all the bindings for reexports.++ -- * The main entrypoints for building new benchmark suites.+ defaultMainWithBechmarks, defaultMainModifyConfig,+ Flag(..), all_cli_options,++ -- * All the types necessary for configuration module HSBencher.Types ) where
HSBencher/App.hs view
@@ -29,7 +29,8 @@ import Debug.Trace import Data.Time.Clock (getCurrentTime, diffUTCTime) import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)-import Data.Maybe (isJust, fromJust, catMaybes)+import Data.Maybe (isJust, fromJust, catMaybes, fromMaybe)+import Data.Monoid import qualified Data.Map as M import Data.Word (Word64) import Data.IORef@@ -70,7 +71,7 @@ #ifdef FUSION_TABLES import HSBencher.Fusion import Network.Google.OAuth2 (getCachedTokens, refreshTokens, OAuth2Client(..), OAuth2Tokens(..))-import Network.Google.FusionTables (createTable, listTables, listColumns, insertRows,+import Network.Google.FusionTables (createTable, listTables, listColumns, TableId, CellType(..), TableMetadata(..)) #endif @@ -183,6 +184,10 @@ filterM (fmap isJust . (`filePredCheck` testPath) . canBuild) buildMethods when (null matches) $ do logT$ "ERROR, no build method matches path: "++testPath+ logT$ " Tried methods: "++show(map methodName buildMethods)+ logT$ " With file preds: "+ forM buildMethods $ \ meth ->+ logT$ " "++ show (canBuild meth) lift exitFailure logT$ printf "Found %d methods that can handle %s: %s" (length matches) testPath (show$ map methodName matches)@@ -207,7 +212,9 @@ -- If the benchmark has already been compiled doCompile=False can be -- used to skip straight to the execution. runOne :: (Int,Int) -> BuildID -> BuildResult -> Benchmark DefaultParamMeaning -> [(DefaultParamMeaning,ParamSetting)] -> BenchM ()-runOne (iterNum, totalIters) bldid bldres Benchmark{target=testPath, cmdargs=args_} runconfig = do +runOne (iterNum, totalIters) _bldid bldres+ Benchmark{target=testPath, cmdargs=args_, progname, benchTimeOut}+ runconfig = do let numthreads = foldl (\ acc (x,_) -> case x of Threads n -> n@@ -221,7 +228,7 @@ let runFlags = toRunFlags runconfig envVars = toEnvVars runconfig- conf@Config{..} <- ask+ conf@Config{..} <- ask --- FIXME: I hate the .. ---------------------------------------- -- (1) Gather contextual information@@ -256,13 +263,9 @@ nruns <- forM [1..trials] $ \ i -> do log$ printf " Running trial %d of %d" i trials log " ------------------------"- let (timeHarvest,ph) = harvesters- prodHarvest = case ph of- Nothing -> nullHarvester- Just h -> h- doMeasure cmddescr = do+ let doMeasure cmddescr = do SubProcess {wait,process_out,process_err} <-- lift$ measureProcess timeHarvest prodHarvest cmddescr+ lift$ measureProcess harvesters cmddescr err2 <- lift$ Strm.map (B.append " [stderr] ") process_err both <- lift$ Strm.concurrentMerge [process_out, err2] mv <- echoStream (not shortrun) both@@ -274,7 +277,13 @@ -- NOTE: For now allowing rts args to include things like "+RTS -RTS", i.e. multiple tokens: let command = binpath++" "++unwords fullargs logT$ " Executing command: " ++ command- doMeasure CommandDescr{ command=ShellCommand command, envVars, timeout=runTimeOut, workingDir=Nothing }+ let timeout = if benchTimeOut == Nothing+ then runTimeOut+ else benchTimeOut+ case timeout of+ Just t -> logT$ " Setting timeout: " ++ show t+ Nothing -> return ()+ doMeasure CommandDescr{ command=ShellCommand command, envVars, timeout, workingDir=Nothing } RunInPlace fn -> do -- logT$ " Executing in-place benchmark run." let cmd = fn fullargs envVars@@ -287,7 +296,7 @@ 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) <-+ (_t1,_t2,_t3,_p1,_p2,_p3) <- if all isError nruns then do log $ "\n >>> MIN/MEDIAN/MAX (TIME,PROD) -- got only ERRORS: " ++show nruns logOn [ResultsFile]$ @@ -321,7 +330,9 @@ let result = emptyBenchmarkResult- { _PROGNAME = testRoot+ { _PROGNAME = case progname of+ Just s -> s+ Nothing -> testRoot , _VARIANT = sched , _ARGS = args , _THREADS = numthreads@@ -330,7 +341,10 @@ , _MAXTIME = gettime maxR , _MINTIME_PRODUCTIVITY = getprod minR , _MEDIANTIME_PRODUCTIVITY = getprod medianR+ , _MEDIANTIME_ALLOCRATE = getallocrate medianR+ , _MEDIANTIME_MEMFOOTPRINT = getmemfootprint medianR , _MAXTIME_PRODUCTIVITY = getprod maxR+ , _RUNTIME_FLAGS = unwords runFlags , _ALLTIMES = unwords$ map (show . gettime) goodruns , _TRIALS = trials }@@ -346,11 +360,11 @@ -------------------------------------------------------------------------------- -- TODO: Remove this hack.-whichVariant :: String -> String-whichVariant "benchlist.txt" = "desktop"-whichVariant "benchlist_server.txt" = "server"-whichVariant "benchlist_laptop.txt" = "laptop"-whichVariant _ = "unknown"+-- whichVariant :: String -> String+-- whichVariant "benchlist.txt" = "desktop"+-- whichVariant "benchlist_server.txt" = "server"+-- whichVariant "benchlist_laptop.txt" = "laptop"+-- whichVariant _ = "unknown" -- | Write the results header out stdout and to disk. printBenchrunHeader :: BenchM ()@@ -453,15 +467,33 @@ if (ShowHelp `elem` options) then exitSuccess else exitFailure conf0 <- getConfig options []- -- The list of benchmarks can optionally be narrowed to match any of the given patterns. let conf1 = modConfig conf0- cutlist = case plainargs of+ +#ifdef FUSION_TABLES+ when (not (null errs) || FusionTest `elem` options) $ do++ let FusionConfig{fusionClientID, fusionClientSecret, fusionTableID} = fusionConfig conf1+ let (Just cid, Just sec) = (fusionClientID, fusionClientSecret)+ authclient = OAuth2Client { clientId = cid, clientSecret = sec }+ putStrLn "[hsbencher] Fusion table test mode. Getting tokens:"+ toks <- getCachedTokens authclient+ putStrLn$ "[hsbencher] Successfully got tokens: "++show toks+ putStrLn "[hsbencher] Next, attempt to list tables:"+ strs <- fmap (map tab_name) (listTables (B.pack (accessToken toks)))+ putStrLn$"[hsbencher] All of users tables:\n"++ unlines (map (" "++) strs)+ exitSuccess+#endif++ -- Next prune the list of benchmarks to those selected by the user:+ let cutlist = case plainargs of [] -> benchlist conf1- patterns -> filter (\ Benchmark{target,cmdargs} ->+ patterns -> filter (\ Benchmark{target,cmdargs,progname} -> any (\pat -> isInfixOf pat target ||- any (isInfixOf pat) cmdargs)+ isInfixOf pat (fromMaybe "" progname) ||+ any (isInfixOf pat) cmdargs+ ) patterns) (benchlist conf1) let conf2@Config{envs,benchlist,stdOut} = conf1{benchlist=cutlist}@@ -473,8 +505,16 @@ rootDir <- getCurrentDirectory runReaderT (do- unless (null plainargs) $- logT$"There were "++show(length cutlist)++" benchmarks matching patterns: "++show plainargs+ unless (null plainargs) $ do+ let len = (length cutlist)+ logT$"There were "++show len++" benchmarks matching patterns: "++show plainargs+ when (len == 0) $ do + error$ "Expected at least one pattern to match!. All benchmarks: \n"+++ (case conf1 of + Config{benchlist=ls} -> + (unlines [ (target ++ (unwords cmdargs))+ | Benchmark{cmdargs,target} <- ls+ ])) logT$"Beginning benchmarking, root directory: "++rootDir let globalBinDir = rootDir </> "bin"@@ -672,24 +712,28 @@ -- These should go in another module....... ---collapsePrefix :: String -> String -> String -> String-collapsePrefix old new str =- if isPrefixOf old str- then new ++ drop (length old) str- else str -+didComplete :: RunResult -> Bool didComplete RunCompleted{} = True didComplete _ = False +isError :: RunResult -> Bool isError ExitError{} = True isError _ = False +getprod :: RunResult -> Maybe Double getprod RunCompleted{productivity} = productivity getprod RunTimeOut{} = Nothing getprod x = error$"Cannot get productivity from: "++show x +getallocrate :: RunResult -> Maybe Word64+getallocrate RunCompleted{allocRate} = allocRate+getallocrate _ = Nothing++getmemfootprint :: RunResult -> Maybe Word64+getmemfootprint RunCompleted{memFootprint} = memFootprint+getmemfootprint _ = Nothing++gettime :: RunResult -> Double gettime RunCompleted{realtime} = realtime gettime RunTimeOut{} = posInf gettime x = error$"Cannot get realtime from: "++show x
HSBencher/Config.hs view
@@ -19,6 +19,7 @@ import qualified Data.Map as M import Data.Time.Clock (getCurrentTime, diffUTCTime) import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)+import Data.Monoid import GHC.Conc (getNumProcessors) import System.Environment (getArgs, getEnv, getEnvironment) import System.Console.GetOpt (getOpt, ArgOrder(Permute), OptDescr(Option), ArgDescr(..), usageInfo)@@ -50,7 +51,7 @@ | BinDir FilePath | NoRecomp | NoCabal | NoClean | ShortRun | KeepGoing | NumTrials String- | SkipTo String | RunID String+ | SkipTo String | RunID String | CIBuildID String | CabalPath String | GHCPath String | ShowHelp | ShowVersion #ifdef FUSION_TABLES@@ -58,6 +59,7 @@ | BenchsetName (String) | ClientID String | ClientSecret String+ | FusionTest #endif deriving (Eq,Ord,Show,Read) @@ -92,6 +94,9 @@ , Option [] ["runid"] (ReqArg RunID "NUM") "Force run ID to be a specific string; useful for completing failed runs"+ , Option [] ["buildid"] (ReqArg CIBuildID "STR")+ "Set the build ID used by the continuous integration system."+ , Option [] ["skipto"] (ReqArg (SkipTo ) "NUM") "Skip ahead to a specific point in the configuration space." @@ -116,6 +121,7 @@ , Option [] ["name"] (ReqArg BenchsetName "NAME") "Name for created/discovered fusion table." , Option [] ["clientid"] (ReqArg ClientID "ID") "Use (and cache) Google client ID" , Option [] ["clientsecret"] (ReqArg ClientSecret "STR") "Use (and cache) Google client secret"+ , Option [] ["fusion-test"] (NoArg FusionTest) "Test authentication and list tables if possible." ]) #endif @@ -132,20 +138,23 @@ lspci <- runLines "lspci" whos <- runLines "who" let newRunID = (hostname ++ "_" ++ show startTime)- let (branch,revision,depth) = gitInfo+ let (branch,revision,depth) = gitInfo return $ base { _HOSTNAME = hostname , _RUNID = case runID of Just r -> r Nothing -> newRunID+ , _CI_BUILD_ID = case ciBuildID of+ Just r -> r+ Nothing -> "" , _DATETIME = show datetime , _TRIALS = trials , _ENV_VARS = show envs , _BENCH_VERSION = show$ snd benchversion , _BENCH_FILE = fst benchversion- , _UNAME = uname --- , LSPCI = (unlines lspci) -- Blows URL size.+ , _UNAME = uname+ , _LSPCI = unlines lspci , _GIT_BRANCH = branch , _GIT_HASH = revision , _GIT_DEPTH = depth@@ -192,7 +201,7 @@ resultsOut <- Strm.unlines =<< Strm.handleToOutputStream rhnd logOut <- Strm.unlines =<< Strm.handleToOutputStream lhnd stdOut <- Strm.unlines Strm.stdout- + let -- Messy way to extract the benchlist version: -- ver = case filter (isInfixOf "ersion") (lines benchstr) of -- (h:_t) -> read $ (\ (h:_)->h) $ filter isNumber (words h)@@ -207,6 +216,7 @@ , trials = 1 , skipTo = Nothing , runID = Nothing+ , ciBuildID = Nothing , pathRegistry = M.empty -- , benchlist = parseBenchList benchstr -- , benchversion = (benchF, ver)@@ -224,12 +234,16 @@ , buildMethods = [cabalMethod, makeMethod, ghcMethod] , doFusionUpload = False , argsBeforeFlags = True- , harvesters = (selftimedHarvester, Just ghcProductivityHarvester)+ , harvesters = selftimedHarvester `mappend`+ ghcProductivityHarvester `mappend`+ ghcMemFootprintHarvester `mappend`+ ghcAllocRateHarvester #ifdef FUSION_TABLES , fusionConfig = FusionConfig { fusionTableID = Nothing , fusionClientID = lookup "HSBENCHER_GOOGLE_CLIENTID" env , fusionClientSecret = lookup "HSBENCHER_GOOGLE_CLIENTSECRET" env+ , serverColumns = [] } #endif }@@ -248,6 +262,7 @@ Just tid -> let r3 = fusionConfig r in r2 { fusionConfig= r3 { fusionTableID = Just tid } } Nothing -> r2+ doFlag FusionTest r = r #endif doFlag (CabalPath p) r = r { pathRegistry= M.insert "cabal" p (pathRegistry r) } doFlag (GHCPath p) r = r { pathRegistry= M.insert "ghc" p (pathRegistry r) }@@ -264,6 +279,7 @@ | otherwise -> error$ "--skipto must be positive: "++s [] -> error$ "--skipto given bad argument: "++s } doFlag (RunID s) r = r { runID= Just s }+ doFlag (CIBuildID s) r = r { ciBuildID= Just s } -- Ignored options: doFlag ShowHelp r = r@@ -285,8 +301,9 @@ case (fusionClientID fconf, fusionClientSecret fconf) of (Just cid, Just sec ) -> do let auth = OAuth2Client { clientId=cid, clientSecret=sec }- tid <- runReaderT (getTableId auth name) conf- return conf{ fusionConfig= fconf { fusionTableID= Just tid }}+ (tid,cols) <- runReaderT (getTableId auth name) conf+ return conf{ fusionConfig= fconf { fusionTableID= Just tid+ , serverColumns= cols }} (_,_) -> error "When --fusion-upload is activated --clientid and --clientsecret are required (or equiv ENV vars)" #else let finalconf = conf
HSBencher/Fusion.hs view
@@ -13,16 +13,20 @@ import Control.Monad.Reader import Control.Concurrent (threadDelay) import qualified Control.Exception as E-import Data.Maybe (isJust, fromJust, catMaybes)+import Data.Maybe (isJust, fromJust, catMaybes, fromMaybe)+import qualified Data.Set as S+import qualified Data.Map as M import qualified Data.ByteString.Char8 as B -- import Network.Google (retryIORequest) import Network.Google.OAuth2 (getCachedTokens, refreshTokens, OAuth2Client(..), OAuth2Tokens(..))-import Network.Google.FusionTables (createTable, listTables, listColumns, insertRows,- TableId, CellType(..), TableMetadata(..))+import Network.Google.FusionTables (createTable, createColumn, listTables, listColumns,+ bulkImportRows, insertRows,+ TableId, CellType(..), TableMetadata(..), ColumnMetadata(..)) import Network.HTTP.Conduit (HttpException) import HSBencher.Types import HSBencher.Logging (log) import Prelude hiding (log)+import System.IO (hPutStrLn, stderr) ---------------------------------------------------------------------------------------------------- @@ -74,7 +78,11 @@ -- | Get the table ID that has been cached on disk, or find the the table in the users -- Google Drive, or create a new table if needed.-getTableId :: OAuth2Client -> String -> BenchM TableId+--+-- In the case of a preexisting table, this function also performs sanity checking+-- comparing the expected schema (including column ordering) to the sserver side one.+-- It returns the permutation of columns found server side.+getTableId :: OAuth2Client -> String -> BenchM (TableId, [String]) getTableId auth tablename = do log$ " [fusiontable] Fetching access tokens, client ID/secret: "++show (clientId auth, clientSecret auth) toks <- liftIO$ getCachedTokens auth@@ -83,37 +91,64 @@ allTables <- stdRetry "listTables" auth toks $ listTables atok log$ " [fusiontable] Retrieved metadata on "++show (length allTables)++" tables" + let ourSchema = map fst fusionSchema+ ourSet = S.fromList ourSchema case filter (\ t -> tab_name t == tablename) allTables of [] -> do log$ " [fusiontable] No table with name "++show tablename ++" found, creating..." TableMetadata{tab_tableId} <- stdRetry "createTable" auth toks $ createTable atok tablename fusionSchema log$ " [fusiontable] Table created with ID "++show tab_tableId-- -- TODO: IF it exists but doesn't have all the columns, then add the necessary columns. - return tab_tableId- [t] -> do log$ " [fusiontable] Found one table with name "++show tablename ++", ID: "++show (tab_tableId t)- return (tab_tableId t)+ -- TODO: IF it exists but doesn't have all the columns, then add the necessary columns.+ return (tab_tableId, ourSchema)+ [t] -> do let tid = (tab_tableId t)+ log$ " [fusiontable] Found one table with name "++show tablename ++", ID: "++show tid+ log$ " [fusiontable] Checking columns... " + targetSchema <- fmap (map col_name) $ liftIO$ listColumns atok tid+ let targetSet = S.fromList targetSchema+ missing = S.difference ourSet targetSet+ misslist = S.toList missing + extra = S.difference targetSet ourSet+ unless (targetSchema == ourSchema) $ + log$ "WARNING: HSBencher upload schema (1) did not match server side schema (2):\n (1) "+++ show ourSchema ++"\n (2) " ++ show targetSchema+ ++ "\n HSBencher will try to make do..."+ unless (S.null missing) $ do + log$ "WARNING: These fields are missing server-side, creating them: "++show misslist+ forM_ misslist $ \ colname -> do+ ColumnMetadata{col_name, col_columnId} <- liftIO$ createColumn atok tid (colname, STRING)+ log$ " -> Created column with name,id: "++show (col_name, col_columnId)+ unless (S.null extra) $ do+ log$ "WARNING: The fusion table has extra fields that HSBencher does not know about: "+++ show (S.toList extra)+ log$ " Expect null-string entries in these fields! "+ -- For now we ASSUME that new columns are added to the end:+ -- TODO: We could do another read from the list of columns to confirm.+ return (tid, targetSchema ++ misslist) ls -> error$ " More than one table with the name '"++show tablename++"' !\n "++show ls -+-- | Push the results from a single benchmark to the server. uploadBenchResult :: BenchmarkResult -> BenchM () uploadBenchResult br@BenchmarkResult{..} = do Config{fusionConfig} <- ask- let FusionConfig{fusionClientID, fusionClientSecret, fusionTableID} = fusionConfig+ let FusionConfig{fusionClientID, fusionClientSecret, fusionTableID, serverColumns} = fusionConfig let (Just cid, Just sec) = (fusionClientID, fusionClientSecret) authclient = OAuth2Client { clientId = cid, clientSecret = sec } -- FIXME: it's EXTREMELY inefficient to authenticate on every tuple upload: toks <- liftIO$ getCachedTokens authclient- let tuple = resultToTuple br- let (cols,vals) = unzip tuple+ let ourData = M.fromList $ resultToTuple br+ -- Any field HSBencher doesn't know about just gets an empty string:+ tuple = [ (key, fromMaybe "" (M.lookup key ourData))+ | key <- serverColumns ]+ (cols,vals) = unzip tuple log$ " [fusiontable] Uploading row with "++show (length cols)++ " columns containing "++show (sum$ map length vals)++" characters of data"- -- - -- FIXME: It's easy to blow the URL size; we need the bulk import version.- stdRetry "insertRows" authclient toks $- insertRows (B.pack$ accessToken toks) (fromJust fusionTableID) cols [vals]++ -- It's easy to blow the URL size; we need the bulk import version.+ -- stdRetry "insertRows" authclient toks $ insertRows+ stdRetry "bulkImportRows" authclient toks $ bulkImportRows+ (B.pack$ accessToken toks) (fromJust fusionTableID) cols [vals] log$ " [fusiontable] Done uploading, run ID "++ (fromJust$ lookup "RUNID" tuple) ++ " date "++ (fromJust$ lookup "DATETIME" tuple) -- [[testRoot, unwords args, show numthreads, t1,t2,t3, p1,p2,p3]]@@ -130,6 +165,7 @@ , ("HOSTNAME",STRING) -- The run is identified by hostname_secondsSinceEpoch: , ("RUNID",STRING)+ , ("CI_BUILD_ID",STRING) , ("THREADS",NUMBER) , ("DATETIME",DATETIME) , ("MINTIME", NUMBER)@@ -157,6 +193,9 @@ , ("ETC_ISSUE",STRING) , ("LSPCI",STRING) , ("FULL_LOG",STRING)+ -- New fields: [2013.12.01]+ , ("MEDIANTIME_ALLOCRATE", STRING)+ , ("MEDIANTIME_MEMFOOTPRINT", STRING) ] -- | Convert the Haskell representation of a benchmark result into a tuple for Fusion@@ -168,14 +207,15 @@ , ("ARGS", unwords$ _ARGS r) , ("HOSTNAME", _HOSTNAME r) , ("RUNID", _RUNID r)+ , ("CI_BUILD_ID", _CI_BUILD_ID r) , ("THREADS", show$ _THREADS r) , ("DATETIME", _DATETIME r) , ("MINTIME", show$ _MINTIME r) , ("MEDIANTIME", show$ _MEDIANTIME r) , ("MAXTIME", show$ _MAXTIME r)- , ("MINTIME_PRODUCTIVITY", show$ _MINTIME_PRODUCTIVITY r)- , ("MEDIANTIME_PRODUCTIVITY", show$ _MEDIANTIME_PRODUCTIVITY r)- , ("MAXTIME_PRODUCTIVITY", show$ _MAXTIME_PRODUCTIVITY r)+ , ("MINTIME_PRODUCTIVITY", fromMaybe "" $ fmap show $ _MINTIME_PRODUCTIVITY r)+ , ("MEDIANTIME_PRODUCTIVITY", fromMaybe "" $ fmap show $ _MEDIANTIME_PRODUCTIVITY r)+ , ("MAXTIME_PRODUCTIVITY", fromMaybe "" $ fmap show $ _MAXTIME_PRODUCTIVITY r) , ("ALLTIMES", _ALLTIMES r) , ("TRIALS", show$ _TRIALS r) , ("COMPILER", _COMPILER r)@@ -184,15 +224,17 @@ , ("ENV_VARS", _ENV_VARS r) , ("BENCH_VERSION", _BENCH_VERSION r) , ("BENCH_FILE", _BENCH_FILE r)- , ("UNAME", take 20 (_UNAME r)) -- TEMP, FIXME+ , ("UNAME", _UNAME r) , ("PROCESSOR", _PROCESSOR r) , ("TOPOLOGY", _TOPOLOGY r) , ("GIT_BRANCH", _GIT_BRANCH r) , ("GIT_HASH", _GIT_HASH r) , ("GIT_DEPTH", show$ _GIT_DEPTH r)- , ("WHO", take 20 (_WHO r)) -- TEMP, FIXME+ , ("WHO", _WHO r) , ("ETC_ISSUE", _ETC_ISSUE r) , ("LSPCI", _LSPCI r) , ("FULL_LOG", _FULL_LOG r)+ , ("MEDIANTIME_ALLOCRATE", fromMaybe "" $ fmap show $ _MEDIANTIME_ALLOCRATE r)+ , ("MEDIANTIME_MEMFOOTPRINT", fromMaybe "" $ fmap show $ _MEDIANTIME_MEMFOOTPRINT r) ]
HSBencher/MeasureProcess.hs view
@@ -2,12 +2,13 @@ -- | This module provides tools to time a sub-process (benchmark), including a -- facility for self-reporting execution time and reporting garbage collector--- overhead.+-- overhead for GHC-compiled programs. module HSBencher.MeasureProcess (measureProcess,- selftimedHarvester, ghcProductivityHarvester,- taggedLineHarvester, nullHarvester+ selftimedHarvester,+ ghcProductivityHarvester, ghcAllocRateHarvester, ghcMemFootprintHarvester,+ taggedLineHarvester ) where @@ -17,6 +18,7 @@ import qualified Control.Exception as E import Data.Time.Clock (getCurrentTime, diffUTCTime) import Data.IORef+import Data.Monoid import System.Exit import System.Directory import System.IO (hClose, stderr)@@ -31,9 +33,10 @@ import System.Environment (getEnvironment) import HSBencher.Types+import Debug.Trace ---------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- + -- | This runs a sub-process and tries to determine how long it took (real time) and -- how much of that time was spent in the mutator vs. the garbage collector. --@@ -42,16 +45,18 @@ -- (1) An additional protocol for the process to report self-measured realtime (a -- line starting in "SELFTIMED") ----- (2) Parsing the output of "+RTS -s" to retrieve productivity OR using lines of--- the form "PRODUCTIVITY: XYZ"+-- (2) Parsing the output of GHC's "+RTS -s" to retrieve productivity OR using +-- lines of the form "PRODUCTIVITY: XYZ" -- -- Note that "+RTS -s" is specific to Haskell/GHC, but the PRODUCTIVITY tag allows -- non-haskell processes to report garbage collector overhead. -- -- This procedure is currently not threadsafe, because it changes the current working -- directory.-measureProcess :: LineHarvester -> LineHarvester -> CommandDescr -> IO SubProcess-measureProcess (LineHarvester checkTiming) (LineHarvester checkProd)+measureProcess :: LineHarvester -- ^ Stack of harvesters+ -> CommandDescr+ -> IO SubProcess+measureProcess (LineHarvester harvest) CommandDescr{command, envVars, timeout, workingDir} = do origDir <- getCurrentDirectory case workingDir of@@ -92,8 +97,9 @@ process_err <- Strm.chanToInput relay_err -- Process the input until there is no more, and then return the result.- let - loop time prod = do+ let+ loop :: RunResult -> IO RunResult+ loop resultAcc = do x <- Strm.read merged3 case x of Just ProcessClosed -> do@@ -102,13 +108,14 @@ code <- waitForProcess pid endtime <- getCurrentTime case code of- ExitSuccess -> do- tm <- case time of- -- If there's no self-reported time, we measure it ourselves:- Nothing -> let d = diffUTCTime endtime startTime in- return$ fromRational$ toRational d- Just t -> return t- return (RunCompleted {realtime=tm, productivity=prod})+ ExitSuccess -> + -- TODO: we should probably make this a Maybe type:+ if realtime resultAcc == realtime emptyRunResult+ then + -- If there's no self-reported time, we measure it ourselves:+ let d = diffUTCTime endtime startTime in+ return$ resultAcc { realtime = fromRational$ toRational d }+ else return resultAcc ExitFailure c -> return (ExitError c) Just TimerFire -> do@@ -126,16 +133,15 @@ Just (ErrLine errLine) -> do writeChan relay_err (Just errLine) -- Check for GHC-produced GC stats here:- loop time (prod `orMaybe` checkProd errLine)+ loop $ fst (harvest errLine) resultAcc Just (OutLine outLine) -> do writeChan relay_out (Just outLine) -- The SELFTIMED readout will be reported on stdout:- loop (time `orMaybe` checkTiming outLine)- (prod `orMaybe` checkProd outLine)+ loop $ fst (harvest outLine) resultAcc Nothing -> error "benchmark.hs: Internal error! This should not happen." - fut <- A.async (loop Nothing Nothing)+ fut <- A.async (loop emptyRunResult) return$ SubProcess {wait=A.wait fut, process_out, process_err} -- Dump the rest of an IOStream until we reach the end@@ -157,54 +163,82 @@ -- Hacks for looking for particular bits of text in process output: ------------------------------------------------------------------- -nullHarvester :: LineHarvester-nullHarvester = LineHarvester $ \_ -> Nothing- -- | Check for a SELFTIMED line of output. selftimedHarvester :: LineHarvester-selftimedHarvester = taggedLineHarvester "SELFTIMED"+selftimedHarvester = taggedLineHarvester "SELFTIMED" (\d r -> r{realtime=d}) -- | Check for a line of output of the form "TAG NUM" or "TAG: NUM".-taggedLineHarvester :: B.ByteString -> LineHarvester-taggedLineHarvester tag = LineHarvester $ \ ln -> +-- Take a function that puts the result into place (the write half of a lens).+taggedLineHarvester :: B.ByteString -> (Double -> RunResult -> RunResult) -> LineHarvester+taggedLineHarvester tag stickit = LineHarvester $ \ ln ->+ let fail = (id, False) in case B.words ln of- [] -> Nothing+ [] -> fail hd:tl | hd == tag || hd == (tag `B.append` ":") -> case tl of [time] -> case reads (B.unpack time) of- (dbl,_):_ -> Just dbl- _ -> error$ "Error parsing number in SELFTIMED line: "++B.unpack ln- _ -> Nothing+ (dbl,_):_ -> (stickit dbl, True)+ _ -> error$ "Error: line tagged with "++B.unpack tag++", but couldn't parse number: "++B.unpack ln+ _ -> fail +--------------------------------------------------------------------------------+-- GHC-specific Harvesters:+-- +-- All three of these are currently using the human-readable "+RTS -s" output format.+-- We should switch them to "--machine-readable -s", but that would require combining+-- information harvested from multiple lines, because GHC breaks up the statistics.+-- (Which is actually kind of weird since its specifically a machine readable format.) -- | Retrieve productivity (i.e. percent time NOT garbage collecting) as output from -- a Haskell program with "+RTS -s". Productivity is a percentage (double between -- 0.0 and 100.0, inclusive). ghcProductivityHarvester :: LineHarvester-ghcProductivityHarvester = LineHarvester $ \ ln -> - case words (B.unpack ln) of- [] -> Nothing- -- EGAD: This is NOT really meant to be machine read:- [p, time] | p == "PRODUCTIVITY" || p == "PRODUCTIVITY:" ->- case reads time of- (dbl,_):_ -> Just dbl- _ -> error$ "Error parsing number in PRODUCTIVITY line: "++B.unpack ln- ["GC","time",gc,"(",total,"elapsed)"] ->--- "GC":"time": gc :"(": total :_ ->- case (reads gc, reads total) of- ((gcD,_):_,(totalD,_):_) -> Just $ - if totalD == 0.0- then 100.0- else (100 - (gcD / totalD * 100))- _ -> error$ "checkGCTime: Error parsing number in MUT time line: "++B.unpack ln- -- TODO: Support "+RTS -t --machine-readable" as well... - -- read GC_wall_seconds - -- read mutator_wall_seconds- _ -> Nothing+ghcProductivityHarvester =+ -- This variant is our own manually produced productivity tag (like SELFTIMED): + (taggedLineHarvester "PRODUCTIVITY" (\d r -> r{productivity=Just d})) `orHarvest`+ (LineHarvester $ \ ln ->+ let nope = (id,False) in+ case words (B.unpack ln) of+ [] -> nope+ -- EGAD: This is NOT really meant to be machine read:+ ("Productivity": prod: "of": "total": "user," : _) ->+ case reads (filter (/= '%') prod) of+ ((prodN,_):_) -> (\r -> r{productivity=Just prodN}, True)+ _ -> nope+ -- TODO: Support "+RTS -t --machine-readable" as well... + _ -> nope) +ghcAllocRateHarvester :: LineHarvester+ghcAllocRateHarvester =+ (LineHarvester $ \ ln ->+ let nope = (id,False) in+ case words (B.unpack ln) of+ [] -> nope+ -- EGAD: This is NOT really meant to be machine read:+ ("Alloc":"rate": rate: "bytes":"per":_) ->+ case reads (filter (/= ',') rate) of+ ((n,_):_) -> (\r -> r{allocRate=Just n}, True)+ _ -> nope+ _ -> nope) +ghcMemFootprintHarvester :: LineHarvester+ghcMemFootprintHarvester =+ (LineHarvester $ \ ln ->+ let nope = (id,False) in+ case words (B.unpack ln) of+ [] -> nope+ -- EGAD: This is NOT really meant to be machine read:+-- " 5,372,024 bytes maximum residency (6 sample(s))",+ (sz:"bytes":"maximum":"residency":_) ->+ case reads (filter (/= ',') sz) of+ ((n,_):_) -> (\r -> r{memFootprint=Just n}, True)+ _ -> nope+ _ -> nope)++--------------------------------------------------------------------------------+ -- | Fire a single event after a time interval, then end the stream. timeOutStream :: Double -> IO (Strm.InputStream ()) timeOutStream time = do@@ -251,8 +285,9 @@ std_err = CreatePipe, cwd = Nothing, close_fds = False,- create_group = False- } + create_group = False,+ delegate_ctlc = True+ } sIn <- Strm.handleToOutputStream hin >>= Strm.atEndOfOutput (hClose hin) >>= Strm.lockingOutputStream
HSBencher/Methods.hs view
@@ -28,7 +28,17 @@ -- Some useful build methods -------------------------------------------------------------------------------- --- | Build with GNU Make.+-- | Build with GNU Make. This is a basic Make protocol; your application may need+-- something more complicated. This assumes targets clean, run, and the default+-- target for building.+--+-- The variables RUN_ARGS and COMPILE_ARGS are used to pass in the per-benchmark+-- run and compile options, so the Makefile must be written with these conventions+-- in mind. Note that this build method never knows where or if any resulting+-- binaries reside. One effect of that is that this simple build method can never+-- be used for PARALLEL compiles, because it cannot manage where the+-- build-intermediates are stored.+-- makeMethod :: BuildMethod makeMethod = BuildMethod { methodName = "make"@@ -66,7 +76,11 @@ inDirectory dir (action makePath) --- | Build with GHC directly.+-- | Build with GHC directly. This assumes that all dependencies are installed and a+-- single call to @ghc@ can build the file.+-- +-- Compile-time arguments go directly to GHC, and runtime arguments directly to the+-- resulting binary. ghcMethod :: BuildMethod ghcMethod = BuildMethod { methodName = "ghc"@@ -101,9 +115,16 @@ -- | Build with cabal.+-- Specifically, this uses "cabal install".+-- +-- This build method attempts to choose reasonable defaults for benchmarking. It+-- takes control of the output program suffix and directory (setting it to ./bin).+-- It passes compile-time arguments directly to cabal. Likewise, runtime arguments+-- get passed directly to the resulting binary. cabalMethod :: BuildMethod cabalMethod = BuildMethod { methodName = "cabal"+ -- TODO: Add methodDocs , canBuild = dotcab `PredOr` InDirectoryWithExactlyOne dotcab , concurrentBuild = True
HSBencher/Types.hs view
@@ -1,15 +1,26 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, NamedFieldPuns, CPP #-} {-# LANGUAGE DeriveGeneric, StandaloneDeriving #-} +-- | All the core types used by the rest of the HSBencher codebase.+ module HSBencher.Types ( -- * Benchmark building- RunFlags, CompileFlags, FilePredicate(..), filePredCheck,- BuildResult(..), BuildMethod(..),+ -- | The basic types for describing a single benchmark. mkBenchmark, - Benchmark(..), + Benchmark(..), + RunFlags, CompileFlags,++ -- * Build method interface and applicability+ -- | A build method is applicable to a subset of target files+ -- (`FilePredicate`) and has a particular interface that HSbencher relies+ -- upon.+ BuildMethod(..), BuildResult(..), + FilePredicate(..), filePredCheck, -- * Benchmark configuration spaces+ -- | Describe how many different ways you want to run your+ -- benchmarks. BenchSpace(..), ParamSetting(..), enumerateBenchSpace, compileOptsOnly, isCompileTime, toCompileFlags, toRunFlags, toEnvVars, toCmdPaths,@@ -23,37 +34,34 @@ #endif -- * Subprocesses and system commands- CommandDescr(..), RunResult(..), SubProcess(..), LineHarvester(..),+ CommandDescr(..), RunResult(..), emptyRunResult,+ SubProcess(..), LineHarvester(..), orHarvest, -- * Benchmark outputs for upload BenchmarkResult(..), emptyBenchmarkResult, - -- * For convenience; large records call for pretty-printing+ -- * For convenience -- large records demand pretty-printing doc ) where import Control.Monad.Reader import Data.Char+import Data.Word import Data.List+import Data.Monoid import qualified Data.Map as M import Data.Maybe (catMaybes)-import Control.Monad (filterM) import System.FilePath import System.Directory import System.Process (CmdSpec(..))-import qualified Data.Set as Set import qualified Data.ByteString.Char8 as B import qualified System.IO.Streams as Strm -import Debug.Trace- import Text.PrettyPrint.GenericPretty (Out(doc,docPrec), Generic) #ifdef FUSION_TABLES import Network.Google.FusionTables (TableId)-import Network.Google.FusionTables (createTable, listTables, listColumns, insertRows,- TableId, CellType(..), TableMetadata(..)) #endif ----------------------------------------------------------------------------------------------------@@ -61,7 +69,11 @@ ---------------------------------------------------------------------------------------------------- type EnvVars = [(String,String)]++-- | The arguments passed (in a build-method specific way) to the running benchmark. type RunFlags = [String]++-- | The arguments passed (in a build-method specific way) into the compilation process. type CompileFlags = [String] -- | Maps canonical command names, e.g. 'ghc', to absolute system paths.@@ -166,6 +178,7 @@ , trials :: Int -- ^ number of runs of each configuration , skipTo :: Maybe Int -- ^ Where to start in the config space. , runID :: Maybe String -- ^ An over-ride for the run ID.+ , ciBuildID :: Maybe String -- ^ The build ID from the continuous integration system. , shortrun :: Bool , doClean :: Bool , keepgoing :: Bool -- ^ keep going after error@@ -189,7 +202,7 @@ , argsBeforeFlags :: Bool -- ^ A global setting to control whether executables are given -- their 'flags/params' after their regular arguments. -- This is here because some executables don't use proper command line parsing.- , harvesters :: (LineHarvester, Maybe LineHarvester) -- ^ Line harvesters for SELFTIMED and productivity lines.+ , harvesters :: LineHarvester -- ^ A stack of line harvesters that gather RunResult details. , doFusionUpload :: Bool #ifdef FUSION_TABLES , fusionConfig :: FusionConfig@@ -203,7 +216,7 @@ { fusionTableID :: Maybe TableId -- ^ This must be Just whenever doFusionUpload is true. , fusionClientID :: Maybe String , fusionClientSecret :: Maybe String--- , fusionUpload :: Maybe FusionInfo+ , serverColumns :: [String] -- ^ Record the ordering of columns server side. } deriving Show #endif@@ -215,12 +228,16 @@ -- Configuration Spaces ---------------------------------------------------------------------------------------------------- --- type BenchFile = [BenchStmt]-+-- | The all-inclusive datatype for a single Benchmark. Do NOT construct values of+-- this type directly. Rather, you should make your code robust against future+-- addition of fields to this datatype. Use `mkBenchmark` followed by customizing+-- only the fields you need. data Benchmark a = Benchmark- { target :: FilePath -- ^ The target file or direcotry.+ { target :: FilePath -- ^ The target file or directory. , cmdargs :: [String] -- ^ Command line argument to feed the benchmark executable. , configs :: BenchSpace a -- ^ The configration space to iterate over.+ , progname :: Maybe String -- ^ Optional name to use INSTEAD of the basename from `target`.+ , benchTimeOut :: Maybe Double -- ^ Specific timeout for this benchmark. Overrides global setting. } deriving (Eq, Show, Ord, Generic) @@ -228,7 +245,7 @@ -- defaults to fill in the rest. Takes target, cmdargs, configs. mkBenchmark :: FilePath -> [String] -> BenchSpace a -> Benchmark a mkBenchmark target cmdargs configs = - Benchmark {target, cmdargs, configs}+ Benchmark {target, cmdargs, configs, progname=Nothing, benchTimeOut=Nothing } -- | A datatype for describing (generating) benchmark configuration spaces.@@ -273,11 +290,13 @@ isCompileTime RuntimeParam{} = False isCompileTime RuntimeEnv {} = False +-- | Extract the parameters that affect the compile-time arguments. toCompileFlags :: [(a,ParamSetting)] -> CompileFlags toCompileFlags [] = [] toCompileFlags ((_,CompileParam s1) : tl) = s1 : toCompileFlags tl toCompileFlags (_ : tl) = toCompileFlags tl +-- | Extract the parameters that affect the runtime arguments. toRunFlags :: [(a,ParamSetting)] -> RunFlags toRunFlags [] = [] toRunFlags ((_,RuntimeParam s1) : tl) = (s1) : toRunFlags tl@@ -375,11 +394,16 @@ data RunResult = RunCompleted { realtime :: Double -- ^ Benchmark time in seconds, may be different than total process time. , productivity :: Maybe Double -- ^ Seconds+ , allocRate :: Maybe Word64 -- ^ Bytes allocated per mutator-second+ , memFootprint :: Maybe Word64 -- ^ High water mark of allocated memory, in bytes. } | RunTimeOut | ExitError Int -- ^ Contains the returned error code. deriving (Eq,Show) +emptyRunResult :: RunResult+emptyRunResult = RunCompleted (-1.0) Nothing Nothing Nothing+ -- | A running subprocess. data SubProcess = SubProcess@@ -399,10 +423,28 @@ doc = docPrec 0 --- | Things like "SELFTIMED" that should be monitored.--- type Tags = [String]+-- | A line harvester takes a single line of input and possible extracts data from it+-- which it can then add to a RunResult.+-- +-- The boolean result indicates whether the line was used or not.+newtype LineHarvester = LineHarvester (B.ByteString -> (RunResult -> RunResult, Bool))+-- newtype LineHarvester = LineHarvester (B.ByteString -> Maybe (RunResult -> RunResult)) -newtype LineHarvester = LineHarvester (B.ByteString -> Maybe Double)+-- | We can stack up line harvesters. ALL of them get to run on each line.+instance Monoid LineHarvester where+ mempty = LineHarvester (\ _ -> (id,False))+ mappend (LineHarvester lh1) (LineHarvester lh2) = LineHarvester $ \ ln ->+ let (f,b1) = lh1 ln + (g,b2) = lh2 ln in+ (f . g, b1 || b2)++-- | Run the second harvester only if the first fails.+orHarvest :: LineHarvester -> LineHarvester -> LineHarvester+orHarvest (LineHarvester lh1) (LineHarvester lh2) = LineHarvester $ \ ln ->+ case lh1 ln of+ x@(_,True) -> x+ (_,False) -> lh2 ln + instance Show LineHarvester where show _ = "<LineHarvester>" @@ -420,6 +462,7 @@ , _ARGS :: [String] , _HOSTNAME :: String , _RUNID :: String+ , _CI_BUILD_ID :: String , _THREADS :: Int , _DATETIME :: String -- Datetime , _MINTIME :: Double@@ -428,7 +471,7 @@ , _MINTIME_PRODUCTIVITY :: Maybe Double , _MEDIANTIME_PRODUCTIVITY :: Maybe Double , _MAXTIME_PRODUCTIVITY :: Maybe Double- , _ALLTIMES :: String+ , _ALLTIMES :: String -- ^ Space separated list of numbers. , _TRIALS :: Int , _COMPILER :: String , _COMPILE_FLAGS :: String@@ -446,6 +489,9 @@ , _ETC_ISSUE :: String , _LSPCI :: String , _FULL_LOG :: String+ + , _MEDIANTIME_ALLOCRATE :: Maybe Word64+ , _MEDIANTIME_MEMFOOTPRINT :: Maybe Word64 } -- | A default value, useful for filling in only the fields that are relevant to a particular benchmark.@@ -456,6 +502,7 @@ , _ARGS = [] , _HOSTNAME = "" , _RUNID = ""+ , _CI_BUILD_ID = "" , _THREADS = 0 , _DATETIME = "" , _MINTIME = 0.0@@ -482,5 +529,7 @@ , _ETC_ISSUE = "" , _LSPCI = "" , _FULL_LOG = ""+ , _MEDIANTIME_ALLOCRATE = Nothing+ , _MEDIANTIME_MEMFOOTPRINT = Nothing }
HSBencher/Utils.hs view
@@ -132,12 +132,9 @@ runLogged :: String -> String -> BenchM (RunResult, [B.ByteString]) runLogged tag cmd = do log$ " * Executing command: " ++ cmd- Config{ harvesters=(timeHarv, ph) } <- ask- let prodHarv = case ph of- Nothing -> nullHarvester- Just h -> h + Config{ harvesters } <- ask SubProcess {wait,process_out,process_err} <-- lift$ measureProcess timeHarv prodHarv+ lift$ measureProcess harvesters CommandDescr{ command=ShellCommand cmd, envVars=[], timeout=Just 150, workingDir=Nothing } err2 <- lift$ Strm.map (B.append (B.pack "[stderr] ")) process_err both <- lift$ Strm.concurrentMerge [process_out, err2]
+ Test.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE TemplateHaskell #-}++import Data.List+import Data.Maybe+import HSBencher.MeasureProcess+import HSBencher.Types+import HSBencher.Config (getConfig)+import qualified Data.ByteString.Char8 as B++import Test.Framework.Providers.HUnit +import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.TH (testGroupGenerator)+import Test.HUnit (Assertion, assertEqual, assertBool, Counts(..))++--------------------------------------------------------------------------------++exampleOuptut :: [String]+exampleOuptut = + [ "SELFTIMED 3.3",+ " 14,956,751,416 bytes allocated in the heap",+ " 2,576,264 bytes copied during GC",+ " 5,372,024 bytes maximum residency (6 sample(s))",+ " 4,199,552 bytes maximum slop",+ " 14 MB total memory in use (0 MB lost due to fragmentation)",+ "",+ " Tot time (elapsed) Avg pause Max pause",+ " Gen 0 14734 colls, 14734 par 2.86s 0.15s 0.0000s 0.0006s",+ " Gen 1 6 colls, 5 par 0.00s 0.00s 0.0002s 0.0005s",+ "",+ " Parallel GC work balance: 37.15% (serial 0%, perfect 100%)",+ "",+ " TASKS: 4 (1 bound, 3 peak workers (3 total), using -N2)",+ "",+ " SPARKS: 511 (1 converted, 0 overflowed, 0 dud, 0 GC'd, 510 fizzled)",+ "",+ " INIT time 0.00s ( 0.00s elapsed)",+ " MUT time 8.06s ( 5.38s elapsed)",+ " GC time 2.86s ( 0.15s elapsed)",+ " EXIT time 0.00s ( 0.00s elapsed)",+ " Total time 10.92s ( 5.53s elapsed)",+ "",+ " Alloc rate 1,855,954,977 bytes per MUT second",+ "",+ " Productivity 73.8% of total user, 145.7% of total elapsed",+ "",+ "gc_alloc_block_sync: 10652",+ "whitehole_spin: 0",+ "gen[0].sync: 8",+ "gen[1].sync: 1700" ]++-- case_prod = assertEqual "Harvest prod" [73.8] $+-- catMaybes $ map (fn . B.pack) exampleOuptut++case_harvest :: IO ()+case_harvest = do+ config <- getConfig [] []+ let LineHarvester fn = harvesters config+-- mapM_ print $ map (\x -> (x, fn (B.pack x))) exampleOuptut+ let hits = filter ((==True) . snd) $ map (fn . B.pack) exampleOuptut+ putStrLn$ "Lines harvested: "++show (length hits)+ let result = foldl' (\ r (f,_) -> f r) emptyRunResult hits+ let expected = RunCompleted {realtime = 3.3, productivity = Just 73.8,+ allocRate = Just 1855954977, memFootprint = Just 5372024}++ assertEqual "Test harvesters" expected result++tests :: Test+tests = $(testGroupGenerator)++main :: IO ()+main = defaultMain [tests]
example/cabal/benchmark.hs view
@@ -19,7 +19,7 @@ defaultMainWithBechmarks benches benches =- [ Benchmark "bench1/" ["unused_cmdline_arg"] withthreads+ [ mkBenchmark "bench1/" ["unused_cmdline_arg"] withthreads ] withthreads = defaultHSSettings$
example/make_and_ghc/benchmark.hs view
@@ -19,8 +19,8 @@ defaultMainWithBechmarks benches benches =- [ Benchmark "bench1/" ["unused_cmdline_arg"] envExample--- , Benchmark "bench2/Hello.hs" [] withthreads + [ mkBenchmark "bench1/" ["unused_cmdline_arg"] envExample+-- , mkBenchmark "bench2/Hello.hs" [] withthreads ] -- No benchmark configuration space.
hsbencher.cabal view
@@ -1,6 +1,6 @@ name: hsbencher-version: 1.3.9+version: 1.5.1 -- CHANGELOG: -- 1.0 : Initial release, new flexible benchmark format. -- 1.1 : Change interface to RunInPlace@@ -15,6 +15,15 @@ -- 1.3.8 : Added --skipto and --runid -- 1.3.8 : Remove hydra-print dep by default. Add 'hydra' flag. +-- 1.4 : Richer Benchmark{} record type.+-- 1.4.1 : add CI_BUILD_ID column+-- 1.4.1.2 : add benchTimeOut field+-- 1.4.1.3 : actually upload run flags, nix uname+-- 1.4.1.5 : search for patterns in 'progname' as well+-- 1.4.3 : switch to bulkImportRows for Fusion tables+-- 1.5 : add new columns, formatting tweaks, robustness to schema evolution+-- 1.5.1 : adapt to upstream change in process-1.2+ synopsis: Flexible benchmark runner for Haskell and non-Haskell benchmarks. description: Benchmark frameworks are usually very specific to the@@ -68,6 +77,8 @@ * (1.3.8) Added @--skipto@ and @--runid@ arguments . * (1.3.4) Added ability to prune benchmarks with patterns on command line.+ .+ * (1.4.2) Breaking changes, don't use Benchmark constructor directly. Use mkBenchmark. license: BSD3@@ -117,7 +128,8 @@ build-depends: -- base ==4.6.*, bytestring ==0.10.*, process ==1.1.*, directory ==1.2.*, filepath ==1.3.*, random ==1.0.*, -- unix ==2.6.*, containers ==0.5.*, time ==1.4.*, mtl ==2.1.*, async >= 2.0,- base >= 4.5 && <= 4.7, bytestring, process, directory, filepath, random, unix, containers, time, mtl, async, + base >= 4.5 && <= 4.7, bytestring, process >= 1.2, + directory, filepath, random, unix, containers, time, mtl, async, io-streams >= 1.1, GenericPretty >= 1.2, http-conduit @@ -129,7 +141,7 @@ default-language: Haskell2010 if flag(fusion) {- build-depends: handa-gdata >= 0.6.2+ build-depends: handa-gdata >= 0.6.9 exposed-modules: HSBencher.Fusion cpp-options: -DFUSION_TABLES }@@ -155,8 +167,8 @@ -- default-language: Haskell2010 -Test-suite test1- main-is: example/cabal/benchmark.hs+Test-suite hsbencher-unit-tests+ main-is: Test.hs type: exitcode-stdio-1.0 build-depends: -- <DUPLICATED from above>@@ -164,19 +176,40 @@ io-streams >= 1.0, GenericPretty >= 1.2, http-conduit, hsbencher -- </DUPLICATED>+ -- Additional deps for testing:+ build-depends: test-framework, test-framework-hunit, test-framework-th, + HUnit, time, text+ ghc-options: -threaded default-language: Haskell2010- if flag(hydra) { build-depends: hydra-print >= 0.1.0.3 }+ if flag(fusion) {+ build-depends: handa-gdata >= 0.6.9+ cpp-options: -DFUSION_TABLES+ } +Test-suite hsbencher-test1+ main-is: example/cabal/benchmark.hs+ type: exitcode-stdio-1.0+ build-depends:+ -- <DUPLICATED from above>+ base >= 4.5 && <= 4.7, bytestring, process, directory, filepath, random, unix, containers, time, mtl, async, + io-streams >= 1.0,+ GenericPretty >= 1.2, http-conduit, hsbencher+ -- </DUPLICATED>+ ghc-options: -threaded + default-language: Haskell2010+ if flag(hydra) {+ build-depends: hydra-print >= 0.1.0.3+ } if flag(fusion) {- build-depends: handa-gdata >= 0.6.2+ build-depends: handa-gdata >= 0.6.9 cpp-options: -DFUSION_TABLES } -Test-suite test2+Test-suite hsbencher-test2 main-is: example/make_and_ghc/benchmark.hs type: exitcode-stdio-1.0 build-depends:@@ -187,12 +220,10 @@ -- </DUPLICATED> ghc-options: -threaded default-language: Haskell2010- if flag(hydra) { build-depends: hydra-print >= 0.1.0.3 }- if flag(fusion) {- build-depends: handa-gdata >= 0.6.2+ build-depends: handa-gdata >= 0.6.9 cpp-options: -DFUSION_TABLES }