From d432f3cfa297c9499a5dc0d3ef40376e8ddf6ccc Mon Sep 17 00:00:00 2001 From: Samuel Smith Date: Sat, 23 Aug 2025 12:24:11 -0500 Subject: [PATCH 1/2] Test fixes for locales without am/pm --- Piece.pm | 13 +++++------ Piece.xs | 7 +++++- t/02core.t | 2 +- t/02core_dst.t | 6 +++-- t/06large.t | 2 +- t/09locales.t | 30 ++++++++++++++++--------- t/11strptime_defaults.t | 49 +++++++++++++++++++++++++---------------- 7 files changed, 68 insertions(+), 41 deletions(-) diff --git a/Piece.pm b/Piece.pm index 36bb658..f43164c 100644 --- a/Piece.pm +++ b/Piece.pm @@ -509,16 +509,15 @@ my $strftime_trans_map = { 'k' => sub { my ( $format, $time ) = @_; my $hr = sprintf( "%2d", $time->[c_hour] ); - $format =~ s/%k/$hr/ if $IS_WIN32; + $format =~ s/%k/$hr/; return $format; }, 'l' => sub { my ( $format, $time ) = @_; - if ($IS_WIN32) { - my $hr = $time->[c_hour] > 12 ? $time->[c_hour] - 12 : $time->[c_hour]; - $hr = sprintf( "%2d", $hr ); - $format =~ s/%l/$hr/ if $IS_WIN32; - } + my $hr = $time->[c_hour] > 12 ? $time->[c_hour] - 12 : $time->[c_hour]; + $hr = 12 unless $hr; + $hr = sprintf( "%2d", $hr ); + $format =~ s/%l/$hr/; return $format; }, 'P' => sub { @@ -854,7 +853,7 @@ my $_format_cache = {}; #accordance with the logic from the translation map subroutines sub _translate_format { my ( $format, $trans_map, $time ) = @_; - my $bad_flags = $IS_WIN32 ? qr/%([eklsVzZ])/ : qr/%([szZ])/; + my $bad_flags = $IS_WIN32 ? qr/%([eklsVzZ])/ : qr/%([klszZ])/; my $can_cache = ($format !~ $bad_flags) ? 1 : 0; if ( $can_cache && exists $_format_cache->{$format} ){ diff --git a/Piece.xs b/Piece.xs index 90cb78f..62ef667 100644 --- a/Piece.xs +++ b/Piece.xs @@ -437,7 +437,12 @@ label: break; case 'r': - buf = _strptime(aTHX_ buf, "%I:%M:%S %p", tm, got_GMT); + if (Locale->AM && strlen(Locale->AM) > 0 && + Locale->PM && strlen(Locale->PM) > 0) { + buf = _strptime(aTHX_ buf, "%I:%M:%S %p", tm, got_GMT); + } else { + buf = _strptime(aTHX_ buf, "%H:%M:%S", tm, got_GMT); + } if (buf == 0) return 0; break; diff --git a/t/02core.t b/t/02core.t index bbe518e..52c58e4 100644 --- a/t/02core.t +++ b/t/02core.t @@ -49,7 +49,7 @@ if (defined &Win32::GetCurrentProcessId } SKIP: { skip "can't register TZ changes in a pseudo-fork", 2 if $is_pseudo_fork; - local $ENV{TZ} = "EST5EDT"; + local $ENV{TZ} = "EST5EDT4,M3.2.0/2,M11.1.0/2"; Time::Piece::_tzset(); # register the environment change my $lt = localtime(1735880528); #2025-01-03T05:02:08 cmp_ok(scalar($lt->tzoffset), 'eq', '-18000'); diff --git a/t/02core_dst.t b/t/02core_dst.t index cf6806a..972e997 100644 --- a/t/02core_dst.t +++ b/t/02core_dst.t @@ -3,7 +3,7 @@ use Test::More; # Skip if doing a regular install # Avoids mystery DST bugs [rt 128240], [GH40] plan skip_all => "DST tests not required for installation" - unless ( $ENV{AUTOMATED_TESTING} ); + unless ( $ENV{AUTOMATED_TESTING} || $ENV{NONINTERACTIVE_TESTING} || $ENV{PERL_BATCH} ); my $is_win32 = ($^O =~ /Win32/); my $is_qnx = ($^O eq 'qnx'); @@ -118,6 +118,8 @@ ok(not $t->is_leap_year); # should test more with different dates cmp_ok($t->month_last_day, '==', 31); # test more +cmp_ok(gmtime(1755648001)->strftime("%I %k %H %l"), 'eq', "12 0 00 12"); # 8/20/25 0:0:1 These should be 12 or 0 + SKIP: { skip "Extra tests for Linux, BSD only.", 9 unless $is_linux or $is_mac or $is_bsd; @@ -138,4 +140,4 @@ SKIP: { is ($lt->strftime("%s"), 1357733231, 'Epoch output is the same with EST'); } -done_testing(59); +done_testing(60); diff --git a/t/06large.t b/t/06large.t index 73a47f9..dbc62e2 100644 --- a/t/06large.t +++ b/t/06large.t @@ -8,7 +8,7 @@ use Time::Seconds; my $is_win32 = ( $^O =~ /Win32/ ); plan skip_all => "Large time tests not required for installation" - unless ( $ENV{AUTOMATED_TESTING} ); + unless ( $ENV{AUTOMATED_TESTING} || $ENV{NONINTERACTIVE_TESTING} || $ENV{PERL_BATCH} ); my $t = gmtime; diff --git a/t/09locales.t b/t/09locales.t index 2dbe8e3..8770519 100644 --- a/t/09locales.t +++ b/t/09locales.t @@ -4,7 +4,7 @@ use Time::Piece; # Skip if doing a regular install # These are mostly for reverse parsing tests, not required for installation plan skip_all => "Reverse parsing not required for installation" - unless ( $ENV{AUTOMATED_TESTING} ); + unless ( $ENV{AUTOMATED_TESTING} || $ENV{NONINTERACTIVE_TESTING} || $ENV{PERL_BATCH} ); my $t = gmtime(1373371631); # 2013-07-09T12:07:11 @@ -56,15 +56,12 @@ my @dates = ( '%A, %e %B %Y at %H:%M:%S', '%a, %e %b %Y at %r', '%s', - '%c', '%F %T', '%D %r', #TODO # '%u %U %Y %T', #%U,W,V currently skipped inside strptime # '%w %W %y %T', - '%A, %e %B %Y at %I:%M:%S %P', #%I and %p can be locale dependant - '%x %X', #hard coded to American localization ); for my $time ( @@ -76,8 +73,17 @@ for my $time ( my $t = gmtime($time); for my $strp_format (@dates) { + my $t_str = $t->strftime($strp_format); - my $parsed = $t->strptime( $t_str, $strp_format ); + my $parsed; + + eval { $parsed = $t->strptime( $t_str, $strp_format ); }; + + if ($@) { + warn("strptime failed with time $t_str and format $strp_format"); + warn($@); + next; + } check_parsed( $t, $parsed, $t_str, $strp_format ); } @@ -95,14 +101,18 @@ for my $time ( my $t_str = $t->strftime($strp_format); my $parsed; - SKIP: { - eval { $parsed = $t->strptime( $t_str, $strp_format ); }; - skip "localtime strptime parse failed", 3 if $@; - check_parsed( $t, $parsed, $t_str, $strp_format ); + + eval { $parsed = $t->strptime( $t_str, $strp_format ); }; + + if ($@) { + warn("strptime failed with time $t_str and format $strp_format"); + warn($@); + next; } + check_parsed( $t, $parsed, $t_str, $strp_format ); } } -done_testing(190); +done_testing(136); diff --git a/t/11strptime_defaults.t b/t/11strptime_defaults.t index 734871d..13b6362 100644 --- a/t/11strptime_defaults.t +++ b/t/11strptime_defaults.t @@ -1,6 +1,7 @@ #!/usr/bin/perl -w -use Test::More tests => 128; +use Test::More tests => 129; +my $is_linux = ($^O =~ /linux/); BEGIN { use_ok('Time::Piece'); } @@ -297,24 +298,6 @@ my @known_localtime = localtime(1753440879); is( $tp->sec, $tp_defaults->sec, "Shorthand: Second taken from object" ); } -# Test shorthand syntax - format defaults to $DATE_FORMAT -{ - my $tp_defaults = localtime(1753440879); - - # Using default format "%a, %d %b %Y %H:%M:%S %Z" - my $input_string = $tp_defaults->strftime(); - - # Replace specific parts to test parsing - $input_string =~ s/Jul/Mar/; - $input_string =~ s/25/15/; - - my $tp = Time::Piece->strptime( $input_string, $tp_defaults ); - - is( $tp->mday, 15, "Shorthand no format: Day is correctly parsed" ); - is( $tp->mon, 3, "Shorthand no format: Month is correctly parsed" ); - is( $tp->year, 2025, "Shorthand no format: Year taken from defaults" ); -} - # Test shorthand syntax - c_islocal copying { my $tp1 = @@ -462,3 +445,31 @@ my @known_localtime = localtime(1753440879); "No format, error: Correct error message" ); } + +# Test shorthand syntax - format defaults to $DATE_FORMAT +SKIP: { + skip "Default format tests for Linux only.", 4 + unless $is_linux + && ( $ENV{AUTOMATED_TESTING} + || $ENV{NONINTERACTIVE_TESTING} + || $ENV{PERL_BATCH} ); + + Time::Piece->use_locale(); + + my $tp_defaults = localtime(1753440879); + + # Using default format "%a, %d %b %Y %H:%M:%S %Z" + my $input_string = $tp_defaults->strftime(); + + # Replace specific parts to test parsing + $input_string =~ s/25/15/; + + my $tp = Time::Piece->strptime( $input_string, $tp_defaults ); + + is( $tp->mday, 15, "Shorthand no format: Day is correctly parsed" ); + is( $tp->mon, 7, "Shorthand no format: Month is correctly parsed" ); + is( $tp->year, 2025, "Shorthand no format: Year taken from defaults" ); + is( $tp->[Time::Piece::c_islocal], + 1, "Shorthand no format, object copied local" ); +} + From 59a9f9c6c0230cd2f99cdcefc5c4492158ff3d6a Mon Sep 17 00:00:00 2001 From: Samuel Smith Date: Sat, 23 Aug 2025 12:25:15 -0500 Subject: [PATCH 2/2] Add warnings for some parse failures --- Piece.xs | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/Piece.xs b/Piece.xs index 62ef667..1c38b88 100644 --- a/Piece.xs +++ b/Piece.xs @@ -359,8 +359,10 @@ _strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm, int *got_GMT) if (isspace((unsigned char)c)) while (*buf != 0 && isspace((unsigned char)*buf)) buf++; - else if (c != *buf++) + else if (c != *buf++) { + warn("Time string mismatches format string"); return 0; + } continue; } @@ -544,8 +546,10 @@ label: if (c == 'H' || c == 'k') { if (i > 23) return 0; - } else if (i > 12) + } else if (i > 12) { + warn("Hour cannot be >12 with %%I or %%l"); return 0; + } tm->tm_hour = i; @@ -563,8 +567,11 @@ label: len = strlen(Locale->am); if (strncasecmp(buf, Locale->am, len) == 0 || strncasecmp(buf, Locale->AM, len) == 0) { - if (tm->tm_hour > 12) + if (tm->tm_hour > 12) { + warn("Hour cannot be >12 with %%p"); return 0; + } + if (tm->tm_hour == 12) tm->tm_hour = 0; buf += len; @@ -574,14 +581,17 @@ label: len = strlen(Locale->pm); if (strncasecmp(buf, Locale->pm, len) == 0 || strncasecmp(buf, Locale->PM, len) == 0) { - if (tm->tm_hour > 12) + if (tm->tm_hour > 12) { + warn("Hour cannot be >12 with %%p"); return 0; + } if (tm->tm_hour != 12) tm->tm_hour += 12; buf += len; break; } + warn("Failed parsing %%p"); return 0; case 'A':