expose tasty test suite's option parser

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"

Test.hs

@@ -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"

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,

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.

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)

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