Commit 738908dc authored by Andreas Klebinger's avatar Andreas Klebinger

Support boot.sh scripts to generate inputs/outputs

parent 0558a731
......@@ -20,6 +20,7 @@ import qualified System.FilePath as FP
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import System.Info hiding (compilerVersion)
import System.Exit
import Options.Applicative
-- Shake - build system
......@@ -187,6 +188,7 @@ main = do
buildRules :: Nofib -> Rules ()
buildRules nofib@Build{..} = do
linkerResource <- newResource "ghc linker" 5
pkgDbResource <- newResource "package db" 1
-- _make/foo/bar -> bar
let asSrcPath :: String -> String
......@@ -266,9 +268,10 @@ buildRules nofib@Build{..} = do
return $ pkgdb_path
buildDepsArgs _test = do
pkgdb <- buildDepsPkgDb
db_exists <- liftIO $ IO.doesPathExist pkgdb
unless (db_exists) $ do
cmd_ ghcPkg "init" pkgdb
withResource pkgDbResource 1 $ do
db_exists <- liftIO $ IO.doesPathExist pkgdb
unless (db_exists) $ do
cmd_ ghcPkg "init" pkgdb
return [ "-package-db", pkgdb, "-no-user-package-db" ]
-- Build all package dependencies. Write .stamp file to indicate
......@@ -279,8 +282,8 @@ buildRules nofib@Build{..} = do
let deps = nub $ foldMap (\config -> words $ config "SRC_DEPS") configs
-- TODO: Invoking cabal in the way we do without any package argument fails.
root <- liftIO $ IO.makeAbsolute buildDepsRoot
unless (null deps)
$ cmd_ "cabal" ("--store-dir=" <> root) "v2-install" "--lib" "-w" compiler "--allow-newer" deps ("-j"<> show threads)
unless (null deps) $ withResource pkgDbResource 1 $
cmd_ "cabal" ("--store-dir=" <> root) "v2-install" "--lib" "-w" compiler "--allow-newer" deps ("-j"<> show threads)
liftIO $ writeFile out ""
-- Benchmark rules
......@@ -528,6 +531,16 @@ runTest nofib@Build{..} runMode resultsTsv = do
need [takeDirectory resultsTsv </> "config.txt", replaceExtensions resultsTsv exe]
let test = testFromResultTsv nofib resultsTsv :: TestName
src_dir = testDir test
obj_dir = output </> src_dir
has_boot_script <- doesFileExist (src_dir </> "boot.sh")
abs_src_dir <- liftIO $ IO.makeAbsolute src_dir
when has_boot_script $ do
abs_obj_dir <- liftIO $ IO.makeAbsolute obj_dir
c <- cmd (Cwd abs_src_dir) "bash" "boot.sh" abs_src_dir abs_obj_dir compiler (map toLower $ show speed)
unless (fromExit c == ExitSuccess) $ do
fail $ "Boot script failed for:" ++ src_dir
-- Construct benchmark invocation
(stdin, args) <- getTestCmdline nofib test
......@@ -585,7 +598,7 @@ getModeArgs benchSettings speed = words $
getTestCmdline :: Nofib -> TestName -> Action (BSL.ByteString, [String])
getTestCmdline Build{..} test = do
config <- readConfig' $ output </> unTestName test </> "config.txt"
config <- readConfig' $ output </> src_dir </> "config.txt"
-- Mode/Speed args default to normal mode.
let speed_args = getModeArgs config speed
......@@ -603,10 +616,17 @@ getTestCmdline Build{..} test = do
stdin <- liftIO $maybe (pure BSL.empty) BSL.readFile stdin_path
return (stdin, args)
where
src_dir = testDir test
-- Grab stdin/out
grab :: String -> IO (Maybe FilePath)
grab ext = do
let s = [testDir test </> takeFileName (unTestName test) <.> map toLower (show speed) ++ ext
,testDir test </> takeFileName (unTestName test) <.> ext]
-- Constant stdin/out files in src directory
let s = [src_dir </> takeFileName (unTestName test) <.> map toLower (show speed) ++ ext
,src_dir </> takeFileName (unTestName test) <.> ext
-- Generated stdin/out files from output directory
,output </> src_dir </> takeFileName (unTestName test) <.> map toLower (show speed) ++ ext
,output </> src_dir </> takeFileName (unTestName test) <.> ext
]
ss <- filterM IO.doesFileExist s
return $ listToMaybe ss
......@@ -660,10 +680,10 @@ fuseLines [] = []
fuseLines [x] = [x]
fuseLines ('\\':'\n':xs) =
fuseLines xs
fuseLines ('\\':'\r':xs) =
fuseLines xs
fuseLines ('\\':'\r':'\n':xs) =
fuseLines xs
fuseLines ('\\':'\r':xs) =
fuseLines xs
fuseLines (x:xs) =
x : fuseLines xs
......
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