1{-
2  This test checks the functionality of `ghc-events merge` and writeEventLogToFile
3-}
4import Control.Monad
5import qualified Data.ByteString.Lazy as BL
6import Data.List (( \\ ))
7import Data.Maybe (fromJust)
8import System.Exit (exitFailure)
9
10import GHC.RTS.Events
11import GHC.RTS.Events.Incremental (readEventLog)
12import Utils (files, diffLines)
13
14-- Failing test cases due to changes introduced some time in the past but
15-- went unnoticed. Needs fixing. TODO
16failingCases :: [FilePath]
17failingCases = map ("test/"++)
18  [ "queens-ghc-6.12.1.eventlog"
19  , "queens-ghc-7.0.2.eventlog"
20  , "mandelbrot-mmc-2011-06-14.eventlog"
21  , "782stop.eventlog"]
22
23rewriteLog :: EventLog -> EventLog
24rewriteLog oldLog = case readEventLog (serialiseEventLog oldLog) of
25  Left reason -> error reason
26  Right (newLog, _) -> newLog
27
28testFile :: FilePath -> IO Bool
29testFile f = do
30  e <- readEventLogFromFile f
31  let oops s = putStrLn (f ++ ": failure " ++ s) >> return False
32  case e of
33    Left m -> oops m
34    Right log -> do
35      let old = ppEventLog log
36      let new = ppEventLog $ rewriteLog log
37      if old == new
38        then putStrLn (f ++ ": success") >> return True
39        else do
40          putStrLn $ diffLines old new
41          oops "re-written file does not match the original"
42
43main :: IO ()
44main = do
45  successes <- mapM testFile files
46  unless (and successes) exitFailure
47