Support running tests N times

2 files changed, 32 insertions, 7 deletions

diff --git a/handy.cabal b/handy.cabal
index 5bd4f85..c55c329 100644
--- a/handy.cabal
+++ b/handy.cabal
@@ -7,7 +7,7 @@ license:             BSD3
 license-file:        LICENSE
 author:              Will Thompson
 maintainer:          Will Thompson <will@willthompson.co.uk>
-build-depends:       base (>= 4), unix, filepath, directory
+build-depends:       base (>= 4), unix, filepath, directory, process
 build-type:          Simple
 extra-source-files:  README
 
diff --git a/tt.hs b/tt.hs
index 7f1792c..4d869ff 100755
--- a/tt.hs
+++ b/tt.hs
@@ -9,22 +9,29 @@ import System.Directory ( doesFileExist
 import Data.List (intercalate, stripPrefix, isSuffixOf)
 import Data.Maybe (fromMaybe, listToMaybe)
 import Control.Applicative ((<$>), (<*>))
-import Control.Monad (when, filterM)
+import Control.Monad (when, filterM, forever, replicateM_)
 import System.Environment (getArgs)
 import System.FilePath ((</>))
-import System.Posix.Process (executeFile)
+import System.Process
+import System.Exit
 
 type Flag = String
+data Repetitions = Forever
+                 | Times Int
+  deriving Show
 
 {- Command line argument definitions and parsing -}
 data Options = Options { printTestDirectory :: Bool
                        , makeFlags :: [Flag]
+                       , repetitions :: Repetitions
                        }
+  deriving Show
 type OptionTransformer = Options -> Options
 
 defaultOptions :: Options
 defaultOptions = Options { printTestDirectory = False
                          , makeFlags = []
+                         , repetitions = Times 1
                          }
 
 setPrintTestDirectory :: OptionTransformer
@@ -33,6 +40,9 @@ setPrintTestDirectory opts = opts { printTestDirectory = True }
 addFlag :: Flag -> OptionTransformer
 addFlag f opts = opts { makeFlags = makeFlags opts ++ [f] }
 
+setRepetitions :: Maybe String -> OptionTransformer
+setRepetitions r opts = opts { repetitions = maybe Forever (Times . read) r }
+
 dialects :: String -> OptionTransformer
 dialects = addFlag . ("JINGLE_DIALECTS=" ++)
 
@@ -48,6 +58,9 @@ optionDefinitions =
     , Option ['p'] ["print-test-directory"]
              (NoArg setPrintTestDirectory)
              "Print the path to the directory containing tests"
+    , Option ['r'] ["repetitions"]
+             (OptArg setRepetitions "N")
+             "Run specified tests N times, or forever"
     ]
 
 parseOptions :: [String] -> (Options, [String], [String])
@@ -57,11 +70,12 @@ parseOptions args = (options, tests, errors)
     options = foldr (.) id transformers defaultOptions
 
 header :: String
-header = "Usage: tt [-v] [-V] [-d DIALECTS] [tests...]"
+header = "Usage: tt [-v] [-V] [-d DIALECTS] [-r[N]] [tests...]"
 
 {- Building and execution of a `make check-twisted` invocation -}
-runTests :: FilePath -> String -> Bool -> [String] -> [Flag] -> IO ()
-runTests testDir testVar inTree tests flags = do
+runTests :: FilePath -> String -> Bool -> [String] -> [Flag] -> Repetitions
+         -> IO ()
+runTests testDir testVar inTree tests flags reps = do
     let buildPaths = expand testDir inTree . unprefix testDir
     tests' <- concat <$> mapM buildPaths tests
     let t = case tests' of
@@ -72,7 +86,17 @@ runTests testDir testVar inTree tests flags = do
                           , "TWISTED_SEPARATE_TESTS="
                           ]
         args = [ "check-twisted", "-s", "-C", testDir ] ++ t ++ flags
-    executeFile "make" True args Nothing
+
+    let run = do
+        (_, _, _, h) <- createProcess $ proc "make" args
+        exitCode <- waitForProcess h
+        case exitCode of
+            ExitSuccess   -> return ()
+            ExitFailure _ -> exitWith exitCode
+
+    case reps of
+        Forever -> forever run
+        Times n -> replicateM_ n run
 
 unprefix :: FilePath -> String -> String
 unprefix testDir = fromMaybe <*> stripPrefix testDir
@@ -116,4 +140,5 @@ main = do
               then putStrLn $ (if inTree then "." else "..") </> "tests/twisted"
               else runTests "tests/twisted/" testVar inTree tests
                             (makeFlags options)
+                            (repetitions options)
         Nothing      -> ioError (userError "no tests here :'(")