diff options
| -rw-r--r-- | Test.hs | 55 | ||||
| -rw-r--r-- | Types/Test.hs | 9 | ||||
| -rw-r--r-- | debian/changelog | 1 | ||||
| -rw-r--r-- | doc/git-annex-test.mdwn | 10 | ||||
| -rw-r--r-- | doc/todo/smudge.mdwn | 1 |
5 files changed, 54 insertions, 22 deletions
@@ -9,6 +9,7 @@ module Test where +import Types.Test import Options.Applicative.Types #ifndef WITH_TESTSUITE @@ -24,11 +25,11 @@ runner = Nothing #else import Test.Tasty -import Test.Tasty.Options import Test.Tasty.Runners import Test.Tasty.HUnit import Test.Tasty.QuickCheck import Test.Tasty.Ingredients.Rerun +import Options.Applicative (switch, long, help) import qualified Data.Map as M import qualified Text.JSON @@ -99,11 +100,16 @@ import qualified Types.Crypto import qualified Utility.Gpg #endif -optParser :: Parser OptionSet -optParser = suiteOptionParser ingredients tests +optParser :: Parser TestOptions +optParser = TestOptions + <$> suiteOptionParser ingredients (tests mempty) + <*> switch + ( long "keep-failures" + <> help "preserve repositories on test failure" + ) -runner :: Maybe (OptionSet -> IO ()) -runner = Just $ \opts -> case tryIngredients ingredients opts tests of +runner :: Maybe (TestOptions -> IO ()) +runner = Just $ \opts -> case tryIngredients ingredients (tastyOptionSet opts) (tests opts) of Nothing -> error "No tests found!?" Just act -> ifM act ( exitSuccess @@ -119,17 +125,17 @@ ingredients = , rerunningTests [consoleTestReporter] ] -tests :: TestTree -tests = testGroup "Tests" $ properties : +tests :: TestOptions -> TestTree +tests opts = testGroup "Tests" $ properties : map (\(d, te) -> withTestMode te (unitTests d)) testmodes where testmodes = - -- [ ("v6 unlocked", (testMode "6") { unlockedFiles = True }) - [ ("v6 locked", testMode "6") - , ("v5", testMode "5") + [ ("v6 unlocked", (testMode opts "6") { unlockedFiles = True }) + , ("v6 locked", testMode opts "6") + , ("v5", testMode opts "5") #ifndef mingw32_HOST_OS -- Windows will only use direct mode, so don't test twice. - , ("v5 direct", (testMode "5") { forceDirect = True }) + , ("v5 direct", (testMode opts "5") { forceDirect = True }) #endif ] @@ -1611,7 +1617,17 @@ withtmpclonerepo = withtmpclonerepo' newCloneRepoConfig withtmpclonerepo' :: CloneRepoConfig -> (FilePath -> Assertion) -> Assertion withtmpclonerepo' cfg a = do dir <- tmprepodir - bracket (clonerepo mainrepodir dir cfg) cleanup a + clone <- clonerepo mainrepodir dir cfg + r <- tryNonAsync (a clone) + case r of + Right () -> cleanup clone + Left e -> do + ifM (keepFailures <$> getTestMode) + ( putStrLn $ "** Preserving repo for failure analysis in " ++ clone + , cleanup clone + ) + throwM e + disconnectOrigin :: Assertion disconnectOrigin = boolSystem "git" [Param "remote", Param "rm", Param "origin"] @? "remote rm" @@ -1839,13 +1855,15 @@ data TestMode = TestMode { forceDirect :: Bool , unlockedFiles :: Bool , annexVersion :: Annex.Version.Version + , keepFailures :: Bool } deriving (Read, Show) -testMode :: Annex.Version.Version -> TestMode -testMode v = TestMode +testMode :: TestOptions -> Annex.Version.Version -> TestMode +testMode opts v = TestMode { forceDirect = False , unlockedFiles = False , annexVersion = v + , keepFailures = keepFailuresOption opts } withTestMode :: TestMode -> TestTree -> TestTree @@ -1858,13 +1876,14 @@ withTestMode testmode = withResource prepare release . const Just act -> unlessM act $ error "init tests failed! cannot continue" return () - release _ = cleanup' True tmpdir + release _ + | keepFailures testmode = void $ tryIO $ do + cleanup' True mainrepodir + removeDirectory tmpdir + | otherwise = cleanup' True tmpdir setTestMode :: TestMode -> IO () setTestMode testmode = do - whenM (doesDirectoryExist tmpdir) $ - error $ "The temporary directory " ++ tmpdir ++ " already exists; cannot run test suite." - currdir <- getCurrentDirectory p <- Utility.Env.getEnvDefault "PATH" "" diff --git a/Types/Test.hs b/Types/Test.hs index 35c4c3c23..2cf8dfbe2 100644 --- a/Types/Test.hs +++ b/Types/Test.hs @@ -14,7 +14,14 @@ import Test.Tasty.Options #endif #ifdef WITH_TESTSUITE -type TestOptions = OptionSet +data TestOptions = TestOptions + { tastyOptionSet :: OptionSet + , keepFailuresOption :: Bool + } + +instance Monoid TestOptions where + mempty = TestOptions mempty False + #else type TestOptions = () #endif diff --git a/debian/changelog b/debian/changelog index c5a8bed2f..cab3bc8d4 100644 --- a/debian/changelog +++ b/debian/changelog @@ -39,6 +39,7 @@ git-annex (6.20151219) UNRELEASED; urgency=medium with fields for each backend instead of the previous weird nested lists. This may break existing parsers of this json output, if there were any. * whereis --json: Make url list be included in machine-parseable form. + * test: Added --keep-failures option. -- Joey Hess <id@joeyh.name> Sat, 19 Dec 2015 13:31:17 -0400 diff --git a/doc/git-annex-test.mdwn b/doc/git-annex-test.mdwn index b38084028..773f7404e 100644 --- a/doc/git-annex-test.mdwn +++ b/doc/git-annex-test.mdwn @@ -10,8 +10,7 @@ git annex test This runs git-annex's built-in test suite. -The test suite runs in the `.t` subdirectory of the current directory -(it refuses to run if `.t` already exists). +The test suite runs in the `.t` subdirectory of the current directory. It can be useful to run the test suite on different filesystems, or to verify your local installation of git-annex. @@ -19,7 +18,12 @@ or to verify your local installation of git-annex. # OPTIONS There are several options, provided by Haskell's tasty test -framework. Pass --help for details. +framework. Pass --help for details about those. + +* `--keep-failures` + + When there are test failures, leave the `.t` directory populated with + repositories that demonstate the failures, for later analysis. # SEE ALSO diff --git a/doc/todo/smudge.mdwn b/doc/todo/smudge.mdwn index 215573363..36561ca7f 100644 --- a/doc/todo/smudge.mdwn +++ b/doc/todo/smudge.mdwn @@ -6,6 +6,7 @@ git-annex should use smudge/clean filters. That pass has many failures. * Intermittent test suite failures, with: Exception: failed to commit changes to sqlite database: Just SQLite3 returned ErrorIO while attempting to perform step. + sqlite worker thread crashed: SQLite3 returned ErrorError while attempting to perform step. * Reconcile staged changes into the associated files database, whenever the database is queried. This is needed to handle eg: git add largefile |