testremote: Display exceptions when tests fail, to aid debugging

diff --git a/CHANGELOG b/CHANGELOG
index 9d64142eaec61ca23e06f993dcd8248d2126ab34..c0b8a07561e203613ca076425e2ee89c2b1efb8a 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -14,6 +14,7 @@ git-annex (8.20201008) UNRELEASED; urgency=medium
     chunks using the configured chunk size.
   * Fixed some problems that prevented this command from working:
     git submodule foreach git annex init
+  * testremote: Display exceptions when tests fail, to aid debugging.
 
  -- Joey Hess <id@joeyh.name>  Thu, 08 Oct 2020 10:48:17 -0400
 

diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs
index e09b6708c8abebf2f5b5031bcc54e2fda364486c..a07ab67b3cb339460ebcc18ef650702886f1548c 100644 (file)
--- a/Command/TestRemote.hs
+++ b/Command/TestRemote.hs
@@ -235,15 +235,15 @@ mkTestTrees runannex mkrs mkunavailr mkexportr mkks = concat $
 test :: RunAnnex -> Annex (Maybe Remote) -> Annex Key -> [TestTree]
 test runannex mkr mkk =
        [ check "removeKey when not present" $ \r k ->
-               whenwritable r $ isRight <$> tryNonAsync (remove r k)
+               whenwritable r $ runBool (remove r k)
        , check ("present " ++ show False) $ \r k ->
                whenwritable r $ present r k False
        , check "storeKey" $ \r k ->
-               whenwritable r $ isRight <$> tryNonAsync (store r k)
+               whenwritable r $ runBool (store r k)
        , check ("present " ++ show True) $ \r k ->
                whenwritable r $ present r k True
        , check "storeKey when already present" $ \r k ->
-               whenwritable r $ isRight <$> tryNonAsync (store r k)
+               whenwritable r $ runBool (store r k)
        , check ("present " ++ show True) $ \r k -> present r k True
        , check "retrieveKeyFile" $ \r k -> do
                lockContentForRemoval k noop removeAnnex
@@ -273,7 +273,7 @@ test runannex mkr mkk =
                get r k
        , check "fsck downloaded object" fsck
        , check "removeKey when present" $ \r k -> 
-               whenwritable r $ isRight <$> tryNonAsync (remove r k)
+               whenwritable r $ runBool (remove r k)
        , check ("present " ++ show False) $ \r k -> 
                whenwritable r $ present r k False
        ]
@@ -306,31 +306,31 @@ testExportTree runannex mkr mkk1 mkk2 =
        [ check "check present export when not present" $ \ea k1 _k2 ->
                not <$> checkpresentexport ea k1
        , check "remove export when not present" $ \ea k1 _k2 -> 
-               isRight <$> tryNonAsync (removeexport ea k1)
+               runBool (removeexport ea k1)
        , check "store export" $ \ea k1 _k2 ->
-               isRight <$> tryNonAsync (storeexport ea k1)
+               runBool (storeexport ea k1)
        , check "check present export after store" $ \ea k1 _k2 ->
                checkpresentexport ea k1
        , check "store export when already present" $ \ea k1 _k2 ->
-               isRight <$> tryNonAsync (storeexport ea k1)
+               runBool (storeexport ea k1)
        , check "retrieve export" $ \ea k1 _k2 -> 
                retrieveexport ea k1
        , check "store new content to export" $ \ea _k1 k2 ->
-               isRight <$> tryNonAsync (storeexport ea k2)
+               runBool (storeexport ea k2)
        , check "check present export after store of new content" $ \ea _k1 k2 ->
                checkpresentexport ea k2
        , check "retrieve export new content" $ \ea _k1 k2 ->
                retrieveexport ea k2
        , check "remove export" $ \ea _k1 k2 -> 
-               isRight <$> tryNonAsync (removeexport ea k2)
+               runBool (removeexport ea k2)
        , check "check present export after remove" $ \ea _k1 k2 ->
                not <$> checkpresentexport ea k2
        , check "retrieve export fails after removal" $ \ea _k1 k2 ->
                not <$> retrieveexport ea k2
        , check "remove export directory" $ \ea _k1 _k2 ->
-               isRight <$> tryNonAsync (removeexportdirectory ea)
+               runBool (removeexportdirectory ea)
        , check "remove export directory that is already removed" $ \ea _k1 _k2 ->
-               isRight <$> tryNonAsync (removeexportdirectory ea)
+               runBool (removeexportdirectory ea)
        -- renames are not tested because remotes do not need to support them
        ]
   where
@@ -448,3 +448,9 @@ getReadonlyKey r f = lookupKey (toRawFilePath f) >>= \case
                unlessM ((Remote.uuid r `elem`) <$> loggedLocations k) $
                        giveup $ f ++ " is not stored in the remote being tested, cannot test it"
                return k
+
+runBool :: Monad m => m () -> m Bool
+runBool a = do
+       a
+       return True
+

diff --git a/doc/bugs/storeKey_when_already_present_failures_on_Windows/comment_2_07f7881be6b0d29cdf64a7839b669b3e._comment b/doc/bugs/storeKey_when_already_present_failures_on_Windows/comment_2_07f7881be6b0d29cdf64a7839b669b3e._comment
new file mode 100644 (file)
index 0000000..7c14b1e
--- /dev/null
+++ b/doc/bugs/storeKey_when_already_present_failures_on_Windows/comment_2_07f7881be6b0d29cdf64a7839b669b3e._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2020-10-23T19:27:57Z"
+ content="""
+I've made it display whatever exception caused the test to fail, which
+should help pin down a bit more what the problem is.
+"""]]