[m-rev.] for review: fix a bug in calendar.duration_between/2
Julien Fischer
jfischer at opturion.com
Tue Jun 23 11:29:33 AEST 2026
For review by anyone.
----------------------------
Fix a bug in calendar.duration_between/2.
calendar.duration_between/2 computes the difference between two date_times
using greedy_subtract_descending/4. That predicate subtracts the fields of its
arguments one at a time (from the smallest to the largest component), borrowing
from the next larger field whenever the current one would otherwise go
negative. For every field except days, the amount borrowed is a fixed quantity.
For the days field, the amount borrowed is the month length, which is a
variable quantity. Unfortunately, the existing code is inconsistent about which
month's length is used. The number of days available to borrow (DaysToBorrow)
is taken from the month adjacent to one date, while the day-of-month being
subtracted is clamped to a *possibly different* month's length (DateAEndOfMonth
or DateBEndOfMonth). When those two month lengths differ and the day-of-month
falls in the gap between them, the days component can become negative while
the months component is positive, producing a duration whose components have
mixed signs; init_duration/7 then aborts. In other cases the same inconsistency
leaves the days component off by the difference between the two month lengths,
so the invariant
add_duration(duration_between(DateA, DateB), DateA, DateB)
does not hold.
For example, duration_between/2 aborts for 2001-01-31 and 2001-03-01.
For 2002-11-29 and 2003-02-03 it returns P2M6D, which adds back to 2003-02-04
rather than 2003-02-03.
Replace the borrow-based computation with a direct construction of the greedy
difference. Choose the largest whole number of months that does not overstep
the far date -- found by a trial add_duration/3 of the year-and-month
difference, decremented by one if it oversteps -- and compute the sub-month
remainder as a fixed-length-unit difference using the existing
do_fixed_duration_between/2 predicate; the month count and the remainder are
both non-negative, so the resulting duration can no longer have mixed signs.
library/calendar.m:
Rewrite greedy_subtract_descending/4 as described above.
tests/hard_coded/calendar_test.{m,exp}:
Add some instances that trigger the bug.
Julien.
diff --git a/library/calendar.m b/library/calendar.m
index ea1d8ff0f..67df54e28 100644
--- a/library/calendar.m
+++ b/library/calendar.m
@@ -1297,68 +1297,76 @@ duration(DateA, DateB) = duration_between(DateA, DateB).
---> ascending
; descending.
- % This predicate has the precondition that DateA > DateB.
- % OriginalOrder is the original order of the date_time arguments
- % (descending means that in the original call DateA < DateB, while
- % ascending means that in the original call DateA > DateB). This is needed
- % to correctly compute the days component of the resulting duration.
- % The calculation is different depending on the original order, because we
- % want the invariant:
+ % greedy_subtract_descending(OriginalOrder, DateA, DateB, Duration):
+ %
+ % Duration is the non-negative difference between DateA and DateB.
+ % It is a precondition of this predicate that DateA > DateB.
+ % OriginalOrder is the order of the arguments in the original call to
+ % duration_between/2:
+ % - descending means that call had DateA < DateB, so this non-negative
+ % result is returned unchanged;
+ % - ascending means it had DateA > DateB, so the caller negates this
+ % result.
+ % The two cases anchor the whole-month count at opposite ends.
+ % This is required so that the invariant
% add_duration(duration_between(DateA, DateB), DateA, DateB)
- % to hold, and in the case where DateA > DateB, Duration will be negative.
+ % holds for the original call for both orders.
+ %
+ % The greedy difference is the largest whole number of months Months such
+ % that
+ % - DateB + Months months =< DateA, in the descending case; or
+ % - DateA - Months months >= DateB, in the ascending case
+ % The remaining difference will span less than a month and is measured in
+ % days and smaller units only.
+ % Because add_duration/3 applies a duration's months component before its
+ % days component, this is precisely the duration that add_duration/3
+ % inverts, so the invariant holds by construction.
+ % Months is found using a trial duration addition of the year-and-month
+ % difference, decremented by one if that oversteps DateA (descending) or
+ % DateB (ascending) because the days and time of day are not yet accounted
+ % for. The sub-month remainder is found using do_fixed_duration_between/2.
+ % Both the month count and the remainder will be non-negative.
+ % This satisfies the requirement that the components of a duration do not
+ % have mixed signs.
%
:- pred greedy_subtract_descending(order::in, date_time::in,
date_time::in, duration::out) is det.
greedy_subtract_descending(OriginalOrder, DateA, DateB, Duration) :-
- some [!Borrow] (
- MicroSecondA = DateA ^ dt_microsecond,
- MicroSecondB = DateB ^ dt_microsecond,
- subtract_ints_with_borrow(microseconds_per_second, MicroSecondA,
- MicroSecondB, MicroSeconds, !:Borrow),
- SecondA = DateA ^ dt_second - !.Borrow,
- SecondB = DateB ^ dt_second,
- subtract_ints_with_borrow(60, SecondA, SecondB, Seconds, !:Borrow),
- MinuteA = DateA ^ dt_minute - !.Borrow,
- MinuteB = DateB ^ dt_minute,
- subtract_ints_with_borrow(60, MinuteA, MinuteB, Minutes, !:Borrow),
- HourA = DateA ^ dt_hour - !.Borrow,
- HourB = DateB ^ dt_hour,
- subtract_ints_with_borrow(24, HourA, HourB, Hours, !:Borrow),
- (
- OriginalOrder = descending,
- add_duration(duration(-1, 0, 0, 0), DateA, DateAMinus1Month),
- DaysToBorrow = max_day_in_month_for(DateAMinus1Month ^ dt_year,
- DateAMinus1Month ^ dt_month),
- DateAEndOfMonth = max_day_in_month_for(DateA ^ dt_year,
- DateA ^ dt_month),
- DayA = DateA ^ dt_day - !.Borrow,
- DayB = int.min(DateB ^ dt_day, DateAEndOfMonth)
- ;
- OriginalOrder = ascending,
- DaysToBorrow = max_day_in_month_for(DateB ^ dt_year,
- DateB ^ dt_month),
- DateBEndOfMonth = max_day_in_month_for(DateB ^ dt_year,
- DateB ^ dt_month),
- DayA = int.min(DateA ^ dt_day - !.Borrow, DateBEndOfMonth),
- DayB = DateB ^ dt_day
+ MonthsUpperBound = 12 * (DateA ^ dt_year - DateB ^ dt_year)
+ + (DateA ^ dt_month - DateB ^ dt_month),
+ (
+ OriginalOrder = descending,
+ % Anchor the months at the earlier date and step forwards, calculating
+ % the largest whole number of months that does not overshoot DateA.
+ add_duration(init_duration(0, MonthsUpperBound, 0, 0, 0, 0, 0),
+ DateB, Candidate),
+ ( if compare((>), Candidate, DateA) then
+ Months = MonthsUpperBound - 1
+ else
+ Months = MonthsUpperBound
),
- subtract_ints_with_borrow(DaysToBorrow, DayA, DayB, Days, !:Borrow),
- MonthA = DateA ^ dt_month - !.Borrow,
- MonthB = DateB ^ dt_month,
- subtract_ints_with_borrow(12, MonthA, MonthB, Months, !:Borrow),
- YearA = DateA ^ dt_year - !.Borrow,
- YearB = DateB ^ dt_year,
- ( if YearA >= YearB then
- Years = YearA - YearB
+ add_duration(init_duration(0, Months, 0, 0, 0, 0, 0), DateB, Landing),
+ % Landing =< DateA, and Landing differs from DateA by less than a
+ % month, so the remainder has no month component.
+ Remainder = do_fixed_duration_between(Landing, DateA)
+ ;
+ OriginalOrder = ascending,
+ % Anchor the months at the later date and step backwards, calculating
+ % the largest whole number of months that does not undershoot DateB.
+ add_duration(init_duration(0, -MonthsUpperBound, 0, 0, 0, 0, 0),
+ DateA, Candidate),
+ ( if compare((<), Candidate, DateB) then
+ Months = MonthsUpperBound - 1
else
- % If this happens, then DateA < DateB, which violates
- % a precondition of this predicate.
- unexpected($pred, "left over years")
+ Months = MonthsUpperBound
),
- Duration = init_duration(Years, Months, Days, Hours, Minutes, Seconds,
- MicroSeconds)
- ).
+ add_duration(init_duration(0, -Months, 0, 0, 0, 0, 0), DateA, Landing),
+ % Landing >= DateB, differing by less than a month.
+ Remainder = do_fixed_duration_between(DateB, Landing)
+ ),
+ Remainder = duration(_, RemDays, RemSeconds, RemMicroSeconds),
+ Duration = duration(Months, RemDays, RemSeconds, RemMicroSeconds).
% subtract_ints_with_borrow(BorrowAmount, Val1, Val2, Val, Borrow):
%
diff --git a/tests/hard_coded/calendar_test.exp
b/tests/hard_coded/calendar_test.exp
index 1dfda1725..5ed50ff53 100644
--- a/tests/hard_coded/calendar_test.exp
+++ b/tests/hard_coded/calendar_test.exp
@@ -109,6 +109,36 @@ G: 2001-04-10 06:00:00 -> 2001-02-20 18:30:00 =
-P1M17DT11H30M checked ok
D: 2001-02-20 18:30:00 -> 2001-04-10 06:00:00 = P48DT11H30M checked ok
D: 2001-04-10 06:00:00 -> 2001-02-20 18:30:00 = -P48DT11H30M checked ok
+G: 2001-01-31 00:00:00 -> 2001-03-01 00:00:00 = P1M1D checked ok
+G: 2001-03-01 00:00:00 -> 2001-01-31 00:00:00 = -P1M1D checked ok
+D: 2001-01-31 00:00:00 -> 2001-03-01 00:00:00 = P29D checked ok
+D: 2001-03-01 00:00:00 -> 2001-01-31 00:00:00 = -P29D checked ok
+
+G: 2001-03-30 00:00:00 -> 2001-01-31 00:00:00 = -P1M28D checked ok
+G: 2001-01-31 00:00:00 -> 2001-03-30 00:00:00 = P1M30D checked ok
+D: 2001-03-30 00:00:00 -> 2001-01-31 00:00:00 = -P58D checked ok
+D: 2001-01-31 00:00:00 -> 2001-03-30 00:00:00 = P58D checked ok
+
+G: 2002-11-29 00:00:00 -> 2003-02-03 00:00:00 = P2M5D checked ok
+G: 2003-02-03 00:00:00 -> 2002-11-29 00:00:00 = -P2M4D checked ok
+D: 2002-11-29 00:00:00 -> 2003-02-03 00:00:00 = P66D checked ok
+D: 2003-02-03 00:00:00 -> 2002-11-29 00:00:00 = -P66D checked ok
+
+G: 2001-03-31 00:00:00 -> 2001-05-01 00:00:00 = P1M1D checked ok
+G: 2001-05-01 00:00:00 -> 2001-03-31 00:00:00 = -P1M1D checked ok
+D: 2001-03-31 00:00:00 -> 2001-05-01 00:00:00 = P31D checked ok
+D: 2001-05-01 00:00:00 -> 2001-03-31 00:00:00 = -P31D checked ok
+
+G: 2000-12-31 00:00:00 -> 2001-02-01 00:00:00 = P1M1D checked ok
+G: 2001-02-01 00:00:00 -> 2000-12-31 00:00:00 = -P1M1D checked ok
+D: 2000-12-31 00:00:00 -> 2001-02-01 00:00:00 = P32D checked ok
+D: 2001-02-01 00:00:00 -> 2000-12-31 00:00:00 = -P32D checked ok
+
+G: 2001-01-31 18:00:00 -> 2001-03-01 06:00:00 = P1MT12H checked ok
+G: 2001-03-01 06:00:00 -> 2001-01-31 18:00:00 = -P1MT12H checked ok
+D: 2001-01-31 18:00:00 -> 2001-03-01 06:00:00 = P28DT12H checked ok
+D: 2001-03-01 06:00:00 -> 2001-01-31 18:00:00 = -P28DT12H checked ok
+
Day of the week:
2008-01-15 23:59:00 : tuesday
diff --git a/tests/hard_coded/calendar_test.m b/tests/hard_coded/calendar_test.m
index a4b423d77..1a350d528 100644
--- a/tests/hard_coded/calendar_test.m
+++ b/tests/hard_coded/calendar_test.m
@@ -67,6 +67,12 @@ main(!IO) :-
test_diff("2000-01-20 00:00:00", "2000-03-10 00:00:00", !IO),
test_diff("2001-03-25 00:00:00", "2001-04-10 00:00:00", !IO),
test_diff("2001-02-20 18:30:00", "2001-04-10 06:00:00", !IO),
+ test_diff("2001-01-31 00:00:00", "2001-03-01 00:00:00", !IO),
+ test_diff("2001-03-30 00:00:00", "2001-01-31 00:00:00", !IO),
+ test_diff("2002-11-29 00:00:00", "2003-02-03 00:00:00", !IO),
+ test_diff("2001-03-31 00:00:00", "2001-05-01 00:00:00", !IO),
+ test_diff("2000-12-31 00:00:00", "2001-02-01 00:00:00", !IO),
+ test_diff("2001-01-31 18:00:00", "2001-03-01 06:00:00", !IO),
io.nl(!IO),
io.write_string("Day of the week:\n", !IO),
test_day_of_week("2008-01-15 23:59:00", !IO),
More information about the reviews
mailing list