Commit e5930f81 authored by Andreas Klebinger's avatar Andreas Klebinger

Sanitize compiler path. Move runner into own folder.

parent 506d16bd
......@@ -30,6 +30,7 @@ library
executable nofib-run
main-is: Main.hs
ghc-options: -Wall
hs-source-dirs: runner
other-modules: CachegrindParse, PerfStatParse, ParseResults, RunnerTypes
other-extensions: RecordWildCards, DeriveDataTypeable
build-depends: base >=4.10 && <4.14,
......
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module CachegrindParse where
import Data.Maybe
import qualified Data.Map as M
newtype EventName = EventName { getEventName :: String }
deriving (Show, Eq, Ord)
parse :: FilePath -> IO (M.Map EventName Integer)
parse fname = parse' <$> readFile fname
parse' :: String -> M.Map EventName Integer
parse' content =
M.fromList $ zip summary events
where
events = case mapMaybe isEventList $ lines content of
[] -> error "No event list found"
[x] -> x
_ -> error "More than one event list found"
summary = case mapMaybe isSummaryList $ lines content of
[] -> error "No event summary found"
[x] -> x
_ -> error "More than one event summary found"
isEventList :: String -> Maybe [Integer]
isEventList line
| "summary:" : rest <- words line = Just $ map read rest
| otherwise = Nothing
isSummaryList :: String -> Maybe [EventName]
isSummaryList line
| "events:" : rest <- words line = Just $ map EventName rest
| otherwise = Nothing
......@@ -104,15 +104,14 @@ getTestDirs user_roots = do
-- | Main program, just interpret the arguments and dispatch the tasks.
main :: IO ()
main = do
-- Sanitize arguments
args <- nofibArgs
case args of
Build{..} -> do
when clean $
removeDirectoryRecursive output
-- Turns "ghc" into /usr/bin/../ghc
compiler_path <- fromMaybe (error "Couldn't find GHC at" ++ compiler) <$> IO.findExecutable compiler
tests' <- getTestDirs tests
putStrLn $ "Running: " ++ unwords (map unTestName tests')
......@@ -124,7 +123,7 @@ main = do
, shakeVerbosity = Development.Shake.Loud
}
shake shakeOpts $ buildRules (args {tests = tests', compiler = compiler_path})
shake shakeOpts $ buildRules (args {tests = tests'})
putStrLn "Build completed"
......@@ -344,7 +343,7 @@ buildRules nofib@Build{..} = do
["//Main.run.results.tsv"] &%> \[resultsTsv] -> do
need [takeDirectory resultsTsv </> "config.txt"]
need [replaceExtensions resultsTsv exe]
let test = unoutput resultsTsv
let test = unoutput resultsTsv :: TestName
(stdin, args) <- liftIO $ getTestCmdline nofib test
executable <- liftIO $ IO.canonicalizePath $ output </> testDir test </> "Main" <.> exe
let rtsStatsOut = executable <.> "stats"
......@@ -376,7 +375,6 @@ buildRules nofib@Build{..} = do
]
<> Ms.prefix (testLabel test <> ml "run" <> ml "rts stats") rtsStats
getTestConfig :: Nofib -> TestName -> Action (String -> String)
getTestConfig Build{..} test =
readConfig' $ output </> testDir test </> "config.txt"
......
......@@ -6,7 +6,9 @@ module RunnerTypes where
-- Standard libraries
import Data.Char
import Data.Maybe
import System.Process
import qualified System.Directory as IO
import Data.String (IsString)
import Options.Applicative
......@@ -97,9 +99,11 @@ nofibArgs = do
print args
case args of
build@Build{..} -> do
-- Turns "ghc" into /usr/bin/../ghc
compiler' <- fromMaybe (error "Couldn't find GHC at" ++ compiler) <$> IO.findExecutable compiler
compilerVer <- compilerVersion compiler
output' <- return $ "_make" </> (if null output then compilerVer else output)
return build{ output = output' }
return build{ output = output', compiler = compiler' }
-- | Find the default compiler string, e.g. ghc-7.4.1
compilerVersion :: FilePath -> IO String
......
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