diff options
author | Joey Hess <joey@kitenet.net> | 2012-10-15 22:22:40 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-10-15 22:22:40 -0400 |
commit | acd55616a7128d42ca191e2978919dfac6e2d1ba (patch) | |
tree | 6d2a6c29f275b000680d108d7b8788cdce03b9d8 | |
parent | 72813114685613f72bc2d7b5d54596c14a5cf0f2 (diff) |
Bug fix: A recent change caused git-annex-shell to crash.
-rw-r--r-- | GitAnnexShell.hs | 1 | ||||
-rw-r--r-- | Utility/Misc.hs | 18 | ||||
-rw-r--r-- | debian/changelog | 1 | ||||
-rw-r--r-- | doc/bugs/Crash_trying_to_sync_with_a_repo_over_ssh.mdwn | 19 | ||||
-rw-r--r-- | test.hs | 2 |
5 files changed, 39 insertions, 2 deletions
diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs index ebe280279..4436ab3e1 100644 --- a/GitAnnexShell.hs +++ b/GitAnnexShell.hs @@ -105,6 +105,7 @@ external params = do -} partitionParams :: [String] -> ([String], [String]) partitionParams params + | null segments = ([], []) | length segments < 2 = (segments !! 0, []) | otherwise = (segments !! 0, segments !! 1) where diff --git a/Utility/Misc.hs b/Utility/Misc.hs index 88d210de6..f03504040 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -40,9 +40,23 @@ firstLine :: String -> String firstLine = takeWhile (/= '\n') {- Splits a list into segments that are delimited by items matching - - a predicate. (The delimiters are not included in the segments.) -} + - a predicate. (The delimiters are not included in the segments.) + - Segments may be empty. -} segment :: (a -> Bool) -> [a] -> [[a]] -segment p = filter (not . all p) . segmentDelim p +segment p l = map reverse $ go [] [] l + where + go c r [] = reverse $ c:r + go c r (i:is) + | p i = go [] (c:r) is + | otherwise = go (i:c) r is + +prop_segment_regressionTest :: Bool +prop_segment_regressionTest = all id + -- Even an empty list is a segment. + [ segment (== "--") [] == [[]] + -- There are two segements in this list, even though the first is empty. + , segment (== "--") ["--", "foo", "bar"] == [[],["foo","bar"]] + ] {- Includes the delimiters as segments of their own. -} segmentDelim :: (a -> Bool) -> [a] -> [[a]] diff --git a/debian/changelog b/debian/changelog index bedea5c05..156993871 100644 --- a/debian/changelog +++ b/debian/changelog @@ -2,6 +2,7 @@ git-annex (3.20121011) UNRELEASED; urgency=low * vicfg: New file format, avoids ambiguity with repos that have the same description, or no description. + * Bug fix: A recent change caused git-annex-shell to crash. -- Joey Hess <joeyh@debian.org> Fri, 12 Oct 2012 22:46:08 -0400 diff --git a/doc/bugs/Crash_trying_to_sync_with_a_repo_over_ssh.mdwn b/doc/bugs/Crash_trying_to_sync_with_a_repo_over_ssh.mdwn index 1df26fc81..38f54d2b6 100644 --- a/doc/bugs/Crash_trying_to_sync_with_a_repo_over_ssh.mdwn +++ b/doc/bugs/Crash_trying_to_sync_with_a_repo_over_ssh.mdwn @@ -22,3 +22,22 @@ I'm on OS X 10.8.2, using GHC 7.6.1. The annex in question has 38G in a few hun Please provide any additional information below. I'm willing to help track this down! + +> I've got it, October 9th's release +> included commit bc649a35bacbecef93e378b1497f6a05b30bf452, which included a +> change to a `segment` function. It was supposed to be a +> rewrite in terms of a more general version, but it introduced a bug +> in what it returned in an edge case and this in turn led git-annex-shell's +> parameter parser to fail in a code path that was never reachable before. +> +> It'd fail both when a new repo was running `git-annex-shell configlist`, +> and in `git-annex-shell commit`, although this latter crash was less +> noticible and I'm sure you saw the former. +> +> Fixed the reversion; fixed insufficient guards around the partial code +> (which I cannot see a way to entirely eliminate sadly; look at +> GitAnnexShell.hs's `partitionParams` and weep or let me know if you have +> any smart ideas..); added a regression test to check the non-obvious +> behavior of segment with an empty segment. I'll be releasing a new +> version with this fix as soon as I have bandwidth, ie tomorrow. +> [[done]] --[[Joey]] @@ -48,6 +48,7 @@ import qualified Build.SysConfig import qualified Utility.Format import qualified Utility.Verifiable import qualified Utility.Process +import qualified Utility.Misc -- for quickcheck instance Arbitrary Types.Key.Key where @@ -91,6 +92,7 @@ quickcheck = TestLabel "quickcheck" $ TestList , qctest "prop_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane , qctest "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane , qctest "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane + , qctest "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest ] blackbox :: Test |