Bug fix: A recent change caused git-annex-shell to crash.
This commit is contained in:
parent
728aba8b02
commit
d430fb1153
5 changed files with 39 additions and 2 deletions
|
@ -105,6 +105,7 @@ external params = do
|
||||||
-}
|
-}
|
||||||
partitionParams :: [String] -> ([String], [String])
|
partitionParams :: [String] -> ([String], [String])
|
||||||
partitionParams params
|
partitionParams params
|
||||||
|
| null segments = ([], [])
|
||||||
| length segments < 2 = (segments !! 0, [])
|
| length segments < 2 = (segments !! 0, [])
|
||||||
| otherwise = (segments !! 0, segments !! 1)
|
| otherwise = (segments !! 0, segments !! 1)
|
||||||
where
|
where
|
||||||
|
|
|
@ -40,9 +40,23 @@ firstLine :: String -> String
|
||||||
firstLine = takeWhile (/= '\n')
|
firstLine = takeWhile (/= '\n')
|
||||||
|
|
||||||
{- Splits a list into segments that are delimited by items matching
|
{- 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 :: (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. -}
|
{- Includes the delimiters as segments of their own. -}
|
||||||
segmentDelim :: (a -> Bool) -> [a] -> [[a]]
|
segmentDelim :: (a -> Bool) -> [a] -> [[a]]
|
||||||
|
|
1
debian/changelog
vendored
1
debian/changelog
vendored
|
@ -2,6 +2,7 @@ git-annex (3.20121011) UNRELEASED; urgency=low
|
||||||
|
|
||||||
* vicfg: New file format, avoids ambiguity with repos that have the same
|
* vicfg: New file format, avoids ambiguity with repos that have the same
|
||||||
description, or no description.
|
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
|
-- Joey Hess <joeyh@debian.org> Fri, 12 Oct 2012 22:46:08 -0400
|
||||||
|
|
||||||
|
|
|
@ -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.
|
Please provide any additional information below.
|
||||||
|
|
||||||
I'm willing to help track this down!
|
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]]
|
||||||
|
|
2
test.hs
2
test.hs
|
@ -48,6 +48,7 @@ import qualified Build.SysConfig
|
||||||
import qualified Utility.Format
|
import qualified Utility.Format
|
||||||
import qualified Utility.Verifiable
|
import qualified Utility.Verifiable
|
||||||
import qualified Utility.Process
|
import qualified Utility.Process
|
||||||
|
import qualified Utility.Misc
|
||||||
|
|
||||||
-- for quickcheck
|
-- for quickcheck
|
||||||
instance Arbitrary Types.Key.Key where
|
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_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane
|
||||||
, qctest "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane
|
, qctest "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane
|
||||||
, qctest "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane
|
, qctest "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane
|
||||||
|
, qctest "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest
|
||||||
]
|
]
|
||||||
|
|
||||||
blackbox :: Test
|
blackbox :: Test
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue