Commit 91d05cca authored by Andreas Klebinger's avatar Andreas Klebinger

Refactor subdir detection logic

parent efe1c567
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main(main) where
......@@ -22,6 +23,7 @@ import Options.Applicative
-- Shake - build system
import Development.Shake
import Development.Shake.FilePath hiding (exe)
import Development.Shake.Util as SU
import RunnerTypes
import qualified Measurements as Ms
......@@ -29,6 +31,7 @@ import Measurements (Measurements, Label(..))
import qualified ParseResults
import qualified CachegrindParse
import qualified PerfStatParse
-- import Utils
-- import Debug.Trace
-- | A handy shortcut.
......@@ -69,36 +72,41 @@ defaultRoots = words "imaginary spectral real shootout"
-- , TestName "real/eff"
-- ]
-- | Directories containing tests that the system can run.
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
benchDirs <- if null user_roots
then concat <$> mapM getSubDirs testRoots
else concat <$> mapM getSubDirs (map unTestName user_roots)
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"))
return $ map TestName benchDirs
-- Looking at a folder, determine paths to actual benchmarks.
--
-- We do so by parsing the makefile. If there is no Makefile there are no benchmarks.
-- If there is a SUBDIRS entry it gives the subfolders containing benchmarks
-- directly or indirectly via another Makefile with a SUBDIRS entry.
-- If there is a Makefile but no SUBDIRS entry then the path itself must be
-- a benchmark.
-- This only applies to benchmark folders. (real, shootout/binary-trees, ..)
getSubDirs :: FilePath -> IO [FilePath]
getSubDirs root = do
hasMakefile <- IO.doesFileExist $ root </> "Makefile"
if not hasMakefile then return [] else do
config <- readConfig $ root </> "Makefile"
let subdir_paths = words $ config "SUBDIRS"
if null subdir_paths
then return [root]
else concat <$> mapM (\s -> getSubDirs (root </> s)) subdir_paths
-- 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"))
---------------------------------------------------------------------
......@@ -265,8 +273,6 @@ buildRules nofib@Build{..} = do
-- Compile object code
["//*.o","//*.hi","//*.o.compile.tsv"] &%> \[o, _hi, resultsTsv] -> do
-- deps <- readFile' $ replaceExtension out "deps"
-- IO\.listDirectory root
liftIO $ print o
let test = unoutput o
dir = testDir test
......@@ -283,6 +289,7 @@ buildRules nofib@Build{..} = do
return $ dir </> modName <.> (if b then "hs" else "lhs")
-- Figure out build dependencies
need $ [obj </> ".depends"]
deps <- readFileLines $ obj </> ".depends"
liftIO $ print "deps:"
liftIO $ print deps
......@@ -517,7 +524,7 @@ convertConfig xs =
, let (a,b) = separate x
, a `elem` keep
]
keep = words "PROG_ARGS SRC_HC_OPTS SLOW_OPTS NORM_OPTS FAST_OPTS STDIN_FILE SRC_DEPS"
keep = words "PROG_ARGS SRC_HC_OPTS SLOW_OPTS NORM_OPTS FAST_OPTS STDIN_FILE SRC_DEPS SUBDIRS"
separate x = (name,rest)
where (name,x2) = span (\c -> isAlpha c || c == '_') x
......@@ -527,13 +534,23 @@ convertConfig xs =
-- | Read a configuration file (new format) into a function supplying options.
readConfig :: FilePath -> IO (String -> String)
readConfig x = do
src <- readFile x
src <- fuseLines <$> readFile x
let res = [ (reverse $ dropWhile isSpace $ reverse a, dropWhile isSpace $ drop 1 b)
| y <- lines src
, let (a,b) = break (== '=') y
]
return $ \k -> fromMaybe "" $ lookup k res
-- Eliminate line breaks preceded by \ which allows multiline statements in make files
fuseLines :: String -> String
fuseLines [] = []
fuseLines [x] = [x]
fuseLines ('\\':'\n':xs) =
fuseLines xs
fuseLines ('\\':'\r':'\n':xs) =
fuseLines xs
fuseLines (x:xs) =
x : fuseLines xs
-- | readConfig lifted into the Action monad.
readConfig' :: FilePath -> Action (String -> 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