diff options
-rw-r--r-- | Command/Test.hs | 3 | ||||
-rw-r--r-- | Test.hs | 35 | ||||
-rw-r--r-- | debian/control | 1 | ||||
-rw-r--r-- | doc/git-annex.mdwn | 2 | ||||
-rw-r--r-- | git-annex.cabal | 2 | ||||
-rw-r--r-- | git-annex.hs | 6 |
6 files changed, 32 insertions, 17 deletions
diff --git a/Command/Test.hs b/Command/Test.hs index 47d72ee44..ee7220142 100644 --- a/Command/Test.hs +++ b/Command/Test.hs @@ -34,5 +34,4 @@ start ps = do stop startIO :: CmdParams -> IO () -startIO [] = warningIO "git-annex was built without its test suite; not testing" -startIO _ = error "Cannot specify any additional parameters when running test" +startIO _ = warningIO "git-annex was built without its test suite; not testing" @@ -14,9 +14,9 @@ import Test.Tasty.Runners import Test.Tasty.HUnit import Test.Tasty.QuickCheck +import Options.Applicative hiding (command) import System.PosixCompat.Files import Control.Exception.Extensible -import Data.Monoid import qualified Data.Map as M import System.IO.HVFS (SystemFS(..)) import qualified Text.JSON @@ -72,8 +72,8 @@ import qualified Utility.Gpg type TestEnv = M.Map String String -main :: IO () -main = do +main :: [String] -> IO () +main ps = do #ifndef mingw32_HOST_OS indirectenv <- prepare False directenv <- prepare True @@ -88,14 +88,27 @@ main = do let tests = testGroup "Tests" [properties, unitTests env ""] #endif - let runner = tryIngredients [consoleTestReporter] mempty tests - ifM (maybe (error "tasty failed to return a runner!") id runner) - ( exitSuccess - , do - putStrLn " (This could be due to a bug in git-annex, or an incompatability" - putStrLn " with utilities, such as git, installed on this system.)" - exitFailure - ) + -- Can't use tasty's defaultMain because one of the command line + -- parameters is "test". + let pinfo = info (helper <*> suiteOptionParser ingredients tests) + ( fullDesc <> header "Builtin test suite" ) + opts <- either (\f -> error =<< errMessage f "git-annex test") return $ + execParserPure (prefs idm) pinfo ps + case tryIngredients ingredients opts tests of + Nothing -> error "No tests found!?" + Just act -> ifM act + ( exitSuccess + , do + putStrLn " (This could be due to a bug in git-annex, or an incompatability" + putStrLn " with utilities, such as git, installed on this system.)" + exitFailure + ) + +ingredients :: [Ingredient] +ingredients = + [ consoleTestReporter + , listingTests + ] properties :: TestTree properties = testGroup "QuickCheck" diff --git a/debian/control b/debian/control index b7649b28d..86a76a9f0 100644 --- a/debian/control +++ b/debian/control @@ -54,6 +54,7 @@ Build-Depends: libghc-tasty-dev [!mipsel !sparc], libghc-tasty-hunit-dev [!mipsel !sparc], libghc-tasty-quickcheck-dev [!mipsel !sparc], + libghc-optparse-applicative-dev, lsof [!kfreebsd-i386 !kfreebsd-amd64], ikiwiki, perlmagick, diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 8a948d303..6e7a6ed55 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -822,6 +822,8 @@ subdirectories). This runs git-annex's built-in test suite. + There are several parameters, provided by Haskell's tasty test framework. + * `xmppgit` This command is used internally to perform git pulls over XMPP. diff --git a/git-annex.cabal b/git-annex.cabal index a7322e400..568d5275d 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -114,7 +114,7 @@ Executable git-annex CPP-Options: -DWITH_CLIBS if flag(TestSuite) - Build-Depends: tasty, tasty-hunit, tasty-quickcheck + Build-Depends: tasty, tasty-hunit, tasty-quickcheck, optparse-applicative CPP-Options: -DWITH_TESTSUITE if flag(TDFA) diff --git a/git-annex.hs b/git-annex.hs index 0f45f53eb..d5c7e4c9b 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -26,9 +26,9 @@ main = run =<< getProgName go a = do ps <- getArgs #ifdef WITH_TESTSUITE - if ps == ["test"] - then Test.main - else a ps + case ps of + ("test":ps') -> Test.main ps' + _ -> a ps #else a ps #endif |