Bug fix: A recent change caused git-annex-shell to crash.

This commit is contained in:
Joey Hess 2012-10-15 22:22:40 -04:00
parent 728aba8b02
commit d430fb1153
5 changed files with 39 additions and 2 deletions

View file

@ -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

View file

@ -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]]

1
debian/changelog vendored
View file

@ -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

View file

@ -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]]

View file

@ -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