git-annex 7.20181031 → 7.20181105

raw patch · 9 files changed

+84/−78 lines, 9 filesdep ~QuickCheck

Dependency ranges changed: QuickCheck

Files

• CHANGELOG +11/−0
• Command/ImportFeed.hs +16/−13
• P2P/Annex.hs +11/−10
• P2P/Protocol.hs +3/−2
• Test.hs +19/−21
• Test/Framework.hs +10/−4
• Utility/InodeCache.hs +1/−9
• Utility/QuickCheck.hs +11/−17
• git-annex.cabal +2/−2

@@ -1,3 +1,14 @@+git-annex (7.20181105) upstream; urgency=medium++  * Fix test suite failure when git-annex test is not run inside a git+    repository.+  * Fix a P2P protocol hang.+  * importfeed: Avoid erroring out when a feed has been repeatedly broken,+    as that can leave other imported files not checked into git.+  * Increase minimum QuickCheck version.++ -- Joey Hess <id@joeyh.name>  Mon, 05 Nov 2018 13:31:09 -0400+ git-annex (7.20181031) upstream; urgency=medium    * Added v7 repository mode. v6 upgrades automatically to v7, but

@@ -78,21 +78,18 @@ perform opts cache url = do 	v <- findDownloads url 	case v of-		[] -> do+		[] -> next $ 			feedProblem url "bad feed content; no enclosures to download"-			next $ return True 		l -> do 			showOutput 			ok <- and <$> mapM (performDownload opts cache) l-			unless ok $-				feedProblem url "problem downloading some item(s) from feed"-			next $ cleanup url True+			next $ cleanup url ok  cleanup :: URLString -> Bool -> CommandCleanup-cleanup url ok = do-	when ok $-		clearFeedProblem url-	return ok+cleanup url True = do+	clearFeedProblem url+	return True+cleanup url False = feedProblem url "problem downloading some item(s) from feed"  data ToDownload = ToDownload 	{ feed :: Feed@@ -370,11 +367,17 @@ noneValue = "none"  {- Called when there is a problem with a feed.- - Throws an error if the feed is broken, otherwise shows a warning. -}-feedProblem :: URLString -> String -> Annex ()+ -+ - If the feed has been broken for some time,+ - returns False, otherwise only warns. -}+feedProblem :: URLString -> String -> Annex Bool feedProblem url message = ifM (checkFeedBroken url)-	( giveup $ message ++ " (having repeated problems with feed: " ++ url ++ ")"-	, warning $ "warning: " ++ message+	( do+		warning $ message ++ " (having repeated problems with feed: " ++ url ++ ")"+		return False+	, do+		warning $ "warning: " ++ message+		return True 	)  {- A feed is only broken if problems have occurred repeatedly, for at

@@ -50,18 +50,19 @@ 		size <- inAnnex' isJust Nothing getsize k 		runner (next (Len <$> size)) 	ReadContent k af o sender next -> do+		let proceed c = do+			r <- tryNonAsync c+			case r of+				Left e -> return $ Left $ ProtoFailureException e+				Right (Left e) -> return $ Left e+				Right (Right ok) -> runner (next ok) 		v <- tryNonAsync $ prepSendAnnex k 		case v of-			Right (Just (f, checkchanged)) -> do-				v' <- tryNonAsync $-					transfer upload k af $-						sinkfile f o checkchanged sender-				case v' of-					Left e -> return $ Left $ ProtoFailureException e-					Right (Left e) -> return $ Left e-					Right (Right ok) -> runner (next ok)-			-- content not available- 			Right Nothing -> runner (next False)+			Right (Just (f, checkchanged)) -> proceed $+				transfer upload k af $+					sinkfile f o checkchanged sender+ 			Right Nothing -> proceed $+				runner (sender mempty (return Invalid)) 			Left e -> return $ Left $ ProtoFailureException e 	StoreContent k af o l getb validitycheck next -> do 		-- This is the same as the retrievalSecurityPolicy of

@@ -238,8 +238,9 @@ 	-- present. 	| ReadContent Key AssociatedFile Offset (L.ByteString -> Proto Validity -> Proto Bool) (Bool -> c) 	-- ^ Reads the content of a key and sends it to the callback.-	-- If the content is not available, sends L.empty to the callback.-	-- Note that the content may change while it's being sent.+	-- May send any amount of data, including L.empty if the content is+	-- not available. The callback must deal with that.+	-- And the content may change while it's being sent. 	-- The callback is passed a validity check that it can run after 	-- sending the content to detect when this happened. 	| StoreContent Key AssociatedFile Offset Len (Proto L.ByteString) (Proto (Maybe Validity)) (Bool -> c)

@@ -60,7 +60,6 @@ import qualified Annex.Init import qualified Annex.CatFile import qualified Annex.Path-import qualified Annex.AdjustedBranch import qualified Annex.VectorClock import qualified Annex.View import qualified Annex.View.ViewedFile@@ -1100,9 +1099,9 @@  {- Conflict resolution while in an adjusted branch. -} test_conflict_resolution_adjusted_branch :: Assertion-test_conflict_resolution_adjusted_branch = whenM (annexeval Annex.AdjustedBranch.isSupported) $+test_conflict_resolution_adjusted_branch = 	withtmpclonerepo $ \r1 ->-		withtmpclonerepo $ \r2 -> do+		withtmpclonerepo $ \r2 -> whenM (adjustedbranchsupported r2) $ do 			indir r1 $ do 				disconnectOrigin 				writecontent conflictor "conflictor1"@@ -1449,9 +1448,9 @@  - where the same file is added to both independently. The bad merge  - emptied the whole tree. -} test_adjusted_branch_merge_regression :: Assertion-test_adjusted_branch_merge_regression = whenM (annexeval Annex.AdjustedBranch.isSupported) $+test_adjusted_branch_merge_regression = do 	withtmpclonerepo $ \r1 ->-		withtmpclonerepo $ \r2 -> do+		withtmpclonerepo $ \r2 -> whenM (adjustedbranchsupported r1) $ do 			pair r1 r2 			setup r1 			setup r2@@ -1476,22 +1475,21 @@  - a subtree to an existing tree lost files. -} test_adjusted_branch_subtree_regression :: Assertion test_adjusted_branch_subtree_regression = -	whenM (annexeval Annex.AdjustedBranch.isSupported) $ -		withtmpclonerepo $ \r -> do-			indir r $ do-				disconnectOrigin-				git_annex "upgrade" [] @? "upgrade failed"-				git_annex "adjust" ["--unlock", "--force"] @? "adjust failed"-				createDirectoryIfMissing True "a/b/c"-				writecontent "a/b/c/d" "foo"-				git_annex "add" ["a/b/c"] @? "add a/b/c failed"-				git_annex "sync" [] @? "sync failed"-				createDirectoryIfMissing True "a/b/x"-				writecontent "a/b/x/y" "foo"-				git_annex "add" ["a/b/x"] @? "add a/b/x failed"-				git_annex "sync" [] @? "sync failed"-				boolSystem "git" [Param "checkout", Param "master"] @? "git checkout master failed"-				doesFileExist "a/b/x/y" @? ("a/b/x/y missing from master after adjusted branch sync")+	withtmpclonerepo $ \r -> whenM (adjustedbranchsupported r) $ do+		indir r $ do+			disconnectOrigin+			git_annex "upgrade" [] @? "upgrade failed"+			git_annex "adjust" ["--unlock", "--force"] @? "adjust failed"+			createDirectoryIfMissing True "a/b/c"+			writecontent "a/b/c/d" "foo"+			git_annex "add" ["a/b/c"] @? "add a/b/c failed"+			git_annex "sync" [] @? "sync failed"+			createDirectoryIfMissing True "a/b/x"+			writecontent "a/b/x/y" "foo"+			git_annex "add" ["a/b/x"] @? "add a/b/x failed"+			git_annex "sync" [] @? "sync failed"+			boolSystem "git" [Param "checkout", Param "master"] @? "git checkout master failed"+			doesFileExist "a/b/x/y" @? ("a/b/x/y missing from master after adjusted branch sync")  {- Set up repos as remotes of each other. -} pair :: FilePath -> FilePath -> Assertion

