Commit 216a7062 authored by Andreas Klebinger's avatar Andreas Klebinger

Two small fixes.

* Use user passed tests as prefix to match against.
* Pass compiler args when linking/dependency generation.
parent c787146a
......@@ -42,55 +42,69 @@ testRoots :: [String]
testRoots = words "imaginary spectral real parallel spectral/hartel gc"
-- | These are tests that are under testRoots, but should be skipped (all are skipped by the Makefile system)
disabledTests :: [TestName]
disabledTests =
[ TestName "spectral/hartel"
, TestName "spectral/last-piece"
, TestName "spectral/secretary"
, TestName "spectral/minimax"
, TestName "parallel/cfd"
, TestName "parallel/dcbm"
, TestName "parallel/linsolv"
, TestName "parallel/warshall"
]
-- | These tests are compiled by the Makefile system, but don't work for me (mostly GHC 7.4 breaks)
newlyDisabledTests :: [TestName]
newlyDisabledTests =
[ TestName "power"
, TestName "lift"
, TestName "fulsom"
, TestName "fluid"
, TestName "real/eff"
]
-- -- | These are tests that are under testRoots, but should be skipped (all are skipped by the Makefile system)
-- disabledTests :: [TestName]
-- disabledTests =
-- [ TestName "spectral/hartel"
-- , TestName "spectral/last-piece"
-- , TestName "spectral/secretary"
-- , TestName "spectral/minimax"
-- , TestName "parallel/cfd"
-- , TestName "parallel/dcbm"
-- , TestName "parallel/linsolv"
-- , TestName "parallel/warshall"
-- ]
-- -- | These tests are compiled by the Makefile system, but don't work for me (mostly GHC 7.4 breaks)
-- newlyDisabledTests :: [TestName]
-- newlyDisabledTests =
-- [ TestName "power"
-- , TestName "lift"
-- , TestName "fulsom"
-- , TestName "fluid"
-- , TestName "real/eff"
-- ]
-- | Directories containing tests that the system can run.
allTests :: IO [TestName]
allTests = do
xs <- forM testRoots $ \x -> do
ys <- IO.getDirectoryContents x
return [ t
| y <- ys
, '.' `notElem` y
, let t = TestName (x </> y)
, t `notElem` disabledTests
, t `notElem` newlyDisabledTests
]
fmap sort $ flip filterM (concat xs) $ \t -> do
let dir :: FilePath
dir = unTestName t
b <- IO.doesDirectoryExist dir
if not b then return False else
IO.doesFileExist $ dir </> "Makefile"
getTestDirs :: [TestName] -> IO [TestName]
getTestDirs user_roots = do
benchDirs <- concat <$> mapM getSubDirs testRoots
return $ map TestName $
if (null user_roots)
then benchDirs
else
let match test = any (`isPrefixOf` test) (map unTestName user_roots)
in filter match benchDirs
where
-- If we have foo/Makefile we consider it a potential benchmark
-- *unless* we also have foo/bar/Makefile in which case we only
-- have the benchmark bar.
--
-- We should probably switch to having and explicit list of benchmarks
-- either in the shake-nofib program or in some file that we parese instead
-- as this is quite hacky.
getSubDirs :: FilePath -> IO [FilePath]
getSubDirs root = do
contents <- IO.listDirectory root
subDirs <- filterM hasMakeFile (map (root </>) contents)
return $ if null subDirs
then [root]
else subDirs
hasMakeFile dir = do
(IO.doesDirectoryExist dir) <|> (IO.doesFileExist (dir </> "Makefile"))
---------------------------------------------------------------------
-- ARGUMENT PARSING - mostly based on CmdArgs
-- | Testnames are either
-- * A single tests name component (eg "rfib")
-- * A subpath eg. "real/eff"
-- * A fully qualified path e.g. "spectral/simple"
newtype TestName = TestName { unTestName :: String }
deriving (Show, Eq, Ord, IsString)
......@@ -146,11 +160,12 @@ nofibMode =
nofibArgs :: IO Nofib
nofibArgs = do
args <- execParser $ info (helper <*> nofibMode) (progDesc "nofib Benchmark Suite")
print args
case args of
Build{..} -> do
build@Build{..} -> do
compilerVer <- compilerVersion compiler
output <- return $ "_make" </> (if null output then compilerVer else output)
return Build{..}
output' <- return $ "_make" </> (if null output then compilerVer else output)
return build{ output = output' }
-- | Find the default compiler string, e.g. ghc-7.4.1
compilerVersion :: FilePath -> IO String
......@@ -172,7 +187,8 @@ main = do
when clean $
removeDirectoryRecursive output
putStrLn $ "Running: " ++ unwords (map unTestName tests)
tests' <- getTestDirs tests
putStrLn $ "Running: " ++ unwords (map unTestName tests')
let shakeOpts = shakeOptions
{ shakeThreads = threads
......@@ -182,8 +198,7 @@ main = do
, shakeVerbosity = Development.Shake.Loud
}
tests <- allTests
shake shakeOpts $ buildRules (args {tests = tests})
shake shakeOpts $ buildRules (args {tests = tests'})
putStrLn "Build completed"
......@@ -266,8 +281,9 @@ buildRules nofib@Build{..} = do
buildDepsStamp %> \out -> do
configs <- mapM (liftIO . getTestConfig nofib) tests
let deps = 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
cmd_ "cabal" ("--store-dir=" <> root) "v2-install" "--lib" "-w" compiler "--allow-newer" deps
cmd_ "cabal" ("--store-dir=" <> root) "v2-install" "--lib" "-w" compiler "--allow-newer" ("hashmap":deps)
liftIO $ writeFile out ""
-- Benchmark rules
......@@ -298,7 +314,8 @@ buildRules nofib@Build{..} = do
compileArgs <- liftIO $ getTestCompileArgs nofib test
deps_args <- buildDepsArgs test
() <- withResource linkerResource 1 $
cmd compiler $ ["-Rghc-timing","-rtsopts","-o", out] ++ objs ++ compileArgs ++ deps_args
-- We pass the compiler_args as well, as we don't distinguish between link and compile time arguments
cmd compiler $ ["-Rghc-timing","-rtsopts","-o", out] ++ objs ++ compileArgs ++ compiler_args ++ deps_args
-- Report executable size
Stdout out_err <- cmd "size" [out]
......@@ -315,6 +332,8 @@ buildRules nofib@Build{..} = do
obj = output </> dir
config <- readConfig' $ obj </> "config.txt"
liftIO $ print "FooBar"
-- Figure out source location
let modName =
let x = dropExtension $ drop (length obj + 1) o
......@@ -358,7 +377,10 @@ buildRules nofib@Build{..} = do
, "-i" ++ testDir test
, "-dep-makefile=" ++ out
, "-dep-suffix", ""
] ++ compileArgs ++ deps_args
] ++ compileArgs ++
-- It's unlikely but possible that flags could affect dependencies.
compiler_args ++
deps_args
src <- liftIO $ readFile out
need [x | x <- words src, takeExtension x `elem` [".hs",".lhs",".h"]]
......@@ -408,7 +430,7 @@ buildRules nofib@Build{..} = do
let rtsStatsOut = executable <.> "stats"
out' <- liftIO $ IO.canonicalizePath out
cmd_ (Cwd $ testDir test) (EchoStdout False) (StdinBS stdin)
"valgrind" "--tool=cachegrind" cachegrind_args ("--cachegrind-out-file="++out')
"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
......
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