diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs index ebe2802798..4436ab3e1e 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 88d210de66..f03504040f 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 bedea5c055..156993871e 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 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 1df26fc810..38f54d2b61 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]] diff --git a/test.hs b/test.hs index 2417f681bb..875668b869 100644 --- a/test.hs +++ b/test.hs @@ -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