@@ -35,6 +35,7 @@ import qualified Annex.Init import qualified Annex.Path import qualified Annex.Action+import qualified Annex.AdjustedBranch import qualified Utility.Process import qualified Utility.Env import qualified Utility.Env.Set@@ -160,17 +161,22 @@ withgitrepo :: (FilePath -> Assertion) -> Assertion withgitrepo = bracket (setuprepo mainrepodir) return -indir :: FilePath -> Assertion -> Assertion+indir :: FilePath -> IO a -> IO a indir dir a = do 	currdir <- getCurrentDirectory 	-- Assertion failures throw non-IO errors; catch 	-- any type of error and change back to currdir before 	-- rethrowing.-	r <- bracket_ (changeToTmpDir dir) (setCurrentDirectory currdir)-		(try a::IO (Either SomeException ()))+	r <- bracket_+		(changeToTmpDir dir)+		(setCurrentDirectory currdir)+		(tryNonAsync a) 	case r of-		Right () -> return ()+		Right v -> return v 		Left e -> throwM e++adjustedbranchsupported :: FilePath -> IO Bool+adjustedbranchsupported repo = indir repo $ annexeval Annex.AdjustedBranch.isSupported  setuprepo :: FilePath -> IO FilePath setuprepo dir = do

@@ -269,16 +269,8 @@ 	arbitrary = frequency 		-- timestamp is not usually negative                 [ (50, MTimeLowRes <$> (abs . fromInteger <$> arbitrary))-                , (50, MTimeHighRes <$> (abs <$> arbposixtime))+                , (50, MTimeHighRes <$> arbitrary) 		]-	  where-		-- include fractional part, which the usual instance does not-		arbposixtime = do-			t <- arbitrary-			f <- arbitrary-			return $ if f == 0-				then t-				else t + recip f  #ifdef mingw32_HOST_OS instance Arbitrary FileID where

