diff --git a/src/datetime/stdlib_datetime.f90 b/src/datetime/stdlib_datetime.f90 index c15e03e93..4f2ae4353 100644 --- a/src/datetime/stdlib_datetime.f90 +++ b/src/datetime/stdlib_datetime.f90 @@ -8,11 +8,14 @@ module stdlib_datetime implicit none private - public :: datetime_type, timedelta_type - public :: datetime, timedelta, now, now_utc, epoch + public :: datetime_type, timedelta_type, date_type, time_type + public :: datetime, timedelta, date, time_of_day + public :: now, now_utc, epoch, today, current_time public :: parse_datetime, format_datetime, format_timedelta + public :: parse_date, parse_time, format_date, format_time public :: is_leap_year, days_in_month, days_in_year public :: day_of_year, day_of_week, to_utc, total_seconds + public :: get_date, get_time public :: operator(+), operator(-) public :: operator(==), operator(/=) public :: operator(<), operator(<=) @@ -22,7 +25,7 @@ module stdlib_datetime !! version: experimental !! !! Represents a specific point in time. - integer :: year = 1 !! Year (1-9999) + integer :: year = 1 !! Year integer :: month = 1 !! Month (1-12) integer :: day = 1 !! Day (1-31) integer :: hour = 0 !! Hour (0-23) @@ -43,15 +46,48 @@ module stdlib_datetime integer :: milliseconds = 0 !! Milliseconds (0-999) end type timedelta_type + type :: date_type + !! version: experimental + !! + !! Represents a calendar date (no time-of-day component). + integer :: year = 1 !! Year + integer :: month = 1 !! Month (1-12) + integer :: day = 1 !! Day (1-31) + end type date_type + + type :: time_type + !! version: experimental + !! + !! Represents a clock time (no date component). + integer :: hour = 0 !! Hour (0-23) + integer :: minute = 0 !! Minute (0-59) + integer :: second = 0 !! Second (0-59) + integer :: millisecond = 0 !! Millisecond (0-999) + integer :: utc_offset_minutes = 0 !! UTC offset in minutes + end type time_type + integer(int64), parameter :: MS_PER_SEC = 1000_int64 integer(int64), parameter :: MS_PER_MIN = 60000_int64 integer(int64), parameter :: MS_PER_HOUR = 3600000_int64 integer(int64), parameter :: MS_PER_DAY = 86400000_int64 + interface datetime + !! version: experimental + !! + !! Create a datetime_type from components or from + !! date_type and time_type. + module procedure datetime_from_components + module procedure datetime_from_date_time + end interface + interface operator(+) module procedure dt_plus_td module procedure td_plus_dt module procedure td_plus_td + module procedure date_plus_td + module procedure td_plus_date + module procedure time_plus_td + module procedure td_plus_time end interface interface operator(-) @@ -59,46 +95,88 @@ module stdlib_datetime module procedure dt_minus_dt module procedure td_minus_td module procedure td_negate + module procedure date_minus_td + module procedure date_minus_date + module procedure time_minus_td + module procedure time_minus_time end interface interface operator(==) module procedure dt_eq module procedure td_eq + module procedure date_eq + module procedure time_eq end interface interface operator(/=) module procedure dt_ne module procedure td_ne + module procedure date_ne + module procedure time_ne end interface interface operator(<) module procedure dt_lt module procedure td_lt + module procedure date_lt + module procedure time_lt end interface interface operator(<=) module procedure dt_le module procedure td_le + module procedure date_le + module procedure time_le end interface interface operator(>) module procedure dt_gt module procedure td_gt + module procedure date_gt + module procedure time_gt end interface interface operator(>=) module procedure dt_ge module procedure td_ge + module procedure date_ge + module procedure time_ge end interface interface is_leap_year module procedure is_leap_year_int module procedure is_leap_year_dt + module procedure is_leap_year_date + end interface + + interface day_of_year + !! version: experimental + !! + !! Return the ordinal day of the year (1-366). + module procedure day_of_year_dt + module procedure day_of_year_date + end interface + + interface day_of_week + !! version: experimental + !! + !! Return ISO weekday (1=Monday ... 7=Sunday). + module procedure day_of_week_dt + module procedure day_of_week_date + end interface + + interface to_utc + !! version: experimental + !! + !! Convert to UTC. + module procedure to_utc_dt + module procedure to_utc_time end interface contains - pure function datetime(year, month, day, hour, minute, & + pure function datetime_from_components(year, month, day, & + hour, minute, & second, millisecond, & utc_offset_minutes) result(dt) !! version: experimental @@ -118,7 +196,56 @@ pure function datetime(year, month, day, hour, minute, & if (present(millisecond)) dt%millisecond = millisecond if (present(utc_offset_minutes)) & dt%utc_offset_minutes = utc_offset_minutes - end function datetime + end function datetime_from_components + + pure function datetime_from_date_time(d, t) result(dt) + !! version: experimental + !! + !! Create a datetime_type from a date_type and an + !! optional time_type. + type(date_type), intent(in) :: d + type(time_type), intent(in), optional :: t + type(datetime_type) :: dt + dt%year = d%year + dt%month = d%month + dt%day = d%day + if (present(t)) then + dt%hour = t%hour + dt%minute = t%minute + dt%second = t%second + dt%millisecond = t%millisecond + dt%utc_offset_minutes = t%utc_offset_minutes + end if + end function datetime_from_date_time + + pure function date(year, month, day) result(d) + !! version: experimental + !! + !! Create a date_type from year, month, day components. + integer, intent(in), optional :: year, month, day + type(date_type) :: d + if (present(year)) d%year = year + if (present(month)) d%month = month + if (present(day)) d%day = day + end function date + + pure function time_of_day(hour, minute, second, & + millisecond, & + utc_offset_minutes) result(t) + !! version: experimental + !! + !! Create a time_type from clock components. + integer, intent(in), optional :: hour, minute, second + integer, intent(in), optional :: millisecond + integer, intent(in), optional :: utc_offset_minutes + type(time_type) :: t + if (present(hour)) t%hour = hour + if (present(minute)) t%minute = minute + if (present(second)) t%second = second + if (present(millisecond)) t%millisecond = millisecond + if (present(utc_offset_minutes)) & + t%utc_offset_minutes = utc_offset_minutes + end function time_of_day pure function timedelta(days, hours, minutes, seconds, & milliseconds) result(td) @@ -174,6 +301,45 @@ pure function epoch() result(dt) dt = datetime_type(1970, 1, 1, 0, 0, 0, 0, 0) end function epoch + function today() result(d) + !! version: experimental + !! + !! Return today's local date. + type(date_type) :: d + integer :: v(8) + call date_and_time(values=v) + d = date_type(v(1), v(2), v(3)) + end function today + + function current_time() result(t) + !! version: experimental + !! + !! Return the current local clock time. + type(time_type) :: t + integer :: v(8) + call date_and_time(values=v) + t = time_type(v(5), v(6), v(7), v(8), v(4)) + end function current_time + + pure function get_date(dt) result(d) + !! version: experimental + !! + !! Extract the date part from a datetime_type. + type(datetime_type), intent(in) :: dt + type(date_type) :: d + d = date_type(dt%year, dt%month, dt%day) + end function get_date + + pure function get_time(dt) result(t) + !! version: experimental + !! + !! Extract the time part from a datetime_type. + type(datetime_type), intent(in) :: dt + type(time_type) :: t + t = time_type(dt%hour, dt%minute, dt%second, & + dt%millisecond, dt%utc_offset_minutes) + end function get_time + pure function dt_plus_td(dt, td) result(res) !! datetime + timedelta type(datetime_type), intent(in) :: dt @@ -230,6 +396,120 @@ pure function td_negate(td) result(res) res = ms_to_td(-td_to_ms(td)) end function td_negate + pure function date_plus_td(d, td) result(res) + !! version: experimental + !! + !! date + timedelta -> date. + !! The full timedelta (days + seconds + milliseconds) is + !! converted to a whole-day count via truncation toward zero; + !! sub-day remainder is discarded. E.g. timedelta(hours=36) + !! adds 1 whole day, timedelta(hours=-36) subtracts 1 whole day. + type(date_type), intent(in) :: d + type(timedelta_type), intent(in) :: td + type(date_type) :: res + integer(int64) :: total_days + total_days = days_from_civil(d%year, d%month, d%day) & + + td_to_ms(td) / MS_PER_DAY + call civil_from_days(total_days, & + res%year, res%month, res%day) + end function date_plus_td + + pure function td_plus_date(td, d) result(res) + !! timedelta + date (commutative) + type(timedelta_type), intent(in) :: td + type(date_type), intent(in) :: d + type(date_type) :: res + res = date_plus_td(d, td) + end function td_plus_date + + pure function date_minus_td(d, td) result(res) + !! date - timedelta -> date. + !! The full timedelta is converted to a whole-day count via + !! truncation toward zero before subtracting. + type(date_type), intent(in) :: d + type(timedelta_type), intent(in) :: td + type(date_type) :: res + integer(int64) :: total_days + total_days = days_from_civil(d%year, d%month, d%day) & + - td_to_ms(td) / MS_PER_DAY + call civil_from_days(total_days, & + res%year, res%month, res%day) + end function date_minus_td + + pure function date_minus_date(d1, d2) result(res) + !! date - date -> timedelta (difference in whole days) + type(date_type), intent(in) :: d1, d2 + type(timedelta_type) :: res + integer(int64) :: diff + diff = days_from_civil(d1%year, d1%month, d1%day) & + - days_from_civil(d2%year, d2%month, d2%day) + res = timedelta_type(int(diff), 0, 0) + end function date_minus_date + + pure function time_plus_td(t, td) result(res) + !! version: experimental + !! + !! time + timedelta -> time (modulo 24-hour wrap). + type(time_type), intent(in) :: t + type(timedelta_type), intent(in) :: td + type(time_type) :: res + integer(int64) :: total_ms, rem + ! Convert time to ms since midnight + total_ms = int(t%hour, int64) * MS_PER_HOUR & + + int(t%minute, int64) * MS_PER_MIN & + + int(t%second, int64) * MS_PER_SEC & + + int(t%millisecond, int64) + ! Add full timedelta (including days) + total_ms = total_ms + td_to_ms(td) + ! Wrap around 24 hours (modulo always non-negative + ! for positive divisor in Fortran) + total_ms = modulo(total_ms, MS_PER_DAY) + res%hour = int(total_ms / MS_PER_HOUR) + rem = mod(total_ms, MS_PER_HOUR) + res%minute = int(rem / MS_PER_MIN) + rem = mod(rem, MS_PER_MIN) + res%second = int(rem / MS_PER_SEC) + res%millisecond = int(mod(rem, MS_PER_SEC)) + res%utc_offset_minutes = t%utc_offset_minutes + end function time_plus_td + + pure function td_plus_time(td, t) result(res) + !! timedelta + time (commutative) + type(timedelta_type), intent(in) :: td + type(time_type), intent(in) :: t + type(time_type) :: res + res = time_plus_td(t, td) + end function td_plus_time + + pure function time_minus_td(t, td) result(res) + !! time - timedelta -> time (modulo 24-hour wrap) + type(time_type), intent(in) :: t + type(timedelta_type), intent(in) :: td + type(time_type) :: res + integer(int64) :: total_ms, rem + total_ms = int(t%hour, int64) * MS_PER_HOUR & + + int(t%minute, int64) * MS_PER_MIN & + + int(t%second, int64) * MS_PER_SEC & + + int(t%millisecond, int64) + total_ms = total_ms - td_to_ms(td) + total_ms = modulo(total_ms, MS_PER_DAY) + res%hour = int(total_ms / MS_PER_HOUR) + rem = mod(total_ms, MS_PER_HOUR) + res%minute = int(rem / MS_PER_MIN) + rem = mod(rem, MS_PER_MIN) + res%second = int(rem / MS_PER_SEC) + res%millisecond = int(mod(rem, MS_PER_SEC)) + res%utc_offset_minutes = t%utc_offset_minutes + end function time_minus_td + + pure function time_minus_time(t1, t2) result(res) + !! time - time -> timedelta (UTC-adjusted difference) + type(time_type), intent(in) :: t1, t2 + type(timedelta_type) :: res + res = ms_to_td(time_to_utc_ms(t1) & + - time_to_utc_ms(t2)) + end function time_minus_time + pure function dt_eq(dt1, dt2) result(res) type(datetime_type), intent(in) :: dt1, dt2 logical :: res @@ -302,6 +582,108 @@ pure function td_ge(td1, td2) result(res) res = td_to_ms(td1) >= td_to_ms(td2) end function td_ge + pure function date_eq(d1, d2) result(res) + type(date_type), intent(in) :: d1, d2 + logical :: res + res = (d1%year == d2%year) .and. (d1%month == d2%month) .and. (d1%day == d2%day) + end function date_eq + + pure function date_ne(d1, d2) result(res) + type(date_type), intent(in) :: d1, d2 + logical :: res + res = (d1%year /= d2%year) .or. (d1%month /= d2%month) .or. (d1%day /= d2%day) + end function date_ne + + pure function date_lt(d1, d2) result(res) + type(date_type), intent(in) :: d1, d2 + logical :: res + if (d1%year /= d2%year) then + res = d1%year < d2%year + else if (d1%month /= d2%month) then + res = d1%month < d2%month + else + res = d1%day < d2%day + end if + end function date_lt + + pure function date_le(d1, d2) result(res) + type(date_type), intent(in) :: d1, d2 + logical :: res + if (d1%year /= d2%year) then + res = d1%year < d2%year + else if (d1%month /= d2%month) then + res = d1%month < d2%month + else + res = d1%day <= d2%day + end if + end function date_le + + pure function date_gt(d1, d2) result(res) + type(date_type), intent(in) :: d1, d2 + logical :: res + if (d1%year /= d2%year) then + res = d1%year > d2%year + else if (d1%month /= d2%month) then + res = d1%month > d2%month + else + res = d1%day > d2%day + end if + end function date_gt + + pure function date_ge(d1, d2) result(res) + type(date_type), intent(in) :: d1, d2 + logical :: res + if (d1%year /= d2%year) then + res = d1%year > d2%year + else if (d1%month /= d2%month) then + res = d1%month > d2%month + else + res = d1%day >= d2%day + end if + end function date_ge + + pure function time_to_normalized_utc_ms(t) result(res) + type(time_type), intent(in) :: t + integer(int64) :: res + res = modulo(time_to_utc_ms(t), 86400_int64 * 1000_int64) + end function time_to_normalized_utc_ms + + pure function time_eq(t1, t2) result(res) + type(time_type), intent(in) :: t1, t2 + logical :: res + res = time_to_normalized_utc_ms(t1) == time_to_normalized_utc_ms(t2) + end function time_eq + + pure function time_ne(t1, t2) result(res) + type(time_type), intent(in) :: t1, t2 + logical :: res + res = time_to_normalized_utc_ms(t1) /= time_to_normalized_utc_ms(t2) + end function time_ne + + pure function time_lt(t1, t2) result(res) + type(time_type), intent(in) :: t1, t2 + logical :: res + res = time_to_normalized_utc_ms(t1) < time_to_normalized_utc_ms(t2) + end function time_lt + + pure function time_le(t1, t2) result(res) + type(time_type), intent(in) :: t1, t2 + logical :: res + res = time_to_normalized_utc_ms(t1) <= time_to_normalized_utc_ms(t2) + end function time_le + + pure function time_gt(t1, t2) result(res) + type(time_type), intent(in) :: t1, t2 + logical :: res + res = time_to_utc_ms(t1) > time_to_utc_ms(t2) + end function time_gt + + pure function time_ge(t1, t2) result(res) + type(time_type), intent(in) :: t1, t2 + logical :: res + res = time_to_utc_ms(t1) >= time_to_utc_ms(t2) + end function time_ge + pure function format_datetime(dt) result(str) !! version: experimental !! @@ -358,6 +740,49 @@ pure function format_timedelta(td) result(str) end if end function format_timedelta + pure function format_date(d) result(str) + !! version: experimental + !! + !! Format a date_type as an ISO 8601 date string. + type(date_type), intent(in) :: d + character(:), allocatable :: str + str = to_string(d%year, '(I4.4)') // '-' // & + to_string(d%month, '(I2.2)') // '-' // & + to_string(d%day, '(I2.2)') + end function format_date + + pure function format_time(t) result(str) + !! version: experimental + !! + !! Format a time_type as an ISO 8601 time string. + type(time_type), intent(in) :: t + character(:), allocatable :: str + integer :: off_h, off_m + + str = to_string(t%hour, '(I2.2)') // ':' // & + to_string(t%minute, '(I2.2)') // ':' // & + to_string(t%second, '(I2.2)') + + if (t%millisecond /= 0) then + str = str // '.' // & + to_string(t%millisecond, '(I3.3)') + end if + + if (t%utc_offset_minutes == 0) then + str = str // 'Z' + else + off_h = abs(t%utc_offset_minutes) / 60 + off_m = mod(abs(t%utc_offset_minutes), 60) + if (t%utc_offset_minutes > 0) then + str = str // '+' + else + str = str // '-' + end if + str = str // to_string(off_h, '(I2.2)') // ':' // & + to_string(off_m, '(I2.2)') + end if + end function format_time + function parse_datetime(str, stat) result(dt) !! version: experimental !! @@ -489,7 +914,9 @@ function parse_datetime(str, stat) result(dt) if (present(stat)) stat = 1 return end if - dt%millisecond = nint(ms_frac * 1000.0_dp) + ! Clamp to [0, 999]: nint can round up to 1000 for values + ! like .9996, keeping millisecond in the documented range. + dt%millisecond = min(999, max(0, nint(ms_frac * 1000.0_dp))) end if if (slen <= ms_end) return @@ -535,6 +962,185 @@ function parse_datetime(str, stat) result(dt) end if end function parse_datetime + function parse_date(str, stat) result(d) + !! version: experimental + !! + !! Parse an ISO 8601 date string (YYYY-MM-DD). + character(len=*), intent(in) :: str + integer, intent(out), optional :: stat + type(date_type) :: d + integer :: slen, ios, max_day + + if (present(stat)) stat = 0 + d = date_type() + slen = len_trim(str) + + ! Require exactly YYYY-MM-DD (10 characters) + if (slen /= 10) then + if (present(stat)) stat = 1 + return + end if + + ! Check required separators + if (str(5:5) /= '-' .or. str(8:8) /= '-') then + if (present(stat)) stat = 1 + return + end if + + read(str(1:4), '(I4)', iostat=ios) d%year + if (ios /= 0) then + if (present(stat)) stat = 1 + return + end if + read(str(6:7), '(I2)', iostat=ios) d%month + if (ios /= 0) then + if (present(stat)) stat = 1 + return + end if + if (d%month < 1 .or. d%month > 12) then + if (present(stat)) stat = 1 + return + end if + read(str(9:10), '(I2)', iostat=ios) d%day + if (ios /= 0) then + if (present(stat)) stat = 1 + return + end if + max_day = days_in_month(d%month, d%year) + if (d%day < 1 .or. d%day > max_day) then + if (present(stat)) stat = 1 + return + end if + end function parse_date + + function parse_time(str, stat) result(t) + !! version: experimental + !! + !! Parse an ISO 8601 time string + !! (HH:MM:SS[.mmm][Z|+HH:MM]). + character(len=*), intent(in) :: str + integer, intent(out), optional :: stat + type(time_type) :: t + integer :: slen, ios, off_h, off_m, ms_end + character(len=1) :: sign_ch + character(len=32) :: tmp_str + real(dp) :: ms_frac + + if (present(stat)) stat = 0 + t = time_type() + slen = len_trim(str) + + ! Minimum: HH:MM:SS (8 characters) + if (slen < 8) then + if (present(stat)) stat = 1 + return + end if + + ! Check required separators + if (str(3:3) /= ':' .or. str(6:6) /= ':') then + if (present(stat)) stat = 1 + return + end if + + read(str(1:2), '(I2)', iostat=ios) t%hour + if (ios /= 0) then + if (present(stat)) stat = 1 + return + end if + if (t%hour < 0 .or. t%hour > 23) then + if (present(stat)) stat = 1 + return + end if + + read(str(4:5), '(I2)', iostat=ios) t%minute + if (ios /= 0) then + if (present(stat)) stat = 1 + return + end if + if (t%minute < 0 .or. t%minute > 59) then + if (present(stat)) stat = 1 + return + end if + + read(str(7:8), '(I2)', iostat=ios) t%second + if (ios /= 0) then + if (present(stat)) stat = 1 + return + end if + if (t%second < 0 .or. t%second > 59) then + if (present(stat)) stat = 1 + return + end if + + if (slen == 8) return + + ms_end = 8 + if (str(9:9) == '.') then + ms_end = 9 + do while (ms_end < slen) + sign_ch = str(ms_end+1:ms_end+1) + if (sign_ch >= '0' .and. sign_ch <= '9') then + ms_end = ms_end + 1 + else + exit + end if + end do + if (ms_end == 9) then + ! "." without following digits + if (present(stat)) stat = 1 + return + end if + tmp_str = '0' // str(9:ms_end) + read(tmp_str, *, iostat=ios) ms_frac + if (ios /= 0) then + if (present(stat)) stat = 1 + return + end if + ! Clamp to [0, 999]: nint can round up to 1000 for values + ! like .9996, keeping millisecond in the documented range. + t%millisecond = min(999, max(0, nint(ms_frac * 1000.0_dp))) + end if + + if (slen <= ms_end) return + + sign_ch = str(ms_end+1:ms_end+1) + if (sign_ch == 'Z' .or. sign_ch == 'z') then + t%utc_offset_minutes = 0 + else if (sign_ch == '+' .or. sign_ch == '-') then + if (slen < ms_end + 6) then + if (present(stat)) stat = 1 + return + end if + read(str(ms_end+2:ms_end+3), '(I2)', & + iostat=ios) off_h + if (ios /= 0) then + if (present(stat)) stat = 1 + return + end if + if (str(ms_end+4:ms_end+4) /= ':') then + if (present(stat)) stat = 1 + return + end if + read(str(ms_end+5:ms_end+6), '(I2)', & + iostat=ios) off_m + if (ios /= 0) then + if (present(stat)) stat = 1 + return + end if + if (off_h < 0 .or. off_h > 23 .or. & + off_m < 0 .or. off_m > 59) then + if (present(stat)) stat = 1 + return + end if + t%utc_offset_minutes = off_h * 60 + off_m + if (sign_ch == '-') & + t%utc_offset_minutes = -t%utc_offset_minutes + else + if (present(stat)) stat = 1 + return + end if + end function parse_time + pure elemental function is_leap_year_int(year) & result(res) !! version: experimental @@ -557,6 +1163,16 @@ pure elemental function is_leap_year_dt(dt) & res = is_leap_year_int(dt%year) end function is_leap_year_dt + pure elemental function is_leap_year_date(d) & + result(res) + !! version: experimental + !! + !! Check if a date's year is a leap year. + type(date_type), intent(in) :: d + logical :: res + res = is_leap_year_int(d%year) + end function is_leap_year_date + pure function days_in_month(month, year) result(d) !! version: experimental !! @@ -583,10 +1199,11 @@ pure function days_in_year(year) result(d) d = merge(366, 365, is_leap_year_int(year)) end function days_in_year - pure function day_of_year(dt) result(doy) + pure function day_of_year_dt(dt) result(doy) !! version: experimental !! - !! Return the ordinal day of the year (1-366). + !! Return the ordinal day of the year (1-366) + !! for a datetime_type. type(datetime_type), intent(in) :: dt integer :: doy integer, parameter :: cum(12) = & @@ -599,12 +1216,31 @@ pure function day_of_year(dt) result(doy) doy = cum(dt%month) + dt%day if (dt%month > 2 .and. is_leap_year_int(dt%year))& doy = doy + 1 - end function day_of_year + end function day_of_year_dt - pure function day_of_week(dt) result(dow) + pure function day_of_year_date(d) result(doy) !! version: experimental !! - !! Return ISO weekday (1=Monday ... 7=Sunday). + !! Return the ordinal day of the year (1-366) + !! for a date_type. + type(date_type), intent(in) :: d + integer :: doy + integer, parameter :: cum(12) = & + [0,31,59,90,120,151,181,212,243,273,304,334] + if (d%month < 1 .or. d%month > 12) then + doy = 0 + return + end if + doy = cum(d%month) + d%day + if (d%month > 2 .and. is_leap_year_int(d%year)) & + doy = doy + 1 + end function day_of_year_date + + pure function day_of_week_dt(dt) result(dow) + !! version: experimental + !! + !! Return ISO weekday (1=Monday ... 7=Sunday) + !! for a datetime_type. type(datetime_type), intent(in) :: dt integer :: dow integer :: y, w @@ -620,16 +1256,54 @@ pure function day_of_week(dt) result(dow) w = mod(y + y/4 - y/100 + y/400 & + t(dt%month) + dt%day, 7) dow = mod(w + 6, 7) + 1 - end function day_of_week + end function day_of_week_dt - pure function to_utc(dt) result(utc_dt) + pure function day_of_week_date(d) result(dow) + !! version: experimental + !! + !! Return ISO weekday (1=Monday ... 7=Sunday) + !! for a date_type. + type(date_type), intent(in) :: d + integer :: dow + integer :: y, w + integer, parameter :: t(12) = & + [0, 3, 2, 5, 0, 3, 5, 1, 4, 6, 2, 4] + if (d%month < 1 .or. d%month > 12) then + dow = 0 + return + end if + y = d%year + if (d%month < 3) y = y - 1 + w = mod(y + y/4 - y/100 + y/400 & + + t(d%month) + d%day, 7) + dow = mod(w + 6, 7) + 1 + end function day_of_week_date + + pure function to_utc_dt(dt) result(utc_dt) !! version: experimental !! !! Convert a datetime to UTC. type(datetime_type), intent(in) :: dt type(datetime_type) :: utc_dt utc_dt = epoch_ms_to_dt(dt_to_utc_ms(dt), 0) - end function to_utc + end function to_utc_dt + + pure function to_utc_time(t) result(utc_t) + !! version: experimental + !! + !! Convert a time_type to UTC (modulo 24 hours). + type(time_type), intent(in) :: t + type(time_type) :: utc_t + integer(int64) :: ms, rem + ms = modulo(time_to_utc_ms(t), MS_PER_DAY) + utc_t%hour = int(ms / MS_PER_HOUR) + rem = mod(ms, MS_PER_HOUR) + utc_t%minute = int(rem / MS_PER_MIN) + rem = mod(rem, MS_PER_MIN) + utc_t%second = int(rem / MS_PER_SEC) + utc_t%millisecond = int(mod(rem, MS_PER_SEC)) + utc_t%utc_offset_minutes = 0 + end function to_utc_time pure function total_seconds(td) result(secs) !! version: experimental @@ -762,4 +1436,15 @@ pure function ms_to_td(ms) result(td) td%milliseconds = int(mod(rem, MS_PER_SEC)) end function ms_to_td + pure function time_to_utc_ms(t) result(ms) + !! Convert time_type to UTC milliseconds since midnight. + type(time_type), intent(in) :: t + integer(int64) :: ms + ms = int(t%hour, int64) * MS_PER_HOUR & + + int(t%minute, int64) * MS_PER_MIN & + + int(t%second, int64) * MS_PER_SEC & + + int(t%millisecond, int64) & + - int(t%utc_offset_minutes, int64) * MS_PER_MIN + end function time_to_utc_ms + end module stdlib_datetime diff --git a/src/regex/CMakeLists.txt b/src/regex/CMakeLists.txt new file mode 100644 index 000000000..05a711d6e --- /dev/null +++ b/src/regex/CMakeLists.txt @@ -0,0 +1,12 @@ +set(regex_fppFiles + ) + +set(regex_cppFiles + ) + +set(regex_f90Files + stdlib_regex.f90 + ) + +configure_stdlib_target(${PROJECT_NAME}_regex regex_f90Files regex_fppFiles regex_cppFiles) +target_link_libraries(${PROJECT_NAME}_regex PUBLIC ${PROJECT_NAME}_core) diff --git a/test/datetime/test_datetime.f90 b/test/datetime/test_datetime.f90 index e22344c38..001738401 100644 --- a/test/datetime/test_datetime.f90 +++ b/test/datetime/test_datetime.f90 @@ -84,9 +84,84 @@ subroutine collect_datetime(testsuite) new_unittest("year_boundary", & test_year_boundary), & new_unittest("now_returns_valid", & - test_now_valid)] + test_now_valid), & + ! --- date_type tests --- + new_unittest("date_constructor", & + test_date_constructor), & + new_unittest("date_plus_td", & + test_date_plus_td), & + new_unittest("date_minus_td", & + test_date_minus_td), & + new_unittest("date_minus_date", & + test_date_minus_date), & + new_unittest("date_comparison", & + test_date_comparison), & + new_unittest("date_leap_year", & + test_date_leap_year), & + new_unittest("date_day_of_year", & + test_date_day_of_year), & + new_unittest("date_day_of_week", & + test_date_day_of_week), & + new_unittest("format_date_test", & + test_format_date), & + new_unittest("parse_date_test", & + test_parse_date_func), & + new_unittest("parse_date_invalid", & + test_parse_date_invalid), & + new_unittest("today_returns_valid", & + test_today_valid), & + ! --- time_type tests --- + new_unittest("time_constructor", & + test_time_constructor), & + new_unittest("time_plus_td", & + test_time_plus_td), & + new_unittest("time_minus_td", & + test_time_minus_td), & + new_unittest("time_wrap_around", & + test_time_wrap_around), & + new_unittest("time_minus_time", & + test_time_minus_time), & + new_unittest("time_comparison", & + test_time_comparison), & + new_unittest("time_comparison_tz", & + test_time_comparison_tz), & + new_unittest("time_comparison_tz_midnight", & + test_time_comparison_tz_midnight), & + new_unittest("to_utc_time_test", & + test_to_utc_time), & + new_unittest("to_utc_time_midnight", & + test_to_utc_time_midnight), & + new_unittest("format_time_test", & + test_format_time), & + new_unittest("format_time_offset", & + test_format_time_offset), & + new_unittest("parse_time_test", & + test_parse_time_func), & + new_unittest("parse_time_ms", & + test_parse_time_ms), & + new_unittest("parse_time_offset", & + test_parse_time_offset), & + new_unittest("parse_time_invalid", & + test_parse_time_invalid), & + new_unittest("current_time_valid", & + test_current_time_valid), & + new_unittest("parse_date_trailing_junk", & + test_parse_date_trailing_junk), & + new_unittest("date_td_subday", & + test_date_td_subday), & + ! --- integration tests --- + new_unittest("datetime_from_date_time", & + test_datetime_from_date_time), & + new_unittest("get_date_get_time", & + test_get_date_get_time), & + new_unittest("roundtrip_dt_date_time", & + test_roundtrip_dt_date_time)] end subroutine collect_datetime +! ================================================================ +! Existing datetime_type / timedelta_type tests +! ================================================================ + subroutine test_leap_year_basic(error) type(error_type), allocatable, intent(out) :: error call check(error, is_leap_year(2000), & @@ -636,6 +711,696 @@ subroutine test_now_valid(error) if (allocated(error)) return end subroutine test_now_valid +! ================================================================ +! date_type tests +! ================================================================ + +subroutine test_date_constructor(error) + type(error_type), allocatable, intent(out) :: error + type(date_type) :: d + d = date(year=2026, month=4, day=10) + call check(error, d%year == 2026, & + "date year should be 2026") + if (allocated(error)) return + call check(error, d%month == 4, & + "date month should be 4") + if (allocated(error)) return + call check(error, d%day == 10, & + "date day should be 10") + if (allocated(error)) return + ! Test default values + d = date() + call check(error, d%year == 1 .and. & + d%month == 1 .and. d%day == 1, & + "default date should be 0001-01-01") + if (allocated(error)) return +end subroutine test_date_constructor + +subroutine test_date_plus_td(error) + type(error_type), allocatable, intent(out) :: error + type(date_type) :: d, res + type(timedelta_type) :: td + d = date_type(2026, 1, 15) + td = timedelta(days=30) + res = d + td + call check(error, res%month == 2, & + "Jan 15 + 30 days month should be Feb") + if (allocated(error)) return + call check(error, res%day == 14, & + "Jan 15 + 30 days day should be 14") + if (allocated(error)) return + ! Test commutative + res = td + d + call check(error, res%month == 2, & + "td + date should also give February") + if (allocated(error)) return +end subroutine test_date_plus_td + +subroutine test_date_minus_td(error) + type(error_type), allocatable, intent(out) :: error + type(date_type) :: d, res + type(timedelta_type) :: td + d = date_type(2026, 3, 17) + td = timedelta(days=17) + res = d - td + call check(error, res%month == 2, & + "Mar 17 - 17 days month should be Feb") + if (allocated(error)) return + call check(error, res%day == 28, & + "Mar 17 - 17 days day should be 28") + if (allocated(error)) return +end subroutine test_date_minus_td + +subroutine test_date_minus_date(error) + type(error_type), allocatable, intent(out) :: error + type(date_type) :: d1, d2 + type(timedelta_type) :: td + d1 = date_type(2026, 3, 17) + d2 = date_type(2026, 3, 10) + td = d1 - d2 + call check(error, td%days == 7, & + "date difference should be 7 days") + if (allocated(error)) return + call check(error, td%seconds == 0, & + "date difference seconds should be 0") + if (allocated(error)) return + ! Reverse: d2 - d1 should be -7 days + td = d2 - d1 + call check(error, td%days == -7, & + "reversed date diff should be -7 days") + if (allocated(error)) return +end subroutine test_date_minus_date + +subroutine test_date_comparison(error) + type(error_type), allocatable, intent(out) :: error + type(date_type) :: d1, d2 + d1 = date_type(2026, 3, 17) + d2 = date_type(2026, 4, 10) + call check(error, d1 < d2, & + "Mar 17 should be < Apr 10") + if (allocated(error)) return + call check(error, d2 > d1, & + "Apr 10 should be > Mar 17") + if (allocated(error)) return + call check(error, d1 <= d2, & + "Mar 17 should be <= Apr 10") + if (allocated(error)) return + call check(error, d1 /= d2, & + "different dates should be /=") + if (allocated(error)) return + d2 = date_type(2026, 3, 17) + call check(error, d1 == d2, & + "same dates should be ==") + if (allocated(error)) return + call check(error, d1 >= d2, & + "same dates should be >=") + if (allocated(error)) return +end subroutine test_date_comparison + +subroutine test_date_leap_year(error) + type(error_type), allocatable, intent(out) :: error + type(date_type) :: d + d = date_type(2024, 2, 29) + call check(error, is_leap_year(d), & + "2024 date should be a leap year") + if (allocated(error)) return + d = date_type(2026, 6, 15) + call check(error, .not. is_leap_year(d), & + "2026 date should not be a leap year") + if (allocated(error)) return +end subroutine test_date_leap_year + +subroutine test_date_day_of_year(error) + type(error_type), allocatable, intent(out) :: error + type(date_type) :: d + d = date_type(2026, 1, 1) + call check(error, day_of_year(d) == 1, & + "Jan 1 date should be day 1") + if (allocated(error)) return + d = date_type(2026, 3, 17) + call check(error, day_of_year(d) == 76, & + "Mar 17, 2026 date should be day 76") + if (allocated(error)) return + d = date_type(2024, 12, 31) + call check(error, day_of_year(d) == 366, & + "Dec 31, 2024 date should be day 366") + if (allocated(error)) return +end subroutine test_date_day_of_year + +subroutine test_date_day_of_week(error) + type(error_type), allocatable, intent(out) :: error + type(date_type) :: d + d = date_type(2026, 3, 17) + call check(error, day_of_week(d) == 2, & + "2026-03-17 date should be Tuesday (2)") + if (allocated(error)) return + d = date_type(1970, 1, 1) + call check(error, day_of_week(d) == 4, & + "1970-01-01 date should be Thursday (4)") + if (allocated(error)) return +end subroutine test_date_day_of_week + +subroutine test_format_date(error) + type(error_type), allocatable, intent(out) :: error + type(date_type) :: d + d = date_type(2026, 3, 17) + call check(error, & + format_date(d) == '2026-03-17', & + "format_date should be '2026-03-17'") + if (allocated(error)) return + d = date_type(1, 1, 1) + call check(error, & + format_date(d) == '0001-01-01', & + "format_date should be '0001-01-01'") + if (allocated(error)) return +end subroutine test_format_date + +subroutine test_parse_date_func(error) + type(error_type), allocatable, intent(out) :: error + type(date_type) :: d + integer :: stat + d = parse_date('2026-04-10', stat) + call check(error, stat == 0, & + "parsing '2026-04-10' should succeed") + if (allocated(error)) return + call check(error, d%year == 2026, & + "parsed date year should be 2026") + if (allocated(error)) return + call check(error, d%month == 4, & + "parsed date month should be 4") + if (allocated(error)) return + call check(error, d%day == 10, & + "parsed date day should be 10") + if (allocated(error)) return +end subroutine test_parse_date_func + +subroutine test_parse_date_invalid(error) + type(error_type), allocatable, intent(out) :: error + type(date_type) :: d + integer :: stat + d = parse_date('bad', stat) + call check(error, stat /= 0, & + "parsing 'bad' date should fail") + if (allocated(error)) return + d = parse_date('2026-13-01', stat) + call check(error, stat /= 0, & + "parsing month 13 should fail") + if (allocated(error)) return + d = parse_date('2026-02-29', stat) + call check(error, stat /= 0, & + "parsing Feb 29 in non-leap year should fail") + if (allocated(error)) return +end subroutine test_parse_date_invalid + +subroutine test_today_valid(error) + type(error_type), allocatable, intent(out) :: error + type(date_type) :: d + d = today() + call check(error, & + d%year >= 1 .and. d%year <= 9999, & + "today() year should be in valid range") + if (allocated(error)) return + call check(error, & + d%month >= 1 .and. d%month <= 12, & + "today() month should be in valid range") + if (allocated(error)) return + call check(error, & + d%day >= 1 .and. d%day <= 31, & + "today() day should be in valid range") + if (allocated(error)) return +end subroutine test_today_valid + +! ================================================================ +! time_type tests +! ================================================================ + +subroutine test_time_constructor(error) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t + t = time_of_day(hour=14, minute=30, second=45, & + millisecond=500) + call check(error, t%hour == 14, & + "time hour should be 14") + if (allocated(error)) return + call check(error, t%minute == 30, & + "time minute should be 30") + if (allocated(error)) return + call check(error, t%second == 45, & + "time second should be 45") + if (allocated(error)) return + call check(error, t%millisecond == 500, & + "time millisecond should be 500") + if (allocated(error)) return + ! Default + t = time_of_day() + call check(error, t%hour == 0 .and. & + t%minute == 0 .and. t%second == 0, & + "default time should be 00:00:00") + if (allocated(error)) return +end subroutine test_time_constructor + +subroutine test_time_plus_td(error) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t, res + type(timedelta_type) :: td + t = time_type(10, 0, 0, 0, 0) + td = timedelta(hours=3) + res = t + td + call check(error, res%hour == 13, & + "10:00 + 3h should be 13:00") + if (allocated(error)) return + call check(error, res%minute == 0, & + "10:00 + 3h minute should be 0") + if (allocated(error)) return + ! Commutative + res = td + t + call check(error, res%hour == 13, & + "td + time should also give 13:00") + if (allocated(error)) return +end subroutine test_time_plus_td + +subroutine test_time_minus_td(error) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t, res + type(timedelta_type) :: td + t = time_type(10, 30, 0, 0, 0) + td = timedelta(hours=2, minutes=15) + res = t - td + call check(error, res%hour == 8, & + "10:30 - 2h15m hour should be 8") + if (allocated(error)) return + call check(error, res%minute == 15, & + "10:30 - 2h15m minute should be 15") + if (allocated(error)) return +end subroutine test_time_minus_td + +subroutine test_time_wrap_around(error) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t, res + type(timedelta_type) :: td + ! Wrap forward past midnight + t = time_type(23, 0, 0, 0, 0) + td = timedelta(hours=3) + res = t + td + call check(error, res%hour == 2, & + "23:00 + 3h should wrap to 02:00") + if (allocated(error)) return + ! Wrap backward past midnight + t = time_type(1, 0, 0, 0, 0) + td = timedelta(hours=3) + res = t - td + call check(error, res%hour == 22, & + "01:00 - 3h should wrap to 22:00") + if (allocated(error)) return + ! Wrap with days + t = time_type(12, 0, 0, 0, 0) + td = timedelta(days=2, hours=6) + res = t + td + call check(error, res%hour == 18, & + "12:00 + 2d6h should wrap to 18:00") + if (allocated(error)) return +end subroutine test_time_wrap_around + +subroutine test_time_minus_time(error) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t1, t2 + type(timedelta_type) :: td + t1 = time_type(14, 30, 0, 0, 0) + t2 = time_type(10, 0, 0, 0, 0) + td = t1 - t2 + call check(error, td%days == 0, & + "14:30 - 10:00 days should be 0") + if (allocated(error)) return + call check(error, td%seconds == 16200, & + "14:30 - 10:00 should be 16200 seconds") + if (allocated(error)) return +end subroutine test_time_minus_time + +subroutine test_time_comparison(error) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t1, t2 + t1 = time_type(10, 0, 0, 0, 0) + t2 = time_type(14, 30, 0, 0, 0) + call check(error, t1 < t2, & + "10:00 should be < 14:30") + if (allocated(error)) return + call check(error, t2 > t1, & + "14:30 should be > 10:00") + if (allocated(error)) return + call check(error, t1 /= t2, & + "different times should be /=") + if (allocated(error)) return + t2 = time_type(10, 0, 0, 0, 0) + call check(error, t1 == t2, & + "same times should be ==") + if (allocated(error)) return +end subroutine test_time_comparison + +subroutine test_time_comparison_tz(error) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t1, t2 + ! 12:00 UTC == 17:30 +05:30 + t1 = time_type(12, 0, 0, 0, 0) + t2 = time_type(17, 30, 0, 0, 330) + call check(error, t1 == t2, & + "12:00Z should equal 17:30+05:30") + if (allocated(error)) return +end subroutine test_time_comparison_tz + +subroutine test_time_comparison_tz_midnight(error) + !! Tests timezone comparison that crosses midnight: + !! 23:00 UTC-05:00 after modulo-24h normalisation maps to + !! 04:00 UTC, which should compare equal to time_type(4,0,0,0,0). + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t1, t2 + ! time_eq uses time_to_normalized_utc_ms (modulo 86400000 ms). + ! 23:00 UTC-05:00 raw UTC ms = 100800000 + ! modulo(100800000, 86400000) = 14400000 (04:00 UTC) + ! 04:00Z raw UTC ms = 14400000 + ! modulo(14400000, 86400000) = 14400000 + ! --> they ARE equal after midnight-wrap normalization. + t1 = time_type(23, 0, 0, 0, -300) ! 23:00 UTC-05:00 + t2 = time_type(4, 0, 0, 0, 0) ! 04:00 UTC + call check(error, t1 == t2, & + "23:00-05:00 should equal 04:00Z after midnight-wrap") + if (allocated(error)) return + ! Verify a genuinely different time is NOT equal + t2 = time_type(5, 0, 0, 0, 0) ! 05:00 UTC + call check(error, .not. (t1 == t2), & + "23:00-05:00 should NOT equal 05:00Z") + if (allocated(error)) return + ! Same-day sanity: 06:00-02:00 == 08:00Z + t1 = time_type(6, 0, 0, 0, -120) ! 06:00 UTC-02:00 + t2 = time_type(8, 0, 0, 0, 0) ! 08:00 UTC + call check(error, t1 == t2, & + "06:00-02:00 should equal 08:00Z") + if (allocated(error)) return +end subroutine test_time_comparison_tz_midnight + +subroutine test_to_utc_time(error) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t, utc_t + t = time_type(17, 30, 0, 0, 330) + utc_t = to_utc(t) + call check(error, utc_t%hour == 12, & + "to_utc time hour should be 12") + if (allocated(error)) return + call check(error, utc_t%minute == 0, & + "to_utc time minute should be 0") + if (allocated(error)) return + call check(error, utc_t%utc_offset_minutes == 0, & + "to_utc time offset should be 0") + if (allocated(error)) return +end subroutine test_to_utc_time + +subroutine test_to_utc_time_midnight(error) + !! 23:00 UTC-05:00 -> 04:00 UTC (crosses midnight) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t, utc_t + t = time_type(23, 0, 0, 0, -300) + utc_t = to_utc(t) + call check(error, utc_t%hour == 4, & + "to_utc 23:00-05:00 should give 04:00 UTC") + if (allocated(error)) return + call check(error, utc_t%minute == 0, & + "to_utc midnight crossing minute should be 0") + if (allocated(error)) return + call check(error, utc_t%utc_offset_minutes == 0, & + "to_utc midnight crossing offset should be 0") + if (allocated(error)) return +end subroutine test_to_utc_time_midnight + +subroutine test_format_time(error) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t + t = time_type(12, 30, 45, 0, 0) + call check(error, & + format_time(t) == '12:30:45Z', & + "format_time should be '12:30:45Z'") + if (allocated(error)) return + t = time_type(9, 5, 3, 500, 0) + call check(error, & + format_time(t) == '09:05:03.500Z', & + "format_time with ms should be '09:05:03.500Z'") + if (allocated(error)) return +end subroutine test_format_time + +subroutine test_format_time_offset(error) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t + t = time_type(17, 30, 0, 0, 330) + call check(error, & + format_time(t) == '17:30:00+05:30', & + "format_time offset should be '17:30:00+05:30'") + if (allocated(error)) return + t = time_type(6, 0, 0, 0, -300) + call check(error, & + format_time(t) == '06:00:00-05:00', & + "format_time neg offset should be '06:00:00-05:00'") + if (allocated(error)) return +end subroutine test_format_time_offset + +subroutine test_parse_time_func(error) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t + integer :: stat + t = parse_time('14:30:45', stat) + call check(error, stat == 0, & + "parsing '14:30:45' should succeed") + if (allocated(error)) return + call check(error, t%hour == 14, & + "parsed time hour should be 14") + if (allocated(error)) return + call check(error, t%minute == 30, & + "parsed time minute should be 30") + if (allocated(error)) return + call check(error, t%second == 45, & + "parsed time second should be 45") + if (allocated(error)) return +end subroutine test_parse_time_func + +subroutine test_parse_time_ms(error) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t + integer :: stat + t = parse_time('09:05:03.500Z', stat) + call check(error, stat == 0, & + "parsing time with ms should succeed") + if (allocated(error)) return + call check(error, t%hour == 9, & + "parsed time hour should be 9") + if (allocated(error)) return + call check(error, t%millisecond == 500, & + "parsed time ms should be 500") + if (allocated(error)) return + call check(error, t%utc_offset_minutes == 0, & + "parsed time offset should be 0") + if (allocated(error)) return +end subroutine test_parse_time_ms + +subroutine test_parse_time_offset(error) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t + integer :: stat + t = parse_time('17:30:00+05:30', stat) + call check(error, stat == 0, & + "parsing time with offset should succeed") + if (allocated(error)) return + call check(error, t%hour == 17, & + "parsed time hour should be 17") + if (allocated(error)) return + call check(error, t%minute == 30, & + "parsed time minute should be 30") + if (allocated(error)) return + call check(error, t%utc_offset_minutes == 330, & + "parsed time offset should be 330") + if (allocated(error)) return +end subroutine test_parse_time_offset + +subroutine test_parse_time_invalid(error) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t + integer :: stat + t = parse_time('bad', stat) + call check(error, stat /= 0, & + "parsing 'bad' time should fail") + if (allocated(error)) return + t = parse_time('25:00:00', stat) + call check(error, stat /= 0, & + "parsing hour 25 should fail") + if (allocated(error)) return + t = parse_time('12:60:00', stat) + call check(error, stat /= 0, & + "parsing minute 60 should fail") + if (allocated(error)) return +end subroutine test_parse_time_invalid + +subroutine test_current_time_valid(error) + type(error_type), allocatable, intent(out) :: error + type(time_type) :: t + t = current_time() + call check(error, & + t%hour >= 0 .and. t%hour <= 23, & + "current_time() hour should be in range") + if (allocated(error)) return + call check(error, & + t%minute >= 0 .and. t%minute <= 59, & + "current_time() minute should be in range") + if (allocated(error)) return +end subroutine test_current_time_valid + +! ================================================================ +! Integration tests +! ================================================================ + +subroutine test_datetime_from_date_time(error) + type(error_type), allocatable, intent(out) :: error + type(date_type) :: d + type(time_type) :: t + type(datetime_type) :: dt + d = date_type(2026, 4, 10) + t = time_type(14, 30, 0, 0, 330) + dt = datetime(d, t) + call check(error, dt%year == 2026, & + "composed datetime year should be 2026") + if (allocated(error)) return + call check(error, dt%month == 4, & + "composed datetime month should be 4") + if (allocated(error)) return + call check(error, dt%day == 10, & + "composed datetime day should be 10") + if (allocated(error)) return + call check(error, dt%hour == 14, & + "composed datetime hour should be 14") + if (allocated(error)) return + call check(error, dt%minute == 30, & + "composed datetime minute should be 30") + if (allocated(error)) return + call check(error, dt%utc_offset_minutes == 330, & + "composed datetime offset should be 330") + if (allocated(error)) return + ! datetime from date only (time defaults to midnight) + dt = datetime(d) + call check(error, dt%hour == 0 .and. & + dt%minute == 0 .and. dt%second == 0, & + "datetime from date only should be midnight") + if (allocated(error)) return +end subroutine test_datetime_from_date_time + +subroutine test_get_date_get_time(error) + type(error_type), allocatable, intent(out) :: error + type(datetime_type) :: dt + type(date_type) :: d + type(time_type) :: t + dt = datetime_type(2026, 4, 10, 14, 30, 45, 500, 330) + d = get_date(dt) + call check(error, d%year == 2026, & + "get_date year should be 2026") + if (allocated(error)) return + call check(error, d%month == 4, & + "get_date month should be 4") + if (allocated(error)) return + call check(error, d%day == 10, & + "get_date day should be 10") + if (allocated(error)) return + t = get_time(dt) + call check(error, t%hour == 14, & + "get_time hour should be 14") + if (allocated(error)) return + call check(error, t%minute == 30, & + "get_time minute should be 30") + if (allocated(error)) return + call check(error, t%second == 45, & + "get_time second should be 45") + if (allocated(error)) return + call check(error, t%millisecond == 500, & + "get_time millisecond should be 500") + if (allocated(error)) return + call check(error, t%utc_offset_minutes == 330, & + "get_time offset should be 330") + if (allocated(error)) return +end subroutine test_get_date_get_time + +subroutine test_roundtrip_dt_date_time(error) + type(error_type), allocatable, intent(out) :: error + type(datetime_type) :: dt1, dt2 + type(date_type) :: d + type(time_type) :: t + ! Decompose and recompose, should be identical + dt1 = datetime_type(2026, 4, 10, 14, 30, 45, 500, 330) + d = get_date(dt1) + t = get_time(dt1) + dt2 = datetime(d, t) + call check(error, dt1 == dt2, & + "roundtrip datetime should be equal") + if (allocated(error)) return + call check(error, dt2%year == 2026, & + "roundtrip year should be 2026") + if (allocated(error)) return + call check(error, dt2%millisecond == 500, & + "roundtrip ms should be 500") + if (allocated(error)) return + call check(error, dt2%utc_offset_minutes == 330, & + "roundtrip offset should be 330") + if (allocated(error)) return +end subroutine test_roundtrip_dt_date_time + +! ================================================================ +! Additional regression tests for Copilot-flagged issues +! ================================================================ + +subroutine test_parse_date_trailing_junk(error) + !! parse_date must reject strings longer than 10 chars + !! (e.g. '2026-04-10junk') that were previously silently accepted. + type(error_type), allocatable, intent(out) :: error + type(date_type) :: d + integer :: stat + d = parse_date('2026-04-10junk', stat) + call check(error, stat /= 0, & + "parse_date should reject '2026-04-10junk' (trailing chars)") + if (allocated(error)) return + d = parse_date('2026-04-10 ', stat) + call check(error, stat == 0, & + "parse_date should accept '2026-04-10 ' (trailing spaces stripped)") + if (allocated(error)) return +end subroutine test_parse_date_trailing_junk + +subroutine test_date_td_subday(error) + !! date +/- timedelta should account for sub-day components. + !! timedelta(hours=36) = 1 whole day + 12 hours; + !! date arithmetic uses td_to_ms/MS_PER_DAY truncation. + type(error_type), allocatable, intent(out) :: error + type(date_type) :: d, res + type(timedelta_type) :: td + d = date_type(2026, 1, 15) + ! 36 hours -> 1 whole day (129600000 ms / 86400000 ms = 1) + td = timedelta(hours=36) + res = d + td + call check(error, res%month == 1, & + "Jan 15 + 36h (1 day) month should be Jan") + if (allocated(error)) return + call check(error, res%day == 16, & + "Jan 15 + 36h (1 day) day should be 16") + if (allocated(error)) return + ! Subtract 36 hours -> subtract 1 whole day + res = d - td + call check(error, res%month == 1, & + "Jan 15 - 36h (1 day) month should be Jan") + if (allocated(error)) return + call check(error, res%day == 14, & + "Jan 15 - 36h (1 day) day should be 14") + if (allocated(error)) return + ! 23 hours -> 0 whole days (sub-day, truncated) + td = timedelta(hours=23) + res = d + td + call check(error, res%month == 1, & + "Jan 15 + 23h (0 days) month should be Jan") + if (allocated(error)) return + call check(error, res%day == 15, & + "Jan 15 + 23h (0 days) day should stay 15") + if (allocated(error)) return +end subroutine test_date_td_subday + end module test_datetime