Initial commit.

1 files changed, 97 insertions, 0 deletions

diff --git a/tt.hs b/tt.hs
new file mode 100755
index 0000000..eddacd4
--- /dev/null
+++ b/tt.hs
@@ -0,0 +1,97 @@
+{- Helper script to run Twisted tests -}
+module Main where
+
+import System.Console.GetOpt
+import System.Directory ( doesFileExist
+                        , doesDirectoryExist
+                        , getDirectoryContents
+                        )
+import Data.List (intercalate, stripPrefix, isSuffixOf)
+import Data.Maybe (fromMaybe, listToMaybe)
+import Data.Either (partitionEithers)
+import Control.Applicative ((<$>), (<*>))
+import Control.Monad (when, filterM)
+import System.Environment (getArgs)
+import System.FilePath ((</>))
+import System.Posix.Process (executeFile)
+
+data Command = PrintTestDirectory
+             | RunTests
+
+type Flag = String
+type Option = Either Command Flag
+
+runTests :: FilePath -> String -> Bool -> [String] -> [Flag] -> IO ()
+runTests testDir testVar inTree tests flags = do
+    let buildPaths = expand testDir inTree . unprefix testDir
+    tests' <- concat <$> mapM buildPaths tests
+    let t = case tests' of
+                    [] -> []
+                    _  -> [ testVar ++ "=" ++ (intercalate " " tests')
+                          -- This is because Mission Control is crap and has
+                          -- two different sets of tests.
+                          , "TWISTED_SEPARATE_TESTS="
+                          ]
+        args = [ "check", "-s", "-C", testDir ] ++ t ++ flags
+    executeFile "make" True args Nothing
+
+unprefix :: FilePath -> String -> String
+unprefix testDir = fromMaybe <*> stripPrefix testDir
+
+isPython :: String -> Bool
+isPython = isSuffixOf ".py"
+
+expand :: FilePath -> Bool -> String -> IO [String]
+expand testDir inTree s
+    | isPython           s = return [s]
+    | "/"   `isSuffixOf` s = do
+        let srcdir = if inTree then "." else ".."
+            dir = srcdir </> testDir </> s
+        (map (s ++) . filter isPython) <$> getDirectoryContents dir
+    | otherwise            = return [s ++ ".py"]
+
+dialects :: String -> Option
+dialects = Right . ("JINGLE_DIALECTS=" ++)
+
+simpleOption :: Char -> String -> Flag -> OptDescr Option
+simpleOption c s f = Option [c] [s] (NoArg (Right f)) ("set " ++ f)
+
+options :: [OptDescr Option]
+options = [ simpleOption 'v' "verbose" "CHECK_TWISTED_VERBOSE=1"
+          , simpleOption 'V' "valgrind" "GABBLE_TEST_VALGRIND=1"
+          , Option ['d'] ["dialects"] (ReqArg dialects "DIALECTS")
+                   "set JINGLE_DIALECTS to DIALECTS"
+          , Option ['p'] ["print-test-directory"]
+                   (NoArg (Left PrintTestDirectory))
+                   "Print the path to the directory containing tests"
+          ]
+
+header :: String
+header = "Usage: tt [-v] [-V] [-d DIALECTS] [tests...]"
+
+iFuckingHateMissionControl :: IO (Maybe String)
+iFuckingHateMissionControl = do
+    let dirs = [ ("mission-control-plugins", "TWISTED_BASIC_TESTS")
+               , ("tests/twisted", "TWISTED_TESTS")
+               ]
+
+    fmap snd . listToMaybe <$> filterM (doesDirectoryExist . fst) dirs
+
+main :: IO ()
+main = do
+    (commandAndFlags, tests, errors) <- getOpt RequireOrder options <$> getArgs
+    when (not $ null errors) $ do
+        ioError (userError (concat errors ++ usageInfo header options))
+
+    let (commands, flags) = partitionEithers commandAndFlags
+
+    inTree <- doesFileExist "configure"
+    iReallyDo <- iFuckingHateMissionControl
+
+    case iReallyDo of
+        Just testVar -> do
+            case head (commands ++ [RunTests]) of
+                RunTests -> runTests "tests/twisted/" testVar inTree tests flags
+                PrintTestDirectory -> 
+                    putStrLn $ (if inTree then "." else "..") </> "tests/twisted"
+        Nothing      -> ioError (userError "no tests here :'(")