Commit c3d3e812 authored by Ben Gamari's avatar Ben Gamari 🐢

Record RTS statistics during cachegrind run

parent 286e6c56
......@@ -81,7 +81,7 @@ data Nofib
,cachegrind_args :: String
,run :: Bool
,speed :: Speed
,rts :: [String]
,rts_args :: [String]
,times :: Int
,skip_check :: Bool
}
......@@ -109,7 +109,7 @@ nofibMode = cmdArgsMode $ modes
,run = False &= groupname "Running" &= help "Run the tests"
,speed = Norm &= groupname "Running" &= help "Test speed (Fast,Norm,Slow)"
,times = 1 &= help "Number of times to run each test"
,rts = [] &= help "Which RTS options to pass when running"
,rts_args = [] &= help "Which RTS options to pass when running"
,skip_check = False &= help "Skip checking the results of the tests"
} &= auto &= help "Build"
&= help "Build and run"
......@@ -320,18 +320,22 @@ buildRules nofib@Build{..} = do
need [takeDirectory out </> "config.txt"]
need [replaceExtensions out exe]
let test = unoutput out
rtsStatsOut = out <.> "stats"
(stdin, args) <- liftIO $ getTestCmdline nofib test
executable <- liftIO $ IO.canonicalizePath $ output </> test </> "Main" <.> exe
out' <- liftIO $ IO.canonicalizePath out
cmd_ (Cwd test) (EchoStdout False) (StdinBS stdin)
"valgrind" "--tool=cachegrind" cachegrind_args ("--cachegrind-out-file="++out') executable args
"valgrind" "--tool=cachegrind" cachegrind_args ("--cachegrind-out-file="++out')
executable args "+RTS" rts_args "--machine-readable" ("-t"++rtsStatsOut)
stats <- liftIO $ CachegrindParse.parse out'
rtsStats <- liftIO $ readRtsStats rtsStatsOut
liftIO $ MTree.writeFile resultsJson
$ MTree.fromList
$ [ (MTree.mkLabel test <> ml "run" <> ml "cachegrind" <> lbl, realToFrac v)
[ (MTree.mkLabel test <> ml "run" <> ml "cachegrind" <> lbl, realToFrac v)
| (eventName, v) <- M.toList stats
, let lbl = MTree.mkLabel $ CachegrindParse.getEventName eventName
]
<> MTree.prefix (MTree.mkLabel test <> ml "run" <> ml "rts stats") rtsStats
where
objectsForExecutable :: FilePath -> Action [FilePath]
......@@ -371,7 +375,7 @@ runTest nofib@Build{..} test = do
fmap and $ replicateM times $ do
start <- getCurrentTime
(code,stdout,stderr) <- readProcessWithExitCodeAndWorkingDirectory
test executable (args++"+RTS":rts++["--machine-readable", "-t"++stats]) stdin
test executable (args++"+RTS":rts_args++["--machine-readable", "-t"++stats]) stdin
end <- getCurrentTime
stdoutWant <- grab "stdout"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment