Remove the test --append-human-log and --replay features

Distribution/Simple/Setup.hs

@@ -114,7 +114,6 @@ import Distribution.Verbosity
 import Data.List   ( sort )
 import Data.Char   ( isSpace, isAlpha )
 import Data.Monoid ( Monoid(..) )
-import Data.Maybe  ( fromJust )
 
 -- FIXME Not sure where this should live
 defaultDistPref :: FilePath
@@ -1222,14 +1221,10 @@ data TestFlags = TestFlags {
     testDistPref  :: Flag FilePath,
     testVerbosity :: Flag Verbosity,
     testHumanLog :: Flag PathTemplate,
-    --TODO: do we really need append?
-    testHumanAppend :: Flag Bool,
     testMachineLog :: Flag PathTemplate,
     testShowDetails :: Flag TestShowDetails,
     --TODO: eliminate the test list and pass it directly as positional args to the testHook
     testList :: Flag [String],
-    -- TODO: do we need this feature?
-    testReplay :: Flag (Maybe FilePath),
     -- TODO: think about if/how options are passed to test exes
     testOptions :: Flag [String]
   }
@@ -1239,11 +1234,9 @@ defaultTestFlags  = TestFlags {
     testDistPref  = Flag defaultDistPref,
     testVerbosity = Flag normal,
     testHumanLog = toFlag $ toPathTemplate $ "$pkgid-$test-suite.log",
-    testHumanAppend = toFlag False,
     testMachineLog = toFlag $ toPathTemplate $ "$pkgid.log",
     testShowDetails = toFlag Failures,
     testList = Flag [],
-    testReplay = toFlag Nothing,
     testOptions = Flag []
   }
 
@@ -1258,10 +1251,6 @@ testCommand = makeCommand name shortDesc longDesc defaultTestFlags options
       , optionDistPref
             testDistPref (\d flags -> flags { testDistPref = d })
             showOrParseArgs
-      , option [] ["append-human-logs"]
-            ("Append test output to human-readable logs, instead of overwriting.")
-            testHumanAppend (\v flags -> flags { testHumanAppend = v })
-            trueArg
       , option [] ["human-log"]
             ("Log all test suite results to file (name template can use "
             ++ "$pkgid, $compiler, $os, $arch, $test-suite, $result)")
@@ -1287,11 +1276,6 @@ testCommand = makeCommand name shortDesc longDesc defaultTestFlags options
                                    (map display knownTestShowDetails))
                             (fmap toFlag parse))
                 (flagToList . fmap display))
-      , option [] ["replay"]
-            ("replay the test suites in the given machine-readable log file "
-            ++ "using the options therein")
-            testReplay (\v flags -> flags { testReplay = v })
-            (reqArg' "FILE" (toFlag . Just) (flagToList . fmap fromJust))
       , option [] ["test-options"]
             "give extra options to test executables"
             testOptions (\v flags -> flags { testOptions = v })
@@ -1311,22 +1295,18 @@ instance Monoid TestFlags where
     testDistPref  = mempty,
     testVerbosity = mempty,
     testHumanLog = mempty,
-    testHumanAppend = mempty,
     testMachineLog = mempty,
     testShowDetails = mempty,
     testList = mempty,
-    testReplay = mempty,
     testOptions = mempty
   }
   mappend a b = TestFlags {
     testDistPref  = combine testDistPref,
     testVerbosity = combine testVerbosity,
     testHumanLog = combine testHumanLog,
-    testHumanAppend = combine testHumanAppend,
     testMachineLog = combine testMachineLog,
     testShowDetails = combine testShowDetails,
     testList = combine testList,
-    testReplay = combine testReplay,
     testOptions = combine testOptions
   }
     where combine field = field a `mappend` field b

Distribution/Simple/Test.hs

@@ -81,10 +81,10 @@ import Data.Char ( toUpper )
 import Data.Monoid ( mempty )
 import System.Directory
     ( createDirectoryIfMissing, doesFileExist, getCurrentDirectory
-    , getDirectoryContents, removeFile )
+    , removeFile )
 import System.Environment ( getEnvironment )
 import System.Exit ( ExitCode(..), exitFailure, exitSuccess, exitWith )
-import System.FilePath ( (</>), (<.>), takeExtension )
+import System.FilePath ( (</>), (<.>) )
 import System.IO ( hClose, IOMode(..), withFile )
 import System.Process ( runProcess, waitForProcess )
 
@@ -122,8 +122,8 @@ data Case = Case
     }
     deriving (Read, Show, Eq)
 
-getReplayOptions :: TestSuite.Test -> TestSuiteLog -> IO TestSuite.Options
-getReplayOptions t l =
+getTestOptions :: TestSuite.Test -> TestSuiteLog -> IO TestSuite.Options
+getTestOptions t l =
     case filter ((== TestSuite.name t) . caseName) (cases l) of
         (x:_) -> return $ caseOptions x
         _ -> TestSuite.defaultOptions t
@@ -234,14 +234,12 @@ test :: PD.PackageDescription   -- ^information from the .cabal file
      -> IO ()
 test pkg_descr lbi flags = do
     let verbosity = fromFlag $ testVerbosity flags
-        append = fromFlag $ testHumanAppend flags
         humanTemplate = fromFlag $ testHumanLog flags
         machineTemplate = fromFlag $ testMachineLog flags
         distPref = fromFlag $ testDistPref flags
         testLogDir = distPref </> "test"
         testNames = fromFlag $ testList flags
         pkgTests = PD.testSuites pkg_descr
-        replay = fromFlag $ testReplay flags
 
         doTest :: (PD.TestSuite, Maybe TestSuiteLog) -> IO TestSuiteLog
         doTest (suite, mLog) = do
@@ -288,32 +286,16 @@ test pkg_descr lbi flags = do
                             , logFile = ""
                             }
 
-    testsToRun <- case replay of
-        Nothing -> case testNames of
+    testsToRun <- case testNames of
             [] -> return $ zip pkgTests $ repeat Nothing
             names -> flip mapM names $ \tName ->
                 let testMap = map (\x -> (PD.testName x, x)) pkgTests
                 in case lookup tName testMap of
                     Just t -> return (t, Nothing)
                     _ -> die $ "no such test: " ++ tName
-        Just f -> do
-            notice verbosity $ "Replaying " ++ f ++ " ..."
-            pkgLog <- readFile f >>= (return . read)
-            let testSuiteNames = map name $ testSuites pkgLog
-                replayTests =
-                    filter (\t -> PD.testName t `elem` testSuiteNames) pkgTests
-                getLog t = Just $ head $ filter (\l -> PD.testName t == name l)
-                                       $ testSuites pkgLog
-            return $ zip replayTests $ map getLog replayTests
 
     createDirectoryIfMissing True testLogDir
 
-    -- Remove existing human log files, unless they are to be appended.
-    -- The machine log file is always overwritten.
-    existingLogFiles <- liftM (filter $ (== ".log") . takeExtension)
-        $ getDirectoryContents testLogDir
-    unless append $ mapM_ (removeFile . (testLogDir </>)) existingLogFiles
-
     let totalSuites = length testsToRun
     notice verbosity $ "Running " ++ show totalSuites ++ " test suites..."
     suites <- mapM doTest testsToRun
@@ -434,7 +416,7 @@ runTests tests = do
     testLogIn <- liftM read getContents
     let go :: TestSuite.Test -> IO Case
         go t = do
-            o <- getReplayOptions t testLogIn
+            o <- getTestOptions t testLogIn
             r <- TestSuite.runM t o
             let ret = Case
                     { caseName = TestSuite.name t