@@ -6,7 +6,7 @@  -}  {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE TypeSynonymInstances, CPP #-}+{-# LANGUAGE TypeSynonymInstances #-}  module Utility.QuickCheck 	( module X@@ -15,29 +15,23 @@  import Test.QuickCheck as X import Data.Time.Clock.POSIX+import Data.Ratio import System.Posix.Types-#if ! MIN_VERSION_QuickCheck(2,8,2)-import qualified Data.Map as M-import qualified Data.Set as S-#endif-import Control.Applicative import Prelude -#if ! MIN_VERSION_QuickCheck(2,8,2)-instance (Arbitrary k, Arbitrary v, Ord k) => Arbitrary (M.Map k v) where-	arbitrary = M.fromList <$> arbitrary--instance (Arbitrary v, Ord v) => Arbitrary (S.Set v) where-	arbitrary = S.fromList <$> arbitrary-#endif--{- Times before the epoch are excluded, and no fraction is included. -}+{- Times before the epoch are excluded. Half with decimal and half without. -} instance Arbitrary POSIXTime where-	arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral+	arbitrary = do+		n <- nonNegative arbitrarySizedBoundedIntegral :: Gen Int+		d <- nonNegative arbitrarySizedIntegral+		withd <- arbitrary+		return $ if withd+			then fromIntegral n + fromRational (1 % max d 1)+			else fromIntegral n  {- Pids are never negative, or 0. -} instance Arbitrary ProcessID where-	arbitrary = arbitrarySizedBoundedIntegral `suchThat` (> 0)+	arbitrary = positive arbitrarySizedBoundedIntegral  {- Inodes are never negative. -} instance Arbitrary FileID where

@@ -1,5 +1,5 @@ Name: git-annex-Version: 7.20181031+Version: 7.20181105 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -356,7 +356,7 @@    split,    attoparsec,    concurrent-output (>= 1.6),-   QuickCheck (>= 2.1),+   QuickCheck (>= 2.8.2),    tasty (>= 0.7),    tasty-hunit,    tasty-quickcheck,