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