[m-rev.] for review: fix a bug in calendar.duration_between/2

[Julien Fischer]

Hi,

Is anyone intending to review this one?   I will commit it tomorrow in
the absence
of a review.

Julien.

On Tue, 23 Jun 2026 at 11:29, Julien Fischer <jfischer at opturion.com> wrote:
>
> 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),