Sun Jan 27 16:29:31 GMT 2008 Eric Kow <[EMAIL PROTECTED]>
* Make documentation on dates more explicit.
Sun Jan 27 16:30:40 GMT 2008 Eric Kow <[EMAIL PROTECTED]>
* Overhaul date parsing code.
- Add the ability to match on partial ISO 8601 dates, for example,
treating 2008-08 as matching the whole month and not just the
first day of that month
- Fix some bugs in the parsing of fancy English dates
- Fix bugs in the interpretation of English dates (for example,
the interpretation of '3 days before last week' was for all
patches since that date, and not for all patches *on* that
date)
- Treat user input as being in the local timezone
- Make the matching code a bit more compact
Sun Jan 27 16:42:41 GMT 2008 Eric Kow <[EMAIL PROTECTED]>
* Support more interactive use of echo_to_darcs in test harness.
Sun Jan 27 16:42:54 GMT 2008 Eric Kow <[EMAIL PROTECTED]>
* More aggressive testing of date parser.
Using record --pipe to set patch dates.
Mon Jan 28 11:52:14 GMT 2008 Eric Kow <[EMAIL PROTECTED]>
* Simplify date matcher and fix tz-related bug.
When matching partial dates, we should not trust the ctYear, etc on the
CalendarTime because it may vary by timezone. This also leads to a
simplification in the tentative date matching.
Note: subtle change in matching. Now all matching is done
within a range, excluding the latter date. We check
date < end
instead of date <= end
Mon Jan 28 11:53:07 GMT 2008 Eric Kow <[EMAIL PROTECTED]>
* Remove TimeDiff experiment.
New patches:
[Make documentation on dates more explicit.
Eric Kow <[EMAIL PROTECTED]>**20080127162931] hunk ./src/Darcs/Patch/Match.lhs 117
-Note that you may also specify intervals, either in a small subset of English or
+Notes: when matching on the ISO format, a partial date is treated as a range.
+English dates can either refer to a specific day (``6 months ago',``day before
+yesterday''), or to an interval
+from some past date (``last month'') to the present. Putting this all
+together, if today is ``2004-07-24'' then the following matches should work:
+
+\begin{tabular}{|ll|}
+\hline
+\textbf{date} & \textbf{patches selected} \\
+\hline
+2004 & from 2004-01-01 up to and including 2004-12-31 \\
+2004-01 & from 2004-01-01 up to and including 2004-01-31 \\
+2004-01-01 & during 2004-01-01 \\
+\hline
+today & during 2004-07-24 (starting midnight in your timezone) \\
+yesterday & during 2004-07-23 \\
+6 months ago & during 2004-01-23 \\
+\hline
+last 6 months & since 2004-01-23 \\
+last month & since 2004-06-23 (not 2004-06-01!) \\
+last week & since 2004-07-16 \\
+\hline
+\end{tabular}
+
+For more precise control, you may specify an interval, either
+in a small subset of English or
[Overhaul date parsing code.
Eric Kow <[EMAIL PROTECTED]>**20080127163040
- Add the ability to match on partial ISO 8601 dates, for example,
treating 2008-08 as matching the whole month and not just the
first day of that month
- Fix some bugs in the parsing of fancy English dates
- Fix bugs in the interpretation of English dates (for example,
the interpretation of '3 days before last week' was for all
patches since that date, and not for all patches *on* that
date)
- Treat user input as being in the local timezone
- Make the matching code a bit more compact
] {
hunk ./src/DateMatcher.lhs 23
+import Data.Maybe ( isJust )
hunk ./src/DateMatcher.lhs 25
-import IsoDate ( parseDate, englishDateTime, englishInterval, iso8601_interval,
- subtractFromCal, getLocalTz )
+import IsoDate ( parseDate, englishDateTime, englishInterval, englishLast, iso8601_interval,
+ resetCalendar, subtractFromMCal, getLocalTz,
+ MCalendarTime(..), toMCalendarTime, unsafeToCalendarTime,
+ resetMCalendar, unsetTime,
+ )
hunk ./src/DateMatcher.lhs 33
-sameDate :: CalendarTime -> CalendarTime -> Bool
-sameDate a b = (ctDay a == 0 || ctDay b == 0 || ctDay a == ctDay b) &&
- (ctPicosec a == 1 || ctPicosec b == 1 || ctMonth a == ctMonth b) &&
- ctYear a == ctYear b
+-- note that we avoid comparing the fields ctYear, etc directly
+-- because we want to avoid timezone-related issues (our
+-- two dates may not be in the same zone), so we want to normalise
+-- for that
+withinDay :: CalendarTime -> CalendarTime -> Bool
+withinDay a b = withinIncExc (toClockTime a)
+ (addToClockTime day $ toClockTime a)
+ (toClockTime b)
+ where day = TimeDiff 0 0 1 0 0 0 0
hunk ./src/DateMatcher.lhs 43
-dateRange :: CalendarTime -> CalendarTime -> CalendarTime -> Bool
-dateRange a b c = a <= c && b >= c
+dateRange :: MCalendarTime -> MCalendarTime -> CalendarTime -> Bool
+dateRange a b c = cDateRange (unsafeToCalendarTime a) (unsafeToCalendarTime b) c
+
+cDateRange :: CalendarTime -> CalendarTime -> CalendarTime -> Bool
+cDateRange a b c = withinIncInc (toClockTime a) (toClockTime b) (toClockTime c)
+
+withinIncInc, withinIncExc :: ClockTime -> ClockTime -> ClockTime -> Bool
+withinIncInc a b c = a <= c && b >= c
+withinIncExc a b c = a <= c && b > c
+
+data DateMatchResult =
+ NoMatch
+ | Match
+ | TentativeMatch Bool
+
+infixl 1 |>>=|
+(|>>=|) :: DateMatchResult -> (Bool -> DateMatchResult) -> DateMatchResult
+NoMatch |>>=| _ = NoMatch
+Match |>>=| _ = Match
+TentativeMatch next |>>=| x = x next
+
+isMatch :: DateMatchResult -> Bool
+-- we don't care about the next test, because it's only meant to
+-- be run if the next segment is missing from the date
+isMatch (TentativeMatch _) = True
+isMatch Match = True
+isMatch _ = False
+
+-- either the same exact date, or within a range
+-- we make the simplifying assumption that, for example, if the
+-- month is unset, so is the day of month
+samePartialDate :: MCalendarTime -> CalendarTime -> Bool
+samePartialDate a_ b_ = isMatch $
+ case () of
+ _ | mctWeek a -> TentativeMatch True
+ |>>=| check mctYear ctYear (spanMatch year)
+ |>>=| checkWeek
+ | isJust (mctYDay a) -> TentativeMatch True
+ |>>=| check mctYear ctYear (spanMatch year)
+ |>>=| check mctYDay ctYDay (spanMatch day)
+ | otherwise -> TentativeMatch True
+ |>>=| check mctYear ctYear (spanMatch year)
+ |>>=| check mctMonth ctMonth (spanMatch month)
+ |>>=| check mctDay ctDay (spanMatch day)
+ where
+ -- if the field in question is unset, try the range match and stop
+ -- otherwise, make ure it matches and move on
+ check afn bfn nextR previousR =
+ case afn a of
+ Nothing -> if previousR then Match
+ else NoMatch
+ Just ax -> if ax == bfn calB
+ then TentativeMatch nextR
+ else NoMatch
+ checkWeek _ =
+ let s = case mctWDay a of Nothing -> week
+ Just _ -> day
+ in if spanMatch s then TentativeMatch True else NoMatch
+ year = TimeDiff 1 0 0 0 0 0 0
+ month = TimeDiff 0 1 0 0 0 0 0
+ week = TimeDiff 0 0 7 0 0 0 0
+ day = TimeDiff 0 0 1 0 0 0 0
+ -- notice the subtle > vs >= distinction wrt dateRange
+ spanMatch sp = withinIncExc clockA (addToClockTime sp clockA) (toClockTime calB)
+ a = resetMCalendar a_
+ clockA = toClockTime $ unsafeToCalendarTime a
+ calB = resetCalendar b_
hunk ./src/DateMatcher.lhs 114
+ let midnightToday = unsetTime rightNow
+ mRightNow = toMCalendarTime rightNow
hunk ./src/DateMatcher.lhs 117
- let parseToEof p = parse $ do { x <- p; eof; return x }
- --
- tryEnglishDateOr next =
- case parseToEof (englishDateTime rightNow) "" d of
- Right ed -> dateRange ed rightNow
- _ -> next
- --
- tryEnglishIntervalOr next =
- case parseToEof (englishInterval rightNow) "" d of
- Right (a,b) -> dateRange a b
- _ -> next
- --
- tryISOIntervalOr next =
- case parseToEof (iso8601_interval 0) "" d of
- Right (Left dur) -> dateRange (dur `subtractFromCal` rightNow) rightNow
- Right (Right (a,b)) -> dateRange a b
- _ -> next
- --
- tryDateOr next =
- case parseDate tzNow d of
- Right ct -> sameDate ct
- _ -> next
- let matcher = tryEnglishIntervalOr $ tryEnglishDateOr
- $ tryISOIntervalOr $ tryDateOr
- $ error "Can't support fancy dates."
+ let -- note that the order of these is quite important as some matchers
+ -- can match the same date.
+ thingsToTry =
+ [ tryOr (englishLast midnightToday) (\(a,_) -> cDateRange a rightNow)
+ , tryOr (englishDateTime midnightToday) withinDay
+ , tryOr (englishInterval rightNow) (uncurry cDateRange)
+ , tryOr (iso8601_interval tzNow) matchIsoInterval
+ , tryDateOr ]
+ tryOr p m next = either (const next) m $
+ parse (tillEof p) "" d
+ tryDateOr next = either (const next) (samePartialDate) $
+ parseDate tzNow d
+ matchIsoInterval (Left dur) = dateRange (dur `subtractFromMCal` mRightNow) mRightNow
+ matchIsoInterval (Right (a,b)) = dateRange a b
+ let matcher = foldr ($) (error "Can't support fancy dates.") thingsToTry
hunk ./src/DateMatcher.lhs 141
- where catchUserError = catchJust userErrors
-
+ where
+ catchUserError = catchJust userErrors
+ tillEof p = do { x <- p; eof; return x }
hunk ./src/DateMatcher.lhs 146
-now = toUTCTime `liftM` getClockTime
+now = getClockTime >>= toCalendarTime
hunk ./src/IsoDate.lhs 23
- englishDateTime, englishInterval,
+ englishDateTime, englishInterval, englishLast,
hunk ./src/IsoDate.lhs 26
- showIsoDateTime, cleanLocalDate ) where
+ showIsoDateTime, cleanLocalDate, resetCalendar,
+ MCalendarTime(..), subtractFromMCal, addToMCal,
+ nullMCalendar, toMCalendarTime, unsafeToCalendarTime,
+ resetMCalendar, unsetTime,
+ ) where
hunk ./src/IsoDate.lhs 36
+import Data.Maybe ( fromMaybe )
hunk ./src/IsoDate.lhs 59
-cleanDate tz d = showIsoDateTime.toUTCTime.toClockTime $ readDate tz d
+cleanDate tz d = showIsoDateTime.resetCalendar $ readDate tz d
hunk ./src/IsoDate.lhs 65
- Right ct -> ct
+ Right ct -> resetCalendar $ unsafeToCalendarTime ct
hunk ./src/IsoDate.lhs 67
-parseDate :: Int -> String -> Either String CalendarTime
+parseDate :: Int -> String -> Either String MCalendarTime
hunk ./src/IsoDate.lhs 70
- then Right $
+ then Right $ toMCalendarTime $
hunk ./src/IsoDate.lhs 132
-date_time :: Int -> CharParser a CalendarTime
+date_time :: Int -> CharParser a MCalendarTime
hunk ./src/IsoDate.lhs 134
- choice [try $ cvs_date_time tz,
+ choice [try $ toMCalendarTime `fmap` cvs_date_time tz,
hunk ./src/IsoDate.lhs 136
- old_date_time]
+ toMCalendarTime `fmap` old_date_time]
hunk ./src/IsoDate.lhs 189
-iso8601_date_time :: Int -> CharParser a CalendarTime
+iso8601_date_time :: Int -> CharParser a MCalendarTime
hunk ./src/IsoDate.lhs 194
- return $ t $ d { ctTZ = localTz }
+ return $ t $ d { mctTZ = Just localTz }
hunk ./src/IsoDate.lhs 196
-iso8601_date :: CharParser a CalendarTime
+iso8601_date :: CharParser a MCalendarTime
hunk ./src/IsoDate.lhs 199
- return $ foldr ($) nullCalendar d
+ return $ foldr ($) nullMCalendar d
hunk ./src/IsoDate.lhs 212
- wd <- option 1 $ do { optional dash; n_digits 1 }
- let y = yfn nullCalendar
+ mwd <- option Nothing $ do { optional dash; Just `fmap` n_digits 1 }
+ let y = resetCalendar . unsafeToCalendarTime . yfn $ nullMCalendar { mctDay = Just 1 }
hunk ./src/IsoDate.lhs 222
- diff c = c { ctDay = (7 * w) + wd - (fromEnum firstDay) }
- return [(toUTCTime.toClockTime.diff.yfn)]
+ yday = (7 * w) + fromMaybe 1 mwd
+ diff c = c { mctWeek = True
+ , mctWDay = toEnum `fmap` mwd
+ , mctDay = Just yday }
+ return [(diff.yfn)]
hunk ./src/IsoDate.lhs 231
- return $ \c -> c { ctYear = y }
+ return $ \c -> c { mctYear = Just y }
hunk ./src/IsoDate.lhs 233
- -- we (artificially) use ctPicosec to indicate
- -- whether the month has been specified.
- return $ \c -> c { ctMonth = intToMonth m, ctPicosec = 0 }
+ return $ \c -> c { mctMonth = Just $ intToMonth m }
hunk ./src/IsoDate.lhs 235
- return $ \c -> c { ctDay = d }
- yearDay_ = try $ do d <- n_digits 3 <?> "day in year (1 to 366)"
- return $ \c -> c { ctYDay = d }
+ return $ \c -> c { mctDay = Just d }
+ yearDay_ = try $ do d <- n_digits 3 <?> "day in year (001 to 366)"
+ return $ \c -> c { mctDay = Just d
+ , mctYDay = Just (d - 1) }
hunk ./src/IsoDate.lhs 242
-iso8601_time :: CharParser a (CalendarTime -> CalendarTime)
+iso8601_time :: CharParser a (MCalendarTime -> MCalendarTime)
hunk ./src/IsoDate.lhs 251
- return $ \c -> c { ctHour = h }
+ return $ \c -> c { mctHour = Just h }
hunk ./src/IsoDate.lhs 253
- return $ \c -> c { ctMin = m }
+ return $ \c -> c { mctMin = Just m }
hunk ./src/IsoDate.lhs 255
- return $ \c -> c { ctSec = s }
+ return $ \c -> c { mctSec = Just s }
hunk ./src/IsoDate.lhs 262
- return $ \c -> c { ctPicosec = frac }
- zulu = do { char 'Z'; return (\c -> c { ctTZ = 0 }) }
+ return $ \c -> c { mctPicosec = Just $ frac }
+ zulu = do { char 'Z'; return (\c -> c { mctTZ = Just 0 }) }
hunk ./src/IsoDate.lhs 268
- return $ \c -> c { ctTZ = sign * 60 * ((h*60)+m) }
+ return $ \c -> c { mctTZ = Just $ sign * 60 * ((h*60)+m) }
hunk ./src/IsoDate.lhs 271
-iso8601_interval :: Int -> CharParser a (Either TimeDiff (CalendarTime, CalendarTime))
+iso8601_interval :: Int -> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
hunk ./src/IsoDate.lhs 278
- Just e -> Right (dur `subtractFromCal` e, e)
+ Just e -> Right (dur `subtractFromMCal` e, e)
hunk ./src/IsoDate.lhs 284
- Left dur -> Right (start, dur `addToCal` start)
+ Left dur -> Right (start, dur `addToMCal` start)
hunk ./src/IsoDate.lhs 427
- return $ case t of Nothing -> ed
- Just tfn -> (tfn.timeless) ed
+ return $ fromMaybe id t $ ed
hunk ./src/IsoDate.lhs 434
- return $ t $ timeless ed
- timeless x = x { ctHour = 0, ctMin = 0, ctSec = 0, ctPicosec = 0 }
+ return $ t $ unsetTime $ ed
hunk ./src/IsoDate.lhs 436
-englishDate :: CalendarTime -> CharParser a CalendarTime
+englishDate :: CalendarTime -> CharParser a CalendarTime
hunk ./src/IsoDate.lhs 438
- (caseString "today" >> (return now))
+ (caseString "today" >> (return $ resetCalendar now))
hunk ./src/IsoDate.lhs 440
- <|> englishLast now
- where oneDay = TimeDiff 0 0 1 0 0 0 0
+ <|> fst `fmap` englishLast now
+ <|> englishAgo now
+ where oneDay = TimeDiff 0 0 0 24 0 0 0
hunk ./src/IsoDate.lhs 444
-englishLast :: CalendarTime -> CharParser a CalendarTime
-englishLast now =
- -- last year, last week, last 3 years, etc
- (try $ do caseString "last"
- space
- d <- englishDuration
- return $ d `subtractFromCal` now
- )
- <|> -- 4 months ago, 1 day ago, day before yesterday
- (try $ do p <- englishDuration
- try $ do space
- (m,ref) <- (try $ caseString "ago" >> return ((-1), now))
- <|> do m <- beforeMod <|> afterMod
- space
- d <- (englishDate now) <|> iso8601_date
- return (m,d)
- return $ (multiplyDiff m p) `addToCal` ref
- )
- where
+englishAgo :: CalendarTime -> CharParser a CalendarTime
+englishAgo now =
+ -- 4 months ago, 1 day ago, day before yesterday
+ try $ do p <- englishDuration
+ try $ do space
+ (m,ref) <- (try $ caseString "ago" >> return ((-1), now))
+ <|> do m <- beforeMod <|> afterMod
+ space
+ d <- englishDate now
+ <|> fst `fmap` englishLast now
+ <|> unsafeToCalendarTime `fmap` iso8601_date
+ return (m,d)
+ return $ multiplyDiff m p `addToCal` ref
+ where
hunk ./src/IsoDate.lhs 459
- afterMod = try $ caseString "after" >> return (-1)
+ afterMod = try $ caseString "after" >> return 1
hunk ./src/IsoDate.lhs 461
-
-englishInterval :: CalendarTime -> CharParser a (CalendarTime, CalendarTime)
+englishInterval :: CalendarTime -> CharParser a (CalendarTime, CalendarTime)
hunk ./src/IsoDate.lhs 464
- englishDT = (iso8601_date_time (ctTZ now) <|> englishDateTime now)
+ englishDT = (unsafeToCalendarTime `fmap` iso8601_date_time (ctTZ now)
+ <|> englishDateTime now)
hunk ./src/IsoDate.lhs 470
- return (nullCalendar, end)
+ return (unsafeToCalendarTime nullMCalendar, end)
hunk ./src/IsoDate.lhs 490
- lastetc = try $ do ct <- englishLast now
- return (ct, now)
+ lastetc =
+ do l <- englishAgo now
+ return (l, now)
+
+englishLast :: CalendarTime -> CharParser a (CalendarTime, CalendarTime)
+englishLast now =
+ -- last year, last week, last 3 years, etc
+ try $ do caseString "last"
+ space
+ d <- englishDuration
+ return (d `subtractFromCal` now, now)
hunk ./src/IsoDate.lhs 504
- choice [ iso8601_time
+ choice [ wrapM `fmap` iso8601_time
hunk ./src/IsoDate.lhs 512
- return $ \c -> c { ctHour = h, ctMin = m }
+ return $ \c -> c { ctHour = h, ctMin = m }
+ wrapM f = unsafeToCalendarTime . f . toMCalendarTime
hunk ./src/IsoDate.lhs 539
+-- | See 'System.Time.CalendarTime', but note the following new fields:
+-- 'mctWeek'
+data MCalendarTime = MCalendarTime
+ { mctYear :: Maybe Int
+ , mctMonth :: Maybe Month
+ , mctDay :: Maybe Int
+ , mctHour :: Maybe Int
+ , mctMin :: Maybe Int
+ , mctSec :: Maybe Int
+ , mctPicosec :: Maybe Integer
+ , mctWDay :: Maybe Day
+ , mctYDay :: Maybe Int
+ , mctTZName :: Maybe String
+ , mctTZ :: Maybe Int
+ , mctIsDST :: Maybe Bool
+ , mctWeek :: Bool -- is set or not
+} deriving Show
+
+toMCalendarTime :: CalendarTime -> MCalendarTime
+toMCalendarTime (CalendarTime a b c d e f g h i j k l) =
+ MCalendarTime (Just a) (Just b) (Just c) (Just d) (Just e) (Just f)
+ (Just g) (Just h) (Just i) (Just j) (Just k) (Just l)
+ False
+
+-- | Unsafe in that it plugs in default values for unset fields.
+-- See also 'resetCalendar'
+unsafeToCalendarTime :: MCalendarTime -> CalendarTime
+unsafeToCalendarTime m =
+ CalendarTime
+ { ctYear = fromMaybe 0 $ mctYear m
+ , ctMonth = fromMaybe January $ mctMonth m
+ , ctDay = fromMaybe 1 $ mctDay m
+ , ctHour = fromMaybe 0 $ mctHour m
+ , ctMin = fromMaybe 0 $ mctMin m
+ , ctSec = fromMaybe 0 $ mctSec m
+ , ctPicosec = fromMaybe 0 $ mctPicosec m
+ , ctWDay = fromMaybe Sunday $ mctWDay m
+ , ctYDay = fromMaybe 0 $ mctYDay m
+ , ctTZName = fromMaybe "" $ mctTZName m
+ , ctTZ = fromMaybe 0 $ mctTZ m
+ , ctIsDST = fromMaybe False $ mctIsDST m
+ }
+
hunk ./src/IsoDate.lhs 588
+addToMCal :: TimeDiff -> MCalendarTime -> MCalendarTime
+addToMCal td mc =
+ copyCalendar (addToCal td $ unsafeToCalendarTime mc) mc
+
+subtractFromMCal :: TimeDiff -> MCalendarTime -> MCalendarTime
+subtractFromMCal = addToMCal . multiplyDiff (-1)
+
hunk ./src/IsoDate.lhs 604
-nullCalendar :: CalendarTime
-nullCalendar = CalendarTime 0 January 0 0 0 0 1 Sunday 0 "" 0 False
+nullMCalendar :: MCalendarTime
+nullMCalendar = MCalendarTime Nothing Nothing Nothing Nothing Nothing Nothing
+ Nothing Nothing Nothing Nothing Nothing Nothing
+ False
+
+-- | set a calendar to UTC time any eliminate any inconsistencies within
+-- (for example, where the weekday is given as "Thursday", but this does not
+-- match what the numerical date would lead one to expect)
+resetCalendar :: CalendarTime -> CalendarTime
+resetCalendar = toUTCTime . toClockTime
+
+copyCalendar :: CalendarTime -> MCalendarTime -> MCalendarTime
+copyCalendar c mc = mc
+ { mctYear = mctYear mc >> Just (ctYear c)
+ , mctMonth = mctMonth mc >> Just (ctMonth c)
+ , mctDay = mctDay mc >> Just (ctDay c)
+ , mctHour = mctHour mc >> Just (ctHour c)
+ , mctMin = mctMin mc >> Just (ctMin c)
+ , mctSec = mctSec mc >> Just (ctSec c)
+ , mctPicosec = mctPicosec mc >> Just (ctPicosec c)
+ , mctWDay = mctWDay mc >> Just (ctWDay c)
+ , mctYDay = mctYDay mc >> Just (ctYDay c)
+ , mctTZName = mctTZName mc >> Just (ctTZName c)
+ , mctTZ = mctTZ mc >> Just (ctTZ c)
+ , mctIsDST = mctIsDST mc >> Just (ctIsDST c)
+ }
+
+unsetTime :: CalendarTime -> CalendarTime
+unsetTime mc = mc
+ { ctHour = 0
+ , ctMin = 0
+ , ctSec = 0
+ , ctPicosec = 0
+ }
+
+
+resetMCalendar :: MCalendarTime -> MCalendarTime
+resetMCalendar mc = copyCalendar c mc
+ where c = resetCalendar . unsafeToCalendarTime $ mc
}
[Support more interactive use of echo_to_darcs in test harness.
Eric Kow <[EMAIL PROTECTED]>**20080127164241] {
hunk ./tests/amend-record.pl 21
-like( echo_to_darcs("y","amend-record -a foo"), qr/amending changes/i, 'amend-record -a');
+like( echo_to_darcs("amend-record -a foo","y"), qr/amending changes/i, 'amend-record -a');
hunk ./tests/amend-record.pl 38
-like( echo_to_darcs("y","amend-record -a"), qr/finished amending/i, 'amend-record removed file');
+like( echo_to_darcs("amend-record -a","y"), qr/finished amending/i, 'amend-record removed file');
hunk ./tests/amend-record.pl 47
-like( echo_to_darcs("y","amend -a foo"), qr/amending changes/i, 'amend makes empty patch');
+like( echo_to_darcs("amend -a foo","y"), qr/amending changes/i, 'amend makes empty patch');
hunk ./tests/amend-record.pl 52
-like( echo_to_darcs("y","amend -a -m new_name foo"), qr/amending changes/i, 'amend');
+like( echo_to_darcs("amend -a -m new_name foo","y"), qr/amending changes/i, 'amend');
hunk ./tests/amend-record.pl 57
-like( echo_to_darcs("y","amend -a -m new_name -A new_author foo"), qr/amending changes/i, 'amend');
+like( echo_to_darcs("amend -a -m new_name -A new_author foo","y"), qr/amending changes/i, 'amend');
hunk ./tests/lib/perl/Test/Darcs.pm 119
- my($input, $command) = @_;
+ my $command = shift;
+ my $first_input = shift;
+ my @rest_of_input = @_;
hunk ./tests/lib/perl/Test/Darcs.pm 132
- print WRITE "$input";
+ print WRITE "$first_input";
+ for my $i (@rest_of_input) {
+ print WRITE "\n$i";
+ }
hunk ./tests/obliterate.pl 23
- echo_to_darcs("an","obliterate -p add"),
+ echo_to_darcs("obliterate -p add","an"),
hunk ./tests/obliterate.pl 28
- echo_to_darcs("n","obliterate --last 1"),
+ echo_to_darcs("obliterate --last 1","n"),
hunk ./tests/obliterate.pl 39
- echo_to_darcs("n","obliterate -p 'adding a'"),
+ echo_to_darcs("obliterate -p 'adding a'","n"),
hunk ./tests/pull.pl 108
- like(echo_to_darcs("", "rollback -p CC -a -m unC "), qr/Finished rolling back/);
+ like(echo_to_darcs("rollback -p CC -a -m unC ",""), qr/Finished rolling back/);
hunk ./tests/pull.pl 114
- like(echo_to_darcs("", "rollback -p BB -a -m unB "), qr/Finished rolling back/);
+ like(echo_to_darcs("rollback -p BB -a -m unB ",""), qr/Finished rolling back/);
hunk ./tests/record.pl 28
- like( echo_to_darcs('a', "record -am foo --ask-deps"), qr/finished recording/i, $test_name) ;
+ like( echo_to_darcs("record -am foo --ask-deps",'a'), qr/finished recording/i, $test_name) ;
hunk ./tests/unpull.pl 22
- echo_to_darcs("an","unpull -p add"),
+ echo_to_darcs("unpull -p add","an"),
hunk ./tests/unpull.pl 27
- echo_to_darcs("n","unpull --last 1"),
+ echo_to_darcs("unpull --last 1","n"),
hunk ./tests/unpull.pl 38
- echo_to_darcs("n","unpull -p 'adding a'"),
+ echo_to_darcs("unpull -p 'adding a'","n"),
}
[More aggressive testing of date parser.
Eric Kow <[EMAIL PROTECTED]>**20080127164254
Using record --pipe to set patch dates.
] {
hunk ./tests/match.pl 12
-# matching by date
-
-init_tmp_repo();
-
-touch 'bar';
-darcs 'add bar';
-darcs 'record -a -m "" bar';
-
-
-# date matching doesn't yet support different time zones
-$ENV{TZ} = "UTC";
+# predeclare some subs so we can use them without parens.
+sub reset_repo;
+sub create_entry;
+sub match_date;
+sub nomatch_date;
+sub parse_date;
hunk ./tests/match.pl 19
+# matching by date
+reset_repo();
+create_entry( "1973-02-04 15:08Z" );
hunk ./tests/match.pl 33
-# predeclare some subs so we can use them without parens.
-sub match_date;
-sub nomatch_date;
-sub parse_date;
-
-# the comments about dates being the same are meant for some brave soul
-# willing to implement more semantic tests
-
hunk ./tests/match.pl 44
-# week dates. note that 2007 was tactically selected as it starts on Monday
-parse_date '2007-W01-1';
-parse_date '2007W011';
-parse_date '2007-W01';
+# week dates. note that 2007 was selected as it starts on Monday
+reset_repo();
+create_entry "2007-01-04 15:00";
+match_date '2007-W01-4';
+nomatch_date '2007-W01-1';
+match_date '2007W014';
+match_date '2007-W01';
+nomatch_date '2007-W02-1';
+create_entry "2007-01-08 15:00";
+match_date '2007-W02';
+match_date '2007-W02-1';
+create_entry "2007-05-20 15:00";
+match_date '2007-W23';
hunk ./tests/match.pl 58
-parse_date '2007-001'; # first day of 2005
-parse_date '2007001';
+match_date '2007-004'; # fourth day of 2007
+match_date '2007004';
+nomatch_date '2007-005';
hunk ./tests/match.pl 63
-parse_date '1992-10-14 24:00';
-parse_date '1992-10-15 00:00';
+reset_repo();
+create_entry "1992-10-15 00:00";
+match_date '1992-10-14 24:00';
+match_date '1992-10-15 00:00';
hunk ./tests/match.pl 69
-parse_date '1992-02-12T22:32:11';
-parse_date '1992-02-12 22:32:11';
-parse_date '1992-02-12T223211.0000';
+reset_repo();
+create_entry "1992-02-12T22:32:11";
+match_date '1992-02-12T22:32:11';
+match_date '1992-02-12 22:32:11';
+match_date '1992-02-12T223211.0000';
hunk ./tests/match.pl 76
-
-#FIXME: today and yesterday behave poorly, because they don't work in the
-#current time zone, but rather in UTC! :(
-
-#match_date 'today';
-#nomatch_date 'yesterday';
-parse_date 'today';
-parse_date 'yesterday';
-parse_date 'day before yesterday';
+reset_repo();
+create_entry_now();
+$raw_date = get_first_date_from_changes();
+($mon,$mm,$dd,$year,$hhmmss,$tz) = deconstruct_date( $raw_date );
+reset_repo();
+create_entry(($year-1)."$mm-$dd");
+nomatch_date 'today';
+nomatch_date 'yesterday';
+nomatch_date 'day before yesterday';
+nomatch_date 'last week';
+nomatch_date 'last month';
+# note: this test might fail if you run it just before midnight
+reset_repo();
+create_entry_now();
+match_date 'today';
+nomatch_date 'yesterday';
+nomatch_date 'day before yesterday';
hunk ./tests/match.pl 96
+reset_repo();
+create_entry(($year-1)."-$mm-$dd");
hunk ./tests/match.pl 99
-parse_date 'yesterday at 14:00:00';
+nomatch_date 'yesterday at 14:00:00';
hunk ./tests/match.pl 101
-match_date '2 days ago';
-parse_date 'last month 13:00' ;
-parse_date '15 minutes after 1992-10-02';
-match_date '3 days before last week';
+match_date 'last year';
+nomatch_date '2 days ago';
+nomatch_date 'last month 13:00' ;
+nomatch_date '3 days before last week';
+reset_repo();
+create_entry_now();
+match_date 'day after yesterday';
+match_date 'week after last week';
+create_entry("1992-10-02 00:15");
+match_date '15 minutes after 1992-10-02';
hunk ./tests/match.pl 114
+match_date 'between last fortnight and today';
hunk ./tests/match.pl 119
-parse_date '1992-10-15 00:00Z/1992-10-15 00:01Z';
+parse_date '1992-10-02 00:00Z/1992-10-02 00:16Z';
+match_date '1992-10-02 00:00/1992-10-02 00:16';
+match_date 'between 1992-10-02 00:00 and 1992-10-12 00:16';
hunk ./tests/match.pl 127
+reset_repo();
+create_entry_now();
hunk ./tests/match.pl 133
-#FIXME: the following is a bug.
-#nomatch_date '3 days before last year at 17:00';
-parse_date '3 days before last year at 17:00';
+nomatch_date '3 days before last year at 17:00';
hunk ./tests/match.pl 330
+sub reset_repo {
+ init_tmp_repo();
+ touch 'bar';
+ darcs 'add bar';
+}
+
+sub create_entry_now {
+ open BAR,">>bar";
+ print BAR "today\n";
+ close BAR;
+ darcs('record -a -m "" bar');
+}
+
+sub create_entry {
+ my ($date) = shift;
+ open BAR,">>bar";
+ print BAR "$date\n";
+ close BAR;
+ echo_to_darcs('record -m "" --pipe bar',"$date","tester","a","","");
+}
+
+
+
}
[Simplify date matcher and fix tz-related bug.
Eric Kow <[EMAIL PROTECTED]>**20080128115214
When matching partial dates, we should not trust the ctYear, etc on the
CalendarTime because it may vary by timezone. This also leads to a
simplification in the tentative date matching.
Note: subtle change in matching. Now all matching is done
within a range, excluding the latter date. We check
date < end
instead of date <= end
] {
hunk ./src/DateMatcher.lhs 38
-withinDay a b = withinIncExc (toClockTime a)
- (addToClockTime day $ toClockTime a)
- (toClockTime b)
+withinDay a b = within (toClockTime a)
+ (addToClockTime day $ toClockTime a)
+ (toClockTime b)
hunk ./src/DateMatcher.lhs 47
-cDateRange a b c = withinIncInc (toClockTime a) (toClockTime b) (toClockTime c)
+cDateRange a b c = within (toClockTime a) (toClockTime b) (toClockTime c)
hunk ./src/DateMatcher.lhs 49
-withinIncInc, withinIncExc :: ClockTime -> ClockTime -> ClockTime -> Bool
-withinIncInc a b c = a <= c && b >= c
-withinIncExc a b c = a <= c && b > c
+within :: ClockTime -> ClockTime -> ClockTime -> Bool
+within a b c = a <= c && b > c
hunk ./src/DateMatcher.lhs 52
-data DateMatchResult =
- NoMatch
- | Match
- | TentativeMatch Bool
+data DateMatchResult = NoMatch | Match | TentativeMatch
hunk ./src/DateMatcher.lhs 54
-infixl 1 |>>=|
-(|>>=|) :: DateMatchResult -> (Bool -> DateMatchResult) -> DateMatchResult
-NoMatch |>>=| _ = NoMatch
-Match |>>=| _ = Match
-TentativeMatch next |>>=| x = x next
+infixl 1 |>>|
+(|>>|) :: DateMatchResult -> DateMatchResult -> DateMatchResult
+NoMatch |>>| _ = NoMatch
+Match |>>| _ = Match
+TentativeMatch |>>| x = x
hunk ./src/DateMatcher.lhs 63
-isMatch (TentativeMatch _) = True
+isMatch TentativeMatch = True
hunk ./src/DateMatcher.lhs 71
-samePartialDate a_ b_ = isMatch $
- case () of
- _ | mctWeek a -> TentativeMatch True
- |>>=| check mctYear ctYear (spanMatch year)
- |>>=| checkWeek
- | isJust (mctYDay a) -> TentativeMatch True
- |>>=| check mctYear ctYear (spanMatch year)
- |>>=| check mctYDay ctYDay (spanMatch day)
- | otherwise -> TentativeMatch True
- |>>=| check mctYear ctYear (spanMatch year)
- |>>=| check mctMonth ctMonth (spanMatch month)
- |>>=| check mctDay ctDay (spanMatch day)
+samePartialDate a_ b_ =
+ isMatch $ check mctYear year
+ |>>| checkDay
hunk ./src/DateMatcher.lhs 75
- -- if the field in question is unset, try the range match and stop
- -- otherwise, make ure it matches and move on
- check afn bfn nextR previousR =
- case afn a of
- Nothing -> if previousR then Match
- else NoMatch
- Just ax -> if ax == bfn calB
- then TentativeMatch nextR
+ checkDay
+ | mctWeek a = checkWeek
+ | isJust (mctYDay a) = check mctYDay day
+ | otherwise = check mctMonth month |>>| check mctDay day
+ -- if the field in question is unset, we assume it's a match
+ -- (that the previous matcher had succeeeded)
+ check field duration =
+ case field a of
+ Nothing -> Match
+ Just _ -> if spanMatch duration
+ then TentativeMatch
hunk ./src/DateMatcher.lhs 87
- checkWeek _ =
- let s = case mctWDay a of Nothing -> week
+ checkWeek =
+ let d = case mctWDay a of Nothing -> week
hunk ./src/DateMatcher.lhs 90
- in if spanMatch s then TentativeMatch True else NoMatch
+ in if spanMatch d then TentativeMatch else NoMatch
hunk ./src/DateMatcher.lhs 96
- spanMatch sp = withinIncExc clockA (addToClockTime sp clockA) (toClockTime calB)
+ spanMatch sp = within clockA (addToClockTime sp clockA) (toClockTime calB)
}
[Remove TimeDiff experiment.
Eric Kow <[EMAIL PROTECTED]>**20080128115307] hunk ./src/IsoDate.lhs 442
- where oneDay = TimeDiff 0 0 0 24 0 0 0
+ where oneDay = TimeDiff 0 0 1 0 0 0 0
Context:
[resolve conflict with Eric on controlMasterPath.
David Roundy <[EMAIL PROTECTED]>**20080125203903]
[More concise backup warning.
Eric Kow <[EMAIL PROTECTED]>**20071105012930]
[Remove now obsolete wrapper for Map (we now require GHC >= 6.4).
Eric Kow <[EMAIL PROTECTED]>**20071105192636]
[Modernise Data.Map import.
Eric Kow <[EMAIL PROTECTED]>**20071105192530]
[Give ssh CM socket a unique name for each darcs process.
Eric Kow <[EMAIL PROTECTED]>**20071105021956
Delete the socket in the unlikely event that a previous darcs had a socket
with the same name left over.
]
[Create ssh CM socket in $HOME/.darcs if possible.
Eric Kow <[EMAIL PROTECTED]>**20071105015525]
[Refactor y/n prompts.
Eric Kow <[EMAIL PROTECTED]>**20071019213307]
[issue578: steve and monica test for rolling back a rollback
Mark Stosberg <[EMAIL PROTECTED]>**20080118031606]
[eliminate lazy parsing of patches, which gives bad error messages (issue364)
David Roundy <[EMAIL PROTECTED]>**20080125191836]
[make uniqueoptions.sh test give friendlier output.
David Roundy <[EMAIL PROTECTED]>**20080125183430]
[fix code to avoid duplicate --verbose in --help (so tests will pass).
David Roundy <[EMAIL PROTECTED]>**20080125183420]
[adding File::Temp 0.20 to tree for more consistent test results. It is GPL-licensed.
Mark Stosberg <[EMAIL PROTECTED]>**20080124033049]
[update restrictive perms test to run a temporary directory and clean up after itself.
Mark Stosberg <[EMAIL PROTECTED]>**20080123000417
Running in a tru temporary directory allows the potential to run tests in parallel.
]
[update some ChangeLog entries to also credit those who contributed through bug reporting, test writing or feedback.
Mark Stosberg <[EMAIL PROTECTED]>**20080122235435]
[ issue602: part 1: Always prefer our private copy of Test::More over the system-wide one for more consistent results
Mark Stosberg <[EMAIL PROTECTED]>**20080124005407]
[ issue602, part 2: freshen our versions of Test::More and Test::Builder
Mark Stosberg <[EMAIL PROTECTED]>**20080123013642]
[More error messages for libwww.
Dmitry Kurochkin <[EMAIL PROTECTED]>**20080124092600]
[issue608: a new test for 'mv', following Zooko's bug report
Mark Stosberg <[EMAIL PROTECTED]>**20080124013856]
[[issue492] Check that context file actually exists in darcs get.
Eric Kow <[EMAIL PROTECTED]>**20080125183741]
[[issue227] Platform-independent absolute paths in get --context
Eric Kow <[EMAIL PROTECTED]>**20080125181702]
[Make verbosity flags advanced options universally.
Eric Kow <[EMAIL PROTECTED]>**20080125181005]
[report progress in writing the inventory out for hashed repos.
David Roundy <[EMAIL PROTECTED]>**20080125172017]
[make empty key case of progress reporting fast.
David Roundy <[EMAIL PROTECTED]>**20080125171859]
[fix issue where we overwrote prompt with progress info.
David Roundy <[EMAIL PROTECTED]>**20080125164609]
[fix bug where we used show on an exception (and thus printed "User error").
David Roundy <[EMAIL PROTECTED]>**20080125164209
This partially addresses issue168 by improving the error message.
]
[add gnulib sha1.c file as a faster sha1 option.
David Roundy <[EMAIL PROTECTED]>**20080123212502]
[fix embarrassing bug in External.
David Roundy <[EMAIL PROTECTED]>**20080125152329
(which demonstrates that I didn't compile before pushing)
]
[for now, print progress reports to stdout.
David Roundy <[EMAIL PROTECTED]>**20080125152105
My hope is that this will alleviate some of the issues with progress
reports overwriting prompts.
]
[revamp progress reporting, making it more efficient and adding more output.
David Roundy <[EMAIL PROTECTED]>**20080125151540
Note that there is still at least one time sink that remains to be identified.
]
[avoid creating darcs-ssh if we aren't using ControlMaster. (issue613)
David Roundy <[EMAIL PROTECTED]>**20080125150846]
[fix bug where darcs-ssh got even worse name (issue613).
David Roundy <[EMAIL PROTECTED]>**20080125150355]
[provide more detailed progress reports in HashedIO.
David Roundy <[EMAIL PROTECTED]>**20080124145156]
[print additional debug data in Progress.
David Roundy <[EMAIL PROTECTED]>**20080124145114]
[add a few more debug messages in Repository.Internal.
David Roundy <[EMAIL PROTECTED]>**20080124144829]
[fix incorrect report that we were reading patches.
David Roundy <[EMAIL PROTECTED]>**20080124125040]
[reenable mandatory sha1 checks, now that we can link with a faster sha1.
David Roundy <[EMAIL PROTECTED]>**20080123203104]
[remove (broken) git support and add openssl sha1 support.
David Roundy <[EMAIL PROTECTED]>**20080123202025
These two changes got merged together as I was introducing the configure.ac
changes to support openssl as a sha1 alternative to our Haskell code.
(Yes, I'm lazy.)
]
[remove redundant hash checks in hashed IO code.
David Roundy <[EMAIL PROTECTED]>**20080123173022]
[output nicer progress in convert.
David Roundy <[EMAIL PROTECTED]>**20080123170428]
[output timings when --timings is specified.
David Roundy <[EMAIL PROTECTED]>**20080123170314]
[remove inaccurate message in convert.
David Roundy <[EMAIL PROTECTED]>**20080123170243]
[use debugMessage in HashedIO.
David Roundy <[EMAIL PROTECTED]>**20080123160835]
[add --timings flag (that as yet does nothing).
David Roundy <[EMAIL PROTECTED]>**20080123154931]
[Major Perl test suite clean-up.
Mark Stosberg <[EMAIL PROTECTED]>**20080120035651
The primary purpose of this patch was make sure all the tests are executed in
randomly named directories, which allows us to run Perl tests in parallel,
without the directory names collided.
This isn't enabled by default for "make test", but it is there to play with.
In the test directory, you can now do:
./bin/prove -j9 *.pl
to run 9 tests in parallel. There is also "--fork"
option which should be a win on multi-CPU computers.
See "perldoc ./bin/prove" for details.
As part of this, a lot of boiler-plate code at the top and bottom of the
scripts could be eliminated, and I made few other minor style clean-ups
while I had the files open.
There should be no functional changes to the tests.
]
[Take advantage of new Perl testing infrastructure by eliminating needless --ignore-time mentions
Mark Stosberg <[EMAIL PROTECTED]>**20080120005242]
[Take advantage of updated Perl testing infrastructure by removing needless author mentions in tests
Mark Stosberg <[EMAIL PROTECTED]>**20080120004503]
[use --ignore-time in tests instead of "sleep", for faster, more reliable results
Mark Stosberg <[EMAIL PROTECTED]>**20080118030241]
[Issue395: avoid single letter patch names in the test suite.
Mark Stosberg <[EMAIL PROTECTED]>**20080118020634]
[add regression test for amend-record removed file
Tommy Pettersson <[EMAIL PROTECTED]>**20080122223231]
[use UTC in date matching test untill match handles time zones
Tommy Pettersson <[EMAIL PROTECTED]>**20080122134322]
[fix bug with timestamps and obliterate.
David Roundy <[EMAIL PROTECTED]>**20080122224607]
[Test: unpull may hide changes when using timestamp optimisation.
[EMAIL PROTECTED]
[avoid printing totals that are less than our current progress.
David Roundy <[EMAIL PROTECTED]>**20080122210546]
[TAG 2.0.0pre3
David Roundy <[EMAIL PROTECTED]>**20080122200612]
Patch bundle hash:
85f2ae5b7aaecfb5fd3134a402d73cd603553be5
_______________________________________________
darcs-devel mailing list
darcs-devel@darcs.net
http://lists.osuosl.org/mailman/listinfo/darcs-devel
