fix testremote to not throw away annex state
aeca7c2207
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.
This commit is contained in:
parent
e66f9d1c8c
commit
fa98025de0
3 changed files with 41 additions and 8 deletions
|
@ -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 ++ ")")
|
||||
|
||||
|
|
|
@ -79,3 +79,5 @@ bisecting, I believe these failures start happening with aeca7c220
|
|||
|
||||
[[!meta author=kyle]]
|
||||
[[!tag projects/datalad]]
|
||||
|
||||
> [[fixed|done]] --[[Joey]]
|
||||
|
|
|
@ -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.
|
||||
"""]]
|
Loading…
Reference in a new issue