Commit b0a06d47 authored by Andreas Klebinger's avatar Andreas Klebinger

shake: Compare stderr, some cleanup of commented code

parent 50c64343
......@@ -77,30 +77,6 @@ For there it's fairly straight forward.
-}
-- -- | 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.
getTestDirs :: [TestName] -> IO [TestName]
getTestDirs user_roots = do
......@@ -113,7 +89,7 @@ getTestDirs user_roots = do
-- 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
-- If there is a SUBDIRS entry in the Makefile 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.
......@@ -128,16 +104,6 @@ getSubDirs root = do
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"))
---------------------------------------------------------------------
-- MAIN DRIVER
......@@ -160,7 +126,7 @@ main = do
{ shakeThreads = threads
, shakeFiles = output ++ "/"
, shakeReport = [output ++ "/shake_report.html"]
, shakeStaunch = True
, shakeStaunch = False
, shakeVerbosity = Development.Shake.Loud
}
......@@ -530,16 +496,16 @@ runTest nofib@Build{..} runMode resultsTsv = do
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_src_dir <- liftIO $ IO.makeAbsolute src_dir
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
Exit c <- cmd (Cwd abs_src_dir) "bash" "boot.sh" abs_src_dir abs_obj_dir compiler (map toLower $ show speed)
unless (c == ExitSuccess) $ do
fail $ "Boot script failed for:" ++ src_dir
-- Construct benchmark invocation
(stdin, args, stdout) <- getTestCmdline nofib test
(stdin, args, stdout, stderr) <- getTestCmdline nofib test
executable <- liftIO $ IO.canonicalizePath $ output </> src_dir </> "Main" <.> exe
-- Create stats.0, stats.1, etc.
......@@ -552,24 +518,51 @@ runTest nofib@Build{..} runMode resultsTsv = do
executable args "+RTS" rts_args "--machine-readable" ("-t"++rtsStatsOut)
unless (c == ExitSuccess) $ do
fail $ "Benchmark failed:" ++ src_dir ++ " exit code:" ++ show c
unless (BSL.null err) $ do
fail $ "Benchmark failed:" ++ src_dir ++ " unexpected stderr:" ++ show err
-- We simply drop '\r' from both expected and actual output when comparing
-- them. This avoids windows line ending issues.
-- Given that checking the output is merely a sanity check
-- that seems reasonable.
when (isJust stdout &&
(BSL.filter (/= '\r') out) /= (BSL.filter (/= '\r') (fromJust stdout))) $ do
liftIO $ do
BSL.writeFile (output </> src_dir </> ".actual" ) out
BSL.writeFile (output </> src_dir </> ".expected" ) $ fromJust stdout
putStrLn "Start of actual output:"
BSL.putStrLn $ BSL.take 800 out
putStrLn "Start of expected output:"
BSL.putStrLn $ BSL.take 800 (fromJust stdout)
fail $ "Benchmark failed:" ++ src_dir ++ " unexpected stdout:^"
return ()
let isNewlineChar x = x == '\r' || x == '\n'
case stdout of
-- There is an stdout file, compare actual and expected stdout.
Just stdout'
| (BSL.filter (not . isNewlineChar) out) /= (BSL.filter (not . isNewlineChar) (fromJust stdout)) -> do
liftIO $ do
let actual_path = output </> src_dir </> "stdout.actual"
let expected_path = output </> src_dir </> "stdout.expected"
BSL.writeFile actual_path out
BSL.writeFile expected_path $ fromJust stdout
putStrLn "Start of actual output:"
BSL.putStrLn $ BSL.take 800 out
putStrLn "Start of expected output:"
BSL.putStrLn $ BSL.take 800 (fromJust stdout)
putStrLn $ "Full expected/actual output written to " ++ (output </> src_dir)
fail $ "Benchmark failed:" ++ src_dir ++ " unexpected stdout:^"
-- No stdout file, ignore stdout
_ -> return ()
case stderr of
-- Compare stderr file and actual stderr
Just stderr'
| (BSL.filter (not . isNewlineChar) err) /= (BSL.filter (not . isNewlineChar) stderr') -> do
liftIO $ do
let actual_path = output </> src_dir </> "stderr.actual"
let expected_path = output </> src_dir </> "stderr.expected"
BSL.writeFile actual_path err
BSL.writeFile expected_path $ fromJust stderr
putStrLn "Start of actual error output:"
BSL.putStrLn $ BSL.take 800 err
putStrLn "Start of expected error output:"
BSL.putStrLn $ BSL.take 800 stderr'
putStrLn $ "Full expected/actual error output written to " ++ (output </> src_dir)
fail $ "Benchmark failed:" ++ src_dir ++ " unexpected stderr:see above"
-- No stderr file, any error output is considered a failure
Nothing
| (not $ BSL.null err) -> do
fail $ "Benchmark failed:" ++ src_dir ++ " unexpected stderr:" ++ show err
_ -> return ()
-- Run benchmarks n times
forM_ [1..times] $ \n -> doRun n
......@@ -614,7 +607,7 @@ getModeArgs benchSettings speed = words $
= (benchSettings "NORM_OPTS")
-- | Get stdin, arguments, expected stdout for benchmarks
getTestCmdline :: Nofib -> TestName -> Action (BSL.ByteString, [String], Maybe (BSL.ByteString))
getTestCmdline :: Nofib -> TestName -> Action (BSL.ByteString, [String], Maybe (BSL.ByteString), Maybe (BSL.ByteString))
getTestCmdline Build{..} test = do
config <- readConfig' $ output </> src_dir </> "config.txt"
......@@ -643,18 +636,28 @@ getTestCmdline Build{..} test = do
liftIO $ putStrLn $ "test " <> unTestName test <> " stdout: " <> show stdout_path
stdout <- liftIO $ sequence (BSL.readFile <$> stdout_path)
return (stdin, args, stdout)
-- Check if there is an stdout file. Default to Nothing
stderr_path <-
let s = config "STDERR_FILE"
in if null s
then liftIO $ grab "stderr"
else pure $ Just $ testDir test </> s :: Action (Maybe FilePath)
liftIO $ putStrLn $ "test " <> unTestName test <> " stderr: " <> show stderr_path
stderr <- liftIO $ sequence (BSL.readFile <$> stderr_path)
return (stdin, args, stdout, stderr)
where
src_dir = testDir test
-- Grab stdin/out
grab :: String -> IO (Maybe FilePath)
grab ext = do
let s = [-- 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
-- Constant stdin/out files in src directory
let s = [src_dir </> takeFileName (unTestName test) <.> map toLower (show speed) ++ ext
,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
......
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