Initial commit.

6 files changed, 163 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..9b5ef6f
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+/dist
+.*.swp
+*~
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..779c434
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,26 @@
+Copyright © 2010–2011 Will Thompson <will@willthompson.co.uk>
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. Neither the name of the University nor the names of its contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
diff --git a/README b/README
new file mode 100644
index 0000000..a896569
--- /dev/null
+++ b/README
@@ -0,0 +1,19 @@
+To build and install to ~/.cabal/bin:
+
+  % cabal install
+
+To build and install somewhere else:
+
+  % cabal install --prefix=$HOME
+
+While developing, run this once:
+
+  % cabal configure
+
+Run this to build your changes:
+
+  % cabal build
+
+The executable will be `./dist/build/tt/tt`.
+
+`cabal` lives in the Debian package 'cabal-install'.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/handy.cabal b/handy.cabal
new file mode 100644
index 0000000..5bd4f85
--- /dev/null
+++ b/handy.cabal
@@ -0,0 +1,16 @@
+name:                tt
+version:             0.0.1
+synopsis:            Test runner for Telepathy twisted tests
+description:         Simplifies invoking `make check-twisted` to run Telepathy tests
+category:            
+license:             BSD3
+license-file:        LICENSE
+author:              Will Thompson
+maintainer:          Will Thompson <will@willthompson.co.uk>
+build-depends:       base (>= 4), unix, filepath, directory
+build-type:          Simple
+extra-source-files:  README
+
+executable:          tt
+main-is:             tt.hs
+ghc-options:         -Wall -fno-warn-unused-imports -Werror
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 :'(")