From fa98025de08c7b0db9402190fa8bf053d90398e1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 28 Apr 2020 17:19:07 -0400 Subject: [PATCH] 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. --- Command/TestRemote.hs | 25 +++++++++++++------ ...mote_failures_starting_with_aeca7c220.mdwn | 2 ++ ..._d53b98bca623d4d25bab58563e7577b3._comment | 22 ++++++++++++++++ 3 files changed, 41 insertions(+), 8 deletions(-) create mode 100644 doc/bugs/testremote_failures_starting_with_aeca7c220/comment_2_d53b98bca623d4d25bab58563e7577b3._comment diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index fd61153c6e..4136d9ed45 100644 --- 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 f09b8f8a87..92ddca7365 100644 --- 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 index 0000000000..af8a46feff --- /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. +"""]]