From c87d145caa8f07d1974c17569cc070cc68e5abcc Mon Sep 17 00:00:00 2001 From: Daniel Kukula Date: Sun, 7 Dec 2025 23:51:47 +0100 Subject: [PATCH 1/4] use neri-scheider algorithm in calendar --- lib/stdlib/src/calendar.erl | 191 +++++++++--------------------------- 1 file changed, 46 insertions(+), 145 deletions(-) diff --git a/lib/stdlib/src/calendar.erl b/lib/stdlib/src/calendar.erl index b00df6b0da59..e2521dbcf22e 100644 --- a/lib/stdlib/src/calendar.erl +++ b/lib/stdlib/src/calendar.erl @@ -2,9 +2,9 @@ %% %CopyrightBegin% %% %% SPDX-License-Identifier: Apache-2.0 -%% +%% %% Copyright Ericsson AB 1996-2025. All Rights Reserved. -%% +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -16,7 +16,7 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% %% -module(calendar). @@ -90,7 +90,7 @@ The following apply: %% local and universal time, time conversions --export([date_to_gregorian_days/1, +-export([date_to_gregorian_days/1, date_to_gregorian_days/3, datetime_to_gregorian_seconds/1, day_of_the_week/1, @@ -104,9 +104,9 @@ The following apply: local_time/0, local_time_to_system_time/1, local_time_to_system_time/2, - local_time_to_universal_time/1, - local_time_to_universal_time/2, - local_time_to_universal_time_dst/1, + local_time_to_universal_time/1, + local_time_to_universal_time/2, + local_time_to_universal_time_dst/1, now_to_datetime/1, % = now_to_universal_time/1 now_to_local_time/1, now_to_universal_time/1, @@ -135,10 +135,16 @@ The following apply: -define(SECONDS_PER_DAY, 86400). -define(DAYS_PER_YEAR, 365). -define(DAYS_PER_LEAP_YEAR, 366). -%% -define(DAYS_PER_4YEARS, 1461). -%% -define(DAYS_PER_100YEARS, 36524). -%% -define(DAYS_PER_400YEARS, 146097). -define(DAYS_FROM_0_TO_1970, 719528). + +%% Neri-Schneider algorithm constants. +-define(MARCH_1_YEAR_0, 60). % Gregorian days from Jan 1 year 0 to Mar 1 year 0 +-define(DAYS_PER_ERA, 146097). % Days in 400 years +-define(DAYS_PER_4_YEARS, 1460). % 365 * 4 (without leap adjustment) +-define(DAYS_PER_100_YEARS, 36524). % Days in 100 years +-define(YEARS_PER_ERA, 400). +-define(DAYS_PER_5_MONTHS, 153). % Days in Mar-Apr-May-Jun-Jul +-define(MONTHS_PER_CYCLE, 5). -define(DAYS_FROM_0_TO_10000, 2932897). -define(SECONDS_FROM_0_TO_1970, (?DAYS_FROM_0_TO_1970*?SECONDS_PER_DAY)). -define(SECONDS_FROM_0_TO_10000, (?DAYS_FROM_0_TO_10000*?SECONDS_PER_DAY)). @@ -225,11 +231,15 @@ The time unit used by the rfc3339 conversion functions. Day :: day(), Days :: non_neg_integer(). date_to_gregorian_days(Year, Month, Day) when is_integer(Day), Day > 0 -> - Last = last_day_of_the_month(Year, Month), - if - Day =< Last -> - dy(Year) + dm(Month) + df(Year, Month) + Day - 1 - end. + %% Neri-Schneider algorithm. + %% Shift year so March is first month (simplifies leap year handling). + Y = if Month =< 2 -> Year - 1; true -> Year end, + Era = if Y >= 0 -> Y div ?YEARS_PER_ERA; true -> (Y - 399) div ?YEARS_PER_ERA end, + YearOfEra = Y - Era * ?YEARS_PER_ERA, + MonthPrime = if Month > 2 -> Month - 3; true -> Month + 9 end, + DayOfYear = ?DAYS_PER_5_MONTHS * MonthPrime div ?MONTHS_PER_CYCLE + Day - 1, + DayOfEra = ?DAYS_PER_YEAR * YearOfEra + YearOfEra div 4 - YearOfEra div 100 + DayOfYear, + Era * ?DAYS_PER_ERA + DayOfEra + ?MARCH_1_YEAR_0. -doc """ Computes the number of gregorian days starting with year 0 and ending at the @@ -288,9 +298,20 @@ day_of_the_week({Year, Month, Day}) -> -spec gregorian_days_to_date(Days) -> date() when Days :: non_neg_integer(). gregorian_days_to_date(Days) -> - {Year, DayOfYear} = day_to_year(Days), - {Month, DayOfMonth} = year_day_to_date(Year, DayOfYear), - {Year, Month, DayOfMonth}. + %% Neri-Schneider algorithm. + %% Shift to March 1, year 0 epoch. + Z = Days - ?MARCH_1_YEAR_0, + Era = if Z >= 0 -> Z div ?DAYS_PER_ERA; true -> (Z - ?DAYS_PER_ERA + 1) div ?DAYS_PER_ERA end, + DayOfEra = Z - Era * ?DAYS_PER_ERA, + YearOfEra = (DayOfEra - DayOfEra div ?DAYS_PER_4_YEARS + DayOfEra div ?DAYS_PER_100_YEARS + - DayOfEra div (?DAYS_PER_ERA - 1)) div ?DAYS_PER_YEAR, + DayOfYear = DayOfEra - (?DAYS_PER_YEAR * YearOfEra + YearOfEra div 4 - YearOfEra div 100), + MonthPrime = (?MONTHS_PER_CYCLE * DayOfYear + 2) div ?DAYS_PER_5_MONTHS, + Day = DayOfYear - ?DAYS_PER_5_MONTHS * MonthPrime div ?MONTHS_PER_CYCLE + 1, + Month = if MonthPrime < 10 -> MonthPrime + 3; true -> MonthPrime - 9 end, + Y = YearOfEra + Era * ?YEARS_PER_ERA, + Year = if Month =< 2 -> Y + 1; true -> Y end, + {Year, Month, Day}. %% gregorian_seconds_to_datetime(Secs) @@ -425,7 +446,7 @@ local_time_to_system_time(LocalTime, Options) -> [_, _] -> error({ambiguous_local_time, LocalTime}) end. - + %% local_time_to_universal_time(DateTime) %% @@ -498,9 +519,9 @@ local_time_to_universal_time_dst(DateTime) -> %% Convert from erlang:timestamp() to UTC. %% %% Args: Now = now(); now() = {MegaSec, Sec, MilliSec}, MegaSec = Sec -%% = MilliSec = integer() +%% = MilliSec = integer() %% Returns: {date(), time()}, date() = {Y, M, D}, time() = {H, M, S}. -%% +%% -doc """ Returns Universal Coordinated Time (UTC) converted from the return value from `erlang:timestamp/0`. @@ -624,7 +645,7 @@ Converts a specified number of seconds into days, hours, minutes, and seconds. seconds_to_daystime(Secs) -> Days0 = Secs div ?SECONDS_PER_DAY, Secs0 = Secs rem ?SECONDS_PER_DAY, - if + if Secs0 < 0 -> {Days0 - 1, seconds_to_time(Secs0 + ?SECONDS_PER_DAY)}; true -> @@ -783,7 +804,7 @@ system_time_to_rfc3339_do(Time, Options, Unit, OffsetOption) -> %% %% Returns the difference between two {Date, Time} structures. %% -%% T1 = T2 = {Date, Time}, Tdiff = {Day, {Hour, Min, Sec}}, +%% T1 = T2 = {Date, Time}, Tdiff = {Day, {Hour, Min, Sec}}, %% Date = {Year, Month, Day}, Time = {Hour, Minute, Sec}, %% Year = Month = Day = Hour = Minute = Sec = integer() %% @@ -801,7 +822,7 @@ epoch later than `T1`. T2 :: datetime(), Days :: integer(), Time :: time(). -time_difference({{Y1, Mo1, D1}, {H1, Mi1, S1}}, +time_difference({{Y1, Mo1, D1}, {H1, Mi1, S1}}, {{Y2, Mo2, D2}, {H2, Mi2, S2}}) -> Secs = datetime_to_gregorian_seconds({{Y2, Mo2, D2}, {H2, Mi2, S2}}) - datetime_to_gregorian_seconds({{Y1, Mo1, D1}, {H1, Mi1, S1}}), @@ -817,7 +838,7 @@ time_difference({{Y1, Mo1, D1}, {H1, Mi1, S1}}, time_to_seconds({H, M, S}) when is_integer(H), is_integer(M), is_integer(S) -> H * ?SECONDS_PER_HOUR + M * ?SECONDS_PER_MINUTE + S. - + %% universal_time() %% @@ -886,45 +907,6 @@ valid_date({Y, M, D}) -> %% %% LOCAL FUNCTIONS %% --type day_of_year() :: 0..365. - -%% day_to_year(DayOfEpoch) = {Year, DayOfYear} -%% -%% The idea here is to first set the upper and lower bounds for a year, -%% and then adjust a range by interpolation search. Although complexity -%% of the algorithm is log(log(n)), at most 1 or 2 recursive steps -%% are taken. -%% --spec day_to_year(non_neg_integer()) -> {year(), day_of_year()}. -day_to_year(DayOfEpoch) when DayOfEpoch >= 0 -> - YMax = DayOfEpoch div ?DAYS_PER_YEAR, - YMin = DayOfEpoch div ?DAYS_PER_LEAP_YEAR, - {Y1, D1} = dty(YMin, YMax, DayOfEpoch, dy(YMin), dy(YMax)), - {Y1, DayOfEpoch - D1}. - --spec dty(year(), year(), non_neg_integer(), non_neg_integer(), - non_neg_integer()) -> - {year(), non_neg_integer()}. -dty(Min, Max, _D1, DMin, _DMax) when Min == Max -> - {Min, DMin}; -dty(Min, Max, D1, DMin, DMax) -> - Diff = Max - Min, - Mid = Min + (Diff * (D1 - DMin)) div (DMax - DMin), - MidLength = - case is_leap_year(Mid) of - true -> ?DAYS_PER_LEAP_YEAR; - false -> ?DAYS_PER_YEAR - end, - case dy(Mid) of - D2 when D1 < D2 -> - NewMax = Mid - 1, - dty(Min, NewMax, D1, DMin, dy(NewMax)); - D2 when D1 - D2 >= MidLength -> - NewMin = Mid + 1, - dty(NewMin, Max, D1, dy(NewMin), DMax); - D2 -> - {Mid, D2} - end. %% %% The Gregorian days of the iso week 01 day 1 for a given year. @@ -939,87 +921,6 @@ gregorian_days_of_iso_w01_1(Year) -> D0101 + 7 - DOW + 1 end. -%% year_day_to_date(Year, DayOfYear) = {Month, DayOfMonth} -%% -%% Note: 1 is the first day of the month. -%% --spec year_day_to_date(year(), day_of_year()) -> {month(), day()}. -year_day_to_date(Year, DayOfYear) -> - ExtraDay = case is_leap_year(Year) of - true -> - 1; - false -> - 0 - end, - {Month, Day} = year_day_to_date2(ExtraDay, DayOfYear), - {Month, Day + 1}. - - -%% Note: 0 is the first day of the month -%% --spec year_day_to_date2(0 | 1, day_of_year()) -> {month(), 0..30}. -year_day_to_date2(_, Day) when Day < 31 -> - {1, Day}; -year_day_to_date2(E, Day) when 31 =< Day, Day < 59 + E -> - {2, Day - 31}; -year_day_to_date2(E, Day) when 59 + E =< Day, Day < 90 + E -> - {3, Day - (59 + E)}; -year_day_to_date2(E, Day) when 90 + E =< Day, Day < 120 + E -> - {4, Day - (90 + E)}; -year_day_to_date2(E, Day) when 120 + E =< Day, Day < 151 + E -> - {5, Day - (120 + E)}; -year_day_to_date2(E, Day) when 151 + E =< Day, Day < 181 + E -> - {6, Day - (151 + E)}; -year_day_to_date2(E, Day) when 181 + E =< Day, Day < 212 + E -> - {7, Day - (181 + E)}; -year_day_to_date2(E, Day) when 212 + E =< Day, Day < 243 + E -> - {8, Day - (212 + E)}; -year_day_to_date2(E, Day) when 243 + E =< Day, Day < 273 + E -> - {9, Day - (243 + E)}; -year_day_to_date2(E, Day) when 273 + E =< Day, Day < 304 + E -> - {10, Day - (273 + E)}; -year_day_to_date2(E, Day) when 304 + E =< Day, Day < 334 + E -> - {11, Day - (304 + E)}; -year_day_to_date2(E, Day) when 334 + E =< Day -> - {12, Day - (334 + E)}. - -%% dy(Year) -%% -%% Days in previous years. -%% --spec dy(integer()) -> non_neg_integer(). -dy(Y) when Y =< 0 -> - 0; -dy(Y) -> - X = Y - 1, - (X div 4) - (X div 100) + (X div 400) + - X*?DAYS_PER_YEAR + ?DAYS_PER_LEAP_YEAR. - -%% dm(Month) -%% -%% Returns the total number of days in all months -%% preceeding Month, for an ordinary year. -%% --spec dm(month()) -> - 0 | 31 | 59 | 90 | 120 | 151 | 181 | 212 | 243 | 273 | 304 | 334. -dm(1) -> 0; dm(2) -> 31; dm(3) -> 59; dm(4) -> 90; -dm(5) -> 120; dm(6) -> 151; dm(7) -> 181; dm(8) -> 212; -dm(9) -> 243; dm(10) -> 273; dm(11) -> 304; dm(12) -> 334. - -%% df(Year, Month) -%% -%% Accounts for an extra day in February if Year is -%% a leap year, and if Month > 2. -%% --spec df(year(), month()) -> 0 | 1. -df(_, Month) when Month < 3 -> - 0; -df(Year, _) -> - case is_leap_year(Year) of - true -> 1; - false -> 0 - end. - check(_Arg, _Options, Secs) when Secs >= - ?SECONDS_FROM_0_TO_1970, Secs < ?SECONDS_FROM_0_TO_10000 -> ok; From 820250ab92c2ab0296c03242e73c9aa9c08f6301 Mon Sep 17 00:00:00 2001 From: Daniel Kukula Date: Mon, 8 Dec 2025 17:20:38 +0100 Subject: [PATCH 2/4] add tests --- lib/stdlib/src/calendar.erl | 4 +- lib/stdlib/test/calendar_SUITE.erl | 119 ++++++++++++++++-- .../test/property_test/calendar_prop.erl | 73 +++++++++++ 3 files changed, 185 insertions(+), 11 deletions(-) diff --git a/lib/stdlib/src/calendar.erl b/lib/stdlib/src/calendar.erl index e2521dbcf22e..db6c5bed1e7e 100644 --- a/lib/stdlib/src/calendar.erl +++ b/lib/stdlib/src/calendar.erl @@ -237,7 +237,7 @@ date_to_gregorian_days(Year, Month, Day) when is_integer(Day), Day > 0 -> Era = if Y >= 0 -> Y div ?YEARS_PER_ERA; true -> (Y - 399) div ?YEARS_PER_ERA end, YearOfEra = Y - Era * ?YEARS_PER_ERA, MonthPrime = if Month > 2 -> Month - 3; true -> Month + 9 end, - DayOfYear = ?DAYS_PER_5_MONTHS * MonthPrime div ?MONTHS_PER_CYCLE + Day - 1, + DayOfYear = (?DAYS_PER_5_MONTHS * MonthPrime + 2) div ?MONTHS_PER_CYCLE + Day - 1, DayOfEra = ?DAYS_PER_YEAR * YearOfEra + YearOfEra div 4 - YearOfEra div 100 + DayOfYear, Era * ?DAYS_PER_ERA + DayOfEra + ?MARCH_1_YEAR_0. @@ -307,7 +307,7 @@ gregorian_days_to_date(Days) -> - DayOfEra div (?DAYS_PER_ERA - 1)) div ?DAYS_PER_YEAR, DayOfYear = DayOfEra - (?DAYS_PER_YEAR * YearOfEra + YearOfEra div 4 - YearOfEra div 100), MonthPrime = (?MONTHS_PER_CYCLE * DayOfYear + 2) div ?DAYS_PER_5_MONTHS, - Day = DayOfYear - ?DAYS_PER_5_MONTHS * MonthPrime div ?MONTHS_PER_CYCLE + 1, + Day = DayOfYear - (?DAYS_PER_5_MONTHS * MonthPrime + 2) div ?MONTHS_PER_CYCLE + 1, Month = if MonthPrime < 10 -> MonthPrime + 3; true -> MonthPrime - 9 end, Y = YearOfEra + Era * ?YEARS_PER_ERA, Year = if Month =< 2 -> Y + 1; true -> Y end, diff --git a/lib/stdlib/test/calendar_SUITE.erl b/lib/stdlib/test/calendar_SUITE.erl index e73a9e3c170e..65572a58bff6 100644 --- a/lib/stdlib/test/calendar_SUITE.erl +++ b/lib/stdlib/test/calendar_SUITE.erl @@ -23,10 +23,11 @@ -include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, gregorian_days/1, big_gregorian_days/1, + gregorian_days_edge_cases/1, gregorian_seconds/1, day_of_the_week/1, day_of_the_week_calibrate/1, @@ -36,7 +37,7 @@ iso_week_number/1, system_time/1, rfc3339/1]). --define(START_YEAR, 1947). +-define(START_YEAR, 1947). -define(END_YEAR, 2012). -define(BIG_START_YEAR, 20000000). @@ -44,13 +45,14 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [gregorian_days, gregorian_seconds, day_of_the_week, day_of_the_week_calibrate, leap_years, last_day_of_the_month, local_time_to_universal_time_dst, - iso_week_number, system_time, rfc3339, big_gregorian_days]. + iso_week_number, system_time, rfc3339, big_gregorian_days, + gregorian_days_edge_cases]. -groups() -> +groups() -> []. init_per_suite(Config) -> @@ -81,6 +83,105 @@ big_gregorian_days(Config) when is_list(Config) -> MaxDays = calendar:date_to_gregorian_days({?BIG_END_YEAR, 1, 1}), check_gregorian_days(Days, MaxDays). +%% Tests edge cases for the Neri-Schneider algorithm. +%% This includes epoch boundaries, leap years, century boundaries, +%% and 400-year era boundaries. +gregorian_days_edge_cases(Config) when is_list(Config) -> + %% Test epoch (day 0 = Jan 1, year 0) + 0 = calendar:date_to_gregorian_days(0, 1, 1), + {0, 1, 1} = calendar:gregorian_days_to_date(0), + + %% Test year 0 boundaries (year 0 is a leap year) + 0 = calendar:date_to_gregorian_days({0, 1, 1}), + 30 = calendar:date_to_gregorian_days({0, 1, 31}), + 31 = calendar:date_to_gregorian_days({0, 2, 1}), + 58 = calendar:date_to_gregorian_days({0, 2, 28}), + 59 = calendar:date_to_gregorian_days({0, 2, 29}), % Leap day + 60 = calendar:date_to_gregorian_days({0, 3, 1}), + 365 = calendar:date_to_gregorian_days({0, 12, 31}), + + %% Test year 1 (not a leap year) + 366 = calendar:date_to_gregorian_days({1, 1, 1}), + {1, 1, 1} = calendar:gregorian_days_to_date(366), + 730 = calendar:date_to_gregorian_days({1, 12, 31}), + + %% Test Unix epoch (Jan 1, 1970) + 719528 = calendar:date_to_gregorian_days({1970, 1, 1}), + {1970, 1, 1} = calendar:gregorian_days_to_date(719528), + + %% Test century boundaries (1900 is not a leap year, 2000 is) + 693961 = calendar:date_to_gregorian_days({1900, 1, 1}), + {1900, 1, 1} = calendar:gregorian_days_to_date(693961), + 694325 = calendar:date_to_gregorian_days({1900, 12, 31}), % 365 days (not leap) + + 730485 = calendar:date_to_gregorian_days({2000, 1, 1}), + {2000, 1, 1} = calendar:gregorian_days_to_date(730485), + 730850 = calendar:date_to_gregorian_days({2000, 12, 31}), % 366 days (leap) + + %% Verify 1900 is not a leap year (Feb has 28 days, Mar 1 is next day) + 694019 = calendar:date_to_gregorian_days({1900, 2, 28}), + 694020 = calendar:date_to_gregorian_days({1900, 3, 1}), + + %% Verify 2000 is a leap year (Feb has 29 days) + 730544 = calendar:date_to_gregorian_days({2000, 2, 29}), + 730545 = calendar:date_to_gregorian_days({2000, 3, 1}), + + %% Test 400-year era boundaries + 146097 = calendar:date_to_gregorian_days({400, 1, 1}), + {400, 1, 1} = calendar:gregorian_days_to_date(146097), + 292194 = calendar:date_to_gregorian_days({800, 1, 1}), + {800, 1, 1} = calendar:gregorian_days_to_date(292194), + + %% Test all months in a leap year (2000) + check_all_months(2000), + + %% Test all months in a non-leap year (2001) + check_all_months(2001), + + %% Test all months in century non-leap year (1900) + check_all_months(1900), + + %% Test specific known dates + %% July 4, 1776 (US Independence Day) + 648856 = calendar:date_to_gregorian_days({1776, 7, 4}), + {1776, 7, 4} = calendar:gregorian_days_to_date(648856), + + %% December 7, 2025 (a Sunday) + 739957 = calendar:date_to_gregorian_days({2025, 12, 7}), + {2025, 12, 7} = calendar:gregorian_days_to_date(739957), + 7 = calendar:day_of_the_week({2025, 12, 7}), % Sunday + + %% Test far future date + 3652424 = calendar:date_to_gregorian_days({9999, 12, 31}), + {9999, 12, 31} = calendar:gregorian_days_to_date(3652424), + + %% Test roundtrip for sampled days across entire valid range + check_roundtrip_samples(), + + ok. + +%% Helper: check all months roundtrip correctly for a given year +check_all_months(Year) -> + lists:foreach( + fun(Month) -> + LastDay = calendar:last_day_of_the_month(Year, Month), + lists:foreach( + fun(Day) -> + Date = {Year, Month, Day}, + Days = calendar:date_to_gregorian_days(Date), + Date = calendar:gregorian_days_to_date(Days) + end, [1, LastDay]) + end, lists:seq(1, 12)). + +%% Helper: check roundtrip for sampled days +check_roundtrip_samples() -> + %% Sample every 10000 days from 0 to 4000000 (covers year 0 to ~10950) + lists:foreach( + fun(Days) -> + Date = calendar:gregorian_days_to_date(Days), + Days = calendar:date_to_gregorian_days(Date) + end, lists:seq(0, 4000000, 10000)). + %% Tests that datetime_to_gregorian_seconds and %% gregorian_seconds_to_date are each others inverses for a sampled %% number of seconds from ?START_YEAR-01-01 up to ?END_YEAR-01-01: We check @@ -164,7 +265,7 @@ local_time_to_universal_time_dst_x(Config) when is_list(Config) -> {{1969,12,31},{23,59,59}} -> %% It seems that Apple has no intention of fixing this bug in %% Mac OS 10.3.9, and we have no intention of implementing a - %% workaround. + %% workaround. {comment,"Bug in mktime() in this OS"} end. @@ -383,7 +484,7 @@ do_format(Time, Options) -> calendar:system_time_to_rfc3339(Time, Options). %% check_gregorian_days -%% +%% check_gregorian_days(Days, MaxDays) when Days < MaxDays -> Date = calendar:gregorian_days_to_date(Days), true = calendar:valid_date(Date), @@ -393,7 +494,7 @@ check_gregorian_days(_Days, _MaxDays) -> ok. %% check_gregorian_seconds -%% +%% %% We increment with something prime (172801 = 2 days + 1 second). %% check_gregorian_seconds(Secs, MaxSecs) when Secs < MaxSecs -> diff --git a/lib/stdlib/test/property_test/calendar_prop.erl b/lib/stdlib/test/property_test/calendar_prop.erl index 0c329d31a783..e968bea7b5bf 100644 --- a/lib/stdlib/test/property_test/calendar_prop.erl +++ b/lib/stdlib/test/property_test/calendar_prop.erl @@ -88,3 +88,76 @@ loss(SystemTime, millisecond) -> SystemTime rem 1_000; loss(SystemTime, microsecond) -> SystemTime rem 1_000_000; loss(SystemTime, nanosecond) -> SystemTime rem 1_000_000_000; loss(SystemTime, native) -> loss(erlang:convert_time_unit(SystemTime, native, nanosecond), nanosecond). + +%% Property: date_to_gregorian_days and gregorian_days_to_date are inverses +gregorian_days_roundtrip() -> + ?FORALL( + Days, + integer(0, 4_000_000), % Covers year 0 to ~10950 + begin + Date = calendar:gregorian_days_to_date(Days), + Days =:= calendar:date_to_gregorian_days(Date) + end + ). + +%% Property: date_to_gregorian_days produces strictly increasing values +gregorian_days_monotonic() -> + ?FORALL( + {Year, Month, Day}, + valid_date(), + begin + Days1 = calendar:date_to_gregorian_days(Year, Month, Day), + %% Next day should be Days1 + 1 + {Y2, M2, D2} = next_day(Year, Month, Day), + Days2 = calendar:date_to_gregorian_days(Y2, M2, D2), + Days2 =:= Days1 + 1 + end + ). + +%% Property: day_of_the_week cycles correctly (1-7, Monday-Sunday) +day_of_week_cycle() -> + ?FORALL( + Days, + integer(0, 1_000_000), + begin + DOW1 = calendar:day_of_the_week(calendar:gregorian_days_to_date(Days)), + DOW2 = calendar:day_of_the_week(calendar:gregorian_days_to_date(Days + 7)), + DOW1 =:= DOW2 andalso DOW1 >= 1 andalso DOW1 =< 7 + end + ). + +%% Property: leap years have 366 days, non-leap years have 365 days +year_length() -> + ?FORALL( + Year, + integer(0, 10000), + begin + Jan1 = calendar:date_to_gregorian_days(Year, 1, 1), + Dec31 = calendar:date_to_gregorian_days(Year, 12, 31), + YearLength = Dec31 - Jan1 + 1, + ExpectedLength = case calendar:is_leap_year(Year) of + true -> 366; + false -> 365 + end, + YearLength =:= ExpectedLength + end + ). + +%% Generator for valid dates +valid_date() -> + ?LET(Year, integer(0, 9999), + ?LET(Month, integer(1, 12), + ?LET(Day, integer(1, calendar:last_day_of_the_month(Year, Month)), + {Year, Month, Day}))). + +%% Helper: compute next day +next_day(Year, Month, Day) -> + LastDay = calendar:last_day_of_the_month(Year, Month), + if + Day < LastDay -> + {Year, Month, Day + 1}; + Month < 12 -> + {Year, Month + 1, 1}; + true -> + {Year + 1, 1, 1} + end. From 1efefec343a90b8aa0f4a7e3e8bcad07926f11f1 Mon Sep 17 00:00:00 2001 From: Daniel Kukula Date: Mon, 8 Dec 2025 17:40:45 +0100 Subject: [PATCH 3/4] remove duplicated test --- lib/stdlib/test/calendar_SUITE.erl | 28 +--------------------------- 1 file changed, 1 insertion(+), 27 deletions(-) diff --git a/lib/stdlib/test/calendar_SUITE.erl b/lib/stdlib/test/calendar_SUITE.erl index 65572a58bff6..82f359028322 100644 --- a/lib/stdlib/test/calendar_SUITE.erl +++ b/lib/stdlib/test/calendar_SUITE.erl @@ -38,7 +38,7 @@ system_time/1, rfc3339/1]). -define(START_YEAR, 1947). --define(END_YEAR, 2012). +-define(END_YEAR, 2032). -define(BIG_START_YEAR, 20000000). -define(BIG_END_YEAR, 20000020). @@ -105,10 +105,6 @@ gregorian_days_edge_cases(Config) when is_list(Config) -> {1, 1, 1} = calendar:gregorian_days_to_date(366), 730 = calendar:date_to_gregorian_days({1, 12, 31}), - %% Test Unix epoch (Jan 1, 1970) - 719528 = calendar:date_to_gregorian_days({1970, 1, 1}), - {1970, 1, 1} = calendar:gregorian_days_to_date(719528), - %% Test century boundaries (1900 is not a leap year, 2000 is) 693961 = calendar:date_to_gregorian_days({1900, 1, 1}), {1900, 1, 1} = calendar:gregorian_days_to_date(693961), @@ -132,15 +128,6 @@ gregorian_days_edge_cases(Config) when is_list(Config) -> 292194 = calendar:date_to_gregorian_days({800, 1, 1}), {800, 1, 1} = calendar:gregorian_days_to_date(292194), - %% Test all months in a leap year (2000) - check_all_months(2000), - - %% Test all months in a non-leap year (2001) - check_all_months(2001), - - %% Test all months in century non-leap year (1900) - check_all_months(1900), - %% Test specific known dates %% July 4, 1776 (US Independence Day) 648856 = calendar:date_to_gregorian_days({1776, 7, 4}), @@ -160,19 +147,6 @@ gregorian_days_edge_cases(Config) when is_list(Config) -> ok. -%% Helper: check all months roundtrip correctly for a given year -check_all_months(Year) -> - lists:foreach( - fun(Month) -> - LastDay = calendar:last_day_of_the_month(Year, Month), - lists:foreach( - fun(Day) -> - Date = {Year, Month, Day}, - Days = calendar:date_to_gregorian_days(Date), - Date = calendar:gregorian_days_to_date(Days) - end, [1, LastDay]) - end, lists:seq(1, 12)). - %% Helper: check roundtrip for sampled days check_roundtrip_samples() -> %% Sample every 10000 days from 0 to 4000000 (covers year 0 to ~10950) From 86d7c176f28291d09d8be917acbba7d30d87d9d4 Mon Sep 17 00:00:00 2001 From: Daniel Kukula Date: Mon, 8 Dec 2025 20:22:56 +0100 Subject: [PATCH 4/4] include prop test --- lib/stdlib/test/calendar_prop_SUITE.erl | 34 ++++++++++++++++++++++--- 1 file changed, 31 insertions(+), 3 deletions(-) diff --git a/lib/stdlib/test/calendar_prop_SUITE.erl b/lib/stdlib/test/calendar_prop_SUITE.erl index 7c92263df47a..0d911346233d 100644 --- a/lib/stdlib/test/calendar_prop_SUITE.erl +++ b/lib/stdlib/test/calendar_prop_SUITE.erl @@ -25,15 +25,23 @@ init_per_group/2, end_per_group/2, rfc3339_lists_binaries/1, universal_time_system_time_symmetry/1, - local_time_system_time_symmetry/1]). + local_time_system_time_symmetry/1, + gregorian_days_roundtrip/1, + gregorian_days_monotonic/1, + day_of_week_cycle/1, + year_length/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [rfc3339_lists_binaries, - universal_time_system_time_symmetry, - local_time_system_time_symmetry]. + universal_time_system_time_symmetry, + local_time_system_time_symmetry, + gregorian_days_roundtrip, + gregorian_days_monotonic, + day_of_week_cycle, + year_length]. groups() -> []. @@ -64,3 +72,23 @@ local_time_system_time_symmetry(Config) when is_list(Config) -> ct_property_test:quickcheck( calendar_prop:local_time_system_time_symmetry(), Config). + +gregorian_days_roundtrip(Config) when is_list(Config) -> + ct_property_test:quickcheck( + calendar_prop:gregorian_days_roundtrip(), + Config). + +gregorian_days_monotonic(Config) when is_list(Config) -> + ct_property_test:quickcheck( + calendar_prop:gregorian_days_monotonic(), + Config). + +day_of_week_cycle(Config) when is_list(Config) -> + ct_property_test:quickcheck( + calendar_prop:day_of_week_cycle(), + Config). + +year_length(Config) when is_list(Config) -> + ct_property_test:quickcheck( + calendar_prop:year_length(), + Config).