From ed7528099c39ffef354e6a427d062bd3e6ffc2a7 Mon Sep 17 00:00:00 2001
From: Mitsutoshi Aoe <maoe@foldr.in>
Date: Thu, 13 Apr 2017 16:44:12 +0900
Subject: [PATCH] Make write-merge test buildable

---
 src/GHC/RTS/Events.hs |  2 ++
 test/WriteMerge.hs    | 49 +++++++++++++++++++------------------------
 2 files changed, 23 insertions(+), 28 deletions(-)

diff --git a/src/GHC/RTS/Events.hs b/src/GHC/RTS/Events.hs
index 3bf3d08..a02d72f 100644
--- a/src/GHC/RTS/Events.hs
+++ b/src/GHC/RTS/Events.hs
@@ -42,6 +42,8 @@ module GHC.RTS.Events (
        readEventLogFromFile,
        writeEventLogToFile,
 
+       serialiseEventLog,
+
        -- * Utilities
        CapEvent(..), sortEvents,
        buildEventTypeMap,
diff --git a/test/WriteMerge.hs b/test/WriteMerge.hs
index 99668bf..aac78e7 100644
--- a/test/WriteMerge.hs
+++ b/test/WriteMerge.hs
@@ -1,53 +1,46 @@
 {-
   This test checks the functionality of `ghc-events merge` and writeEventLogToFile
 -}
-
+import Control.Monad
 import qualified Data.ByteString.Lazy as BL
 import Data.List (( \\ ))
 import Data.Maybe (fromJust)
 import System.Exit (exitFailure)
 
 import GHC.RTS.Events
-import GHC.RTS.EventsIncremental
+import GHC.RTS.Events.Incremental (readEventLog)
 import Utils (files, diffLines)
 
-
 -- Failing test cases due to changes introduced some time in the past but
 -- went unnoticed. Needs fixing. TODO
+failingCases :: [FilePath]
 failingCases = map ("test/"++)
   [ "queens-ghc-6.12.1.eventlog"
   , "queens-ghc-7.0.2.eventlog"
   , "mandelbrot-mmc-2011-06-14.eventlog"
   , "782stop.eventlog"]
 
--- Returns a pretty printed version of the log and one that's been reserialised
--- and reparsed, which should yield the same result
-rewriteLog :: EventLog -> (String, String)
-rewriteLog oldLog =
-  (ppEventLog oldLog, ppEventLog newLog)
-  where
-    logBytestring = serialiseEventLog oldLog
-    eps = newParserState `pushBytes` (BL.toStrict logBytestring)
-    (newEvts, finalState, _) = readRemainingEvents eps
-    newHdr = fromJust $ readHeader finalState
-    newLog = (EventLog newHdr (Data newEvts))
+rewriteLog :: EventLog -> EventLog
+rewriteLog oldLog = case readEventLog (serialiseEventLog oldLog) of
+  Left reason -> error reason
+  Right (newLog, _) -> newLog
 
 testFile :: FilePath -> IO Bool
 testFile f = do
-    e <- readEventLogFromFile f
-    let oops s = putStrLn (f ++ ": failure " ++ s) >> return False
-    case e of
-        Left m -> oops m
-        Right log -> do
-          let (old, new) = rewriteLog log
-          if old == new
-                    then putStrLn (f ++ ": success") >> return True
-                    else do putStrLn $ diffLines old new
-                            oops "re-written file does not match the original"
+  e <- readEventLogFromFile f
+  let oops s = putStrLn (f ++ ": failure " ++ s) >> return False
+  case e of
+    Left m -> oops m
+    Right log -> do
+      let old = ppEventLog log
+      let new = ppEventLog $ rewriteLog log
+      if old == new
+        then putStrLn (f ++ ": success") >> return True
+        else do
+          putStrLn $ diffLines old new
+          oops "re-written file does not match the original"
 
 main :: IO ()
 main = do
-    successes <- mapM testFile files
-    if and successes
-        then return ()
-        else exitFailure
+  successes <- mapM testFile files
+  unless (and successes) exitFailure