fix testremote to not throw away annex state

aeca7c2207a652c8a72f044204a5c0edb4782aac exposed this problem, but it
was never a good idea to have a series of test cases, some of which depend on
prior ones, and throw away annex state after each.

diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs
index fd61153c6e5c27a921cc568541855dfac9cf8e9e..4136d9ed4508aaed5bc0a9dd3ad2ac61fad0e40d 100644 (file)
--- a/Command/TestRemote.hs
+++ b/Command/TestRemote.hs
@@ -39,6 +39,7 @@ import "crypto-api" Crypto.Random
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
+import Control.Concurrent.STM hiding (check)
 
 cmd :: Command
 cmd = command "testremote" SectionTesting
@@ -99,7 +100,7 @@ start o = starting "testremote" (ActionItemOther (Just (testRemote o))) $ do
 perform :: [Remote] -> [Remote] -> Maybe Remote -> [Key] -> CommandPerform
 perform rs unavailrs exportr ks = do
        let ea = maybe exportUnsupported Remote.exportActions exportr
-       st <- Annex.getState id
+       st <- liftIO . newTVarIO =<< Annex.getState id
        let tests = testGroup "Remote Tests" $ concat
                [ [ testGroup "unavailable remote" (testUnavailable st r (Prelude.head ks)) | r <- unavailrs ]
                , [ testGroup (desc r k) (test st r k) | k <- ks, r <- rs ]
@@ -162,7 +163,7 @@ adjustRemoteConfig r adjustconfig = do
                (Remote.gitconfig r)
                (Remote.remoteStateHandle r)
 
-test :: Annex.AnnexState -> Remote -> Key -> [TestTree]
+test :: TVar Annex.AnnexState -> Remote -> Key -> [TestTree]
 test st r k = catMaybes
        [ whenwritable $ check "removeKey when not present" remove
        , whenwritable $ present False
@@ -203,7 +204,7 @@ test st r k = catMaybes
   where
        whenwritable a = if Remote.readonly r then Nothing else Just a
        check desc a = testCase desc $
-               Annex.eval st (Annex.setOutput QuietOutput >> a) @? "failed"
+               runTestCase st a @? "failed"
        present b = check ("present " ++ show b) $
                (== Right b) <$> Remote.hasKey r k
        fsck = case maybeLookupBackendVariety (fromKey keyVariety k) of
@@ -217,7 +218,16 @@ test st r k = catMaybes
        store = Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate
        remove = Remote.removeKey r k
 
-testExportTree :: Annex.AnnexState -> Maybe Remote -> Remote.ExportActions Annex -> Key -> Key -> [TestTree]
+runTestCase :: TVar Annex.AnnexState -> Annex a -> IO a
+runTestCase stv a = do
+       st <- atomically $ readTVar stv
+       (r, st') <- Annex.run st $ do
+               Annex.setOutput QuietOutput 
+               a
+       atomically $ writeTVar stv st'
+       return r
+
+testExportTree :: TVar Annex.AnnexState -> Maybe Remote -> Remote.ExportActions Annex -> Key -> Key -> [TestTree]
 testExportTree _ Nothing _ _ _ = []
 testExportTree st (Just _) ea k1 k2 =
        [ check "check present export when not present" $
@@ -245,7 +255,7 @@ testExportTree st (Just _) ea k1 k2 =
        testexportdirectory = "testremote-export"
        testexportlocation = mkExportLocation (toRawFilePath (testexportdirectory </> "location"))
        check desc a = testCase desc $
-               Annex.eval st (Annex.setOutput QuietOutput >> a) @? "failed"
+               runTestCase st a @? "failed"
        storeexport k = do
                loc <- fromRawFilePath <$> Annex.calcRepo (gitAnnexLocation k)
                Remote.storeExport ea loc k testexportlocation nullMeterUpdate
@@ -261,7 +271,7 @@ testExportTree st (Just _) ea k1 k2 =
                Nothing -> return True
                Just a -> a (mkExportDirectory (toRawFilePath testexportdirectory))
 
-testUnavailable :: Annex.AnnexState -> Remote -> Key -> [TestTree]
+testUnavailable :: TVar Annex.AnnexState -> Remote -> Key -> [TestTree]
 testUnavailable st r k =
        [ check (== Right False) "removeKey" $
                Remote.removeKey r k
@@ -278,8 +288,7 @@ testUnavailable st r k =
        ]
   where
        check checkval desc a = testCase desc $ do
-               v <- Annex.eval st $ do
-                       Annex.setOutput QuietOutput
+               v <- runTestCase st $
                        either (Left  . show) Right <$> tryNonAsync a
                checkval v  @? ("(got: " ++ show v ++ ")")
 

diff --git a/doc/bugs/testremote_failures_starting_with_aeca7c220.mdwn b/doc/bugs/testremote_failures_starting_with_aeca7c220.mdwn
index f09b8f8a8773286d3cb43359dacb1c3fec9e89be..92ddca736547976e8fc924a97e76b3b4821b9bb9 100644 (file)
--- a/doc/bugs/testremote_failures_starting_with_aeca7c220.mdwn
+++ b/doc/bugs/testremote_failures_starting_with_aeca7c220.mdwn
@@ -79,3 +79,5 @@ bisecting, I believe these failures start happening with aeca7c220
 
 [[!meta author=kyle]]
 [[!tag projects/datalad]]
+
+> [[fixed|done]] --[[Joey]]

diff --git a/doc/bugs/testremote_failures_starting_with_aeca7c220/comment_2_d53b98bca623d4d25bab58563e7577b3._comment b/doc/bugs/testremote_failures_starting_with_aeca7c220/comment_2_d53b98bca623d4d25bab58563e7577b3._comment
new file mode 100644 (file)
index 0000000..af8a46f
--- /dev/null
+++ b/doc/bugs/testremote_failures_starting_with_aeca7c220/comment_2_d53b98bca623d4d25bab58563e7577b3._comment
@@ -0,0 +1,22 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2020-04-28T20:56:01Z"
+ content="""
+Fairly sure it's something to do with the chunk log. The tests with no
+chunks succeed, so the subsequent failures could be due to it failing to
+see information about chunks used to store the key when it then tries to
+retrieve it.
+
+Aha: It's using Annex.eval, so it does stuff, and throws away the changed
+state. So, after writing to the journal, when journalIgnorable = False,
+it will then forget that, and will try to read from the branch, ignoring
+the journal.
+
+I checked all Annex.eval, and all the rest have the pattern 
+Annex.eval =<< Annex.new. This is the only one that *reuses*
+an old state across multiple Annex.eval. And it's not like the commit that
+triggered this made Annex.eval more dangerous; that were never a good thing
+to do and probably only didn't break on some other state being lost before
+due to luck.
+"""]]