Ok, that patch did not handle years down to 1901. Attached is a new patch, and a proper test script.
Currently strptime() does not actually return year-1900 for dates prior to January 1, 1901. I'm guessing this is because some code somewhere can not handle zero or negative "year" values (i.e. -1 for the year 1899).
The new patch has to take that into account, and the corresponding test cases are "skipped".
Best,
-Jim
diff -Naur /usr/share/perl5/Date/Parse.pm /tmp/new/Date/Parse.pm
--- /usr/share/perl5/Date/Parse.pm 2014-04-26 01:05:35.000000000 -0700
+++ /tmp/new/Date/Parse.pm 2018-12-29 17:52:24.402900266 -0800
@@ -252,6 +252,14 @@
$year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5]
unless(defined $year);
+ # Must use 4-digit year with Time::Local::timegm to prevent fiddling.
+ #
+ # However, currently strptime() actually returns the full year, not
+ # year-1900, for years before 1901. In other words, it never returns zero or
+ # a negative value. If strptime() is someday changed to return zero/neg
+ # values then this should be changed to $yyyy = $year+1900 always.
+ my $yyyy = $year < 1900 ? $year+1900 : $year;
+
return undef
unless($month <= 11 && $day >= 1 && $day <= 31
&& $hh <= 23 && $mm <= 59 && $ss <= 59);
@@ -261,7 +269,7 @@
if (defined $zone) {
$result = eval {
local $SIG{__DIE__} = sub {}; # Ick!
- timegm($ss,$mm,$hh,$day,$month,$year);
+ timegm($ss,$mm,$hh,$day,$month,$yyyy);
};
return undef
if !defined $result
@@ -273,7 +281,7 @@
else {
$result = eval {
local $SIG{__DIE__} = sub {}; # Ick!
- timelocal($ss,$mm,$hh,$day,$month,$year);
+ timelocal($ss,$mm,$hh,$day,$month,$yyyy);
};
return undef
if !defined $result
#!/usr/bin/perl
use strict; use warnings; use feature qw(state say);
use Test::More tests => 3;
# Tester for Date::Parse bug which caused certain years to be off by 100
## FIXME
use lib '/tmp/new'; # point to the patched version
use Date::Parse qw(str2time);
use POSIX qw(strftime);
use Time::Local qw(timegm timegm);
my $maxerrs = 10;
my $fmt = "%Y-%m-%dT%H:%M:%SZ"; # ISO-8801
sub test($$$$$$$;$) {
my ($seenhash, $isec, $imin, $ihr, $imday, $imon, $iyear, $verbose) = @_;
my $bugs = 0;
my $str = POSIX::strftime($fmt, $isec,$imin,$ihr,$imday,$imon,$iyear-1900);
my $t = str2time($str,0);
return(0)
unless defined $t; # if it knows it can't handle it, that's ok
if ($seenhash->{$t}) {
diag("str2time produced the same result ($t) for\n",
" $seenhash->{$t} and\n",
" $str\n");
$bugs++;
}
$seenhash->{$t} = $str;
my ($sec,$min,$hr,$mday,$mon,$yminus1900) = gmtime($t);
my $str2 = POSIX::strftime($fmt, $sec,$min,$hr,$mday,$mon,$yminus1900);
if ($str ne $str2) {
diag("str2time('$str',0)=$t and gmtime(...)=($sec,$min,$hr,$mday,$mon,$yminus1900);\n",
" but strftime(...) = '$str2'\n");
$bugs++;
}
print "## strftime($isec, $imin, $ihr, $imday, $imon, $iyear-1900=",$iyear-1900,")=$str\n",
"## str2time(...,0) = $t ; gmtime(t)=($sec,$min,$hr,$mday,$mon,$yminus1900)\n"
if $verbose;
$bugs
}
sub flatten($) { ref($_[0]) ? @{$_[0]} : ($_[0]) }
sub test_combos($$$$$$;$) {
my ($asec, $amin, $ahr, $amday, $amon, $ayear, $verbose) = @_;
my %seen;
my $count = 0;
my $bugs = 0;
foreach my $isec (flatten $asec) {
foreach my $imin (flatten $amin) {
foreach my $ihr (flatten $ahr) {
foreach my $imday (flatten $amday) {
foreach my $imon (flatten $amon) {
foreach my $iyear (flatten $ayear) {
$count++;
$bugs += test(\%seen,$isec,$imin,$ihr,$imday,$imon,$iyear,$verbose);
die "too many errors" if $bugs > $maxerrs;
}
}
}
}
}
}
ok($bugs==0, "Test $count combinations");
}
#test_combos(0,0,0,01,0, [1901],1);
#test_combos(0,0,0,01,0, [1900],1);
#test_combos(0,0,0,01,0, [2900],1);
# Some of these cases failed before the patch
test_combos(13,12,11,01,0, [1967..1975, 2066..2075]);
# Now a more exhaustive sequence
test_combos(13,12,11,31,11, [1901..3799]);
SKIP: {
skip "because strptime() does not currently handle years < 1901 (it can not return negative year)",1;
test_combos(13,12,11,31,11, [1..1900]);
}
