summaryrefslogtreecommitdiff
path: root/cpan/Time-Local
diff options
context:
space:
mode:
authorSteve Hay <steve.m.hay@googlemail.com>2020-10-12 17:26:34 +0100
committerSteve Hay <steve.m.hay@googlemail.com>2020-10-12 17:26:34 +0100
commit3485785629a9d0a5fb09c4e1f08f1d22567d7665 (patch)
tree1667e3fe801ce674fa2dc73f5d978192bfa73f8a /cpan/Time-Local
parent048ed1a13e87c617826385b40c9afc93a27c7763 (diff)
downloadperl-3485785629a9d0a5fb09c4e1f08f1d22567d7665.tar.gz
Update Time-Local from version 1.28 to 1.30
Diffstat (limited to 'cpan/Time-Local')
-rw-r--r--cpan/Time-Local/lib/Time/Local.pm117
-rw-r--r--cpan/Time-Local/t/Local.t618
2 files changed, 444 insertions, 291 deletions
diff --git a/cpan/Time-Local/lib/Time/Local.pm b/cpan/Time-Local/lib/Time/Local.pm
index b5a62bb52d..773414f72e 100644
--- a/cpan/Time-Local/lib/Time/Local.pm
+++ b/cpan/Time-Local/lib/Time/Local.pm
@@ -5,13 +5,19 @@ use strict;
use Carp ();
use Exporter;
-our $VERSION = '1.28';
+our $VERSION = '1.30';
use parent 'Exporter';
-our @EXPORT = qw( timegm timelocal );
-our @EXPORT_OK
- = qw( timegm_modern timelocal_modern timegm_nocheck timelocal_nocheck );
+our @EXPORT = qw( timegm timelocal );
+our @EXPORT_OK = qw(
+ timegm_modern
+ timelocal_modern
+ timegm_nocheck
+ timelocal_nocheck
+ timegm_posix
+ timelocal_posix
+);
my @MonthDays = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
@@ -90,7 +96,7 @@ sub _daygm {
- int( $year / 100 )
+ int( $year / 400 )
+ int( ( ( $month * 306 ) + 5 ) / 10 ) ) - $Epoc;
- }
+ }
);
}
@@ -109,7 +115,7 @@ sub timegm {
if ( $Options{no_year_munging} ) {
$year -= 1900;
}
- else {
+ elsif ( !$Options{posix_year} ) {
if ( $year >= 1000 ) {
$year -= 1900;
}
@@ -175,6 +181,11 @@ sub timegm_modern {
return &timegm;
}
+sub timegm_posix {
+ local $Options{posix_year} = 1;
+ return &timegm;
+}
+
sub timelocal {
my $ref_t = &timegm;
my $loc_for_ref_t = _timegm( localtime($ref_t) );
@@ -204,8 +215,8 @@ sub timelocal {
return $loc_t if $dst_off > 0;
- # If the original date was a non-extent gap in a forward DST jump,
- # we should now have the wrong answer - undo the DST adjustment
+ # If the original date was a non-existent gap in a forward DST jump, we
+ # should now have the wrong answer - undo the DST adjustment
my ( $s, $m, $h ) = localtime($loc_t);
$loc_t -= $dst_off if $s != $_[0] || $m != $_[1] || $h != $_[2];
@@ -222,6 +233,11 @@ sub timelocal_modern {
return &timelocal;
}
+sub timelocal_posix {
+ local $Options{posix_year} = 1;
+ return &timelocal;
+}
+
1;
# ABSTRACT: Efficiently compute time from local and GMT time
@@ -238,14 +254,14 @@ Time::Local - Efficiently compute time from local and GMT time
=head1 VERSION
-version 1.28
+version 1.30
=head1 SYNOPSIS
- use Time::Local;
+ use Time::Local qw( timelocal_posix timegm_posix );
- my $time = timelocal( $sec, $min, $hour, $mday, $mon, $year );
- my $time = timegm( $sec, $min, $hour, $mday, $mon, $year );
+ my $time = timelocal_posix( $sec, $min, $hour, $mday, $mon, $year );
+ my $time = timegm_posix( $sec, $min, $hour, $mday, $mon, $year );
=head1 DESCRIPTION
@@ -263,6 +279,32 @@ consistent with the values returned from C<localtime()> and C<gmtime()>.
=head1 FUNCTIONS
+=head2 C<timelocal_posix()> and C<timegm_posix()>
+
+These functions are the exact inverse of Perl's built-in C<localtime> and
+C<gmtime> functions. That means that calling C<< timelocal_posix(
+localtime($value) ) >> will always give you the same C<$value> you started
+with. The same applies to C<< timegm_posix( gmtime($value) ) >>.
+
+The one exception is when the value returned from C<localtime()> represents an
+ambiguous local time because of a DST change. See the documentation below for
+more details.
+
+These functions expect the year value to be the number of years since 1900,
+which is what the C<localtime()> and C<gmtime()> built-ins returns.
+
+They perform range checking by default on the input C<$sec>, C<$min>,
+C<$hour>, C<$mday>, and C<$mon> values and will croak (using C<Carp::croak()>)
+if given a value outside the allowed ranges.
+
+While it would be nice to make this the default behavior, that would almost
+certainly break a lot of code, so you must explicitly import these functions
+and use them instead of the default C<timelocal()> and C<timegm()>.
+
+You are B<strongly> encouraged to use these functions in any new code which
+uses this module. It will almost certainly make your code's behavior less
+surprising.
+
=head2 C<timelocal_modern()> and C<timegm_modern()>
When C<Time::Local> was first written, it was a common practice to represent
@@ -274,41 +316,44 @@ The default exports of C<timelocal()> and C<timegm()> do a complicated
calculation when given a year value less than 1000. This leads to surprising
results in many cases. See L</Year Value Interpretation> for details.
-The C<time*_modern()> subs do not do this year munging and simply take the
-year value as provided.
-
-While it would be nice to make this the default behavior, that would almost
-certainly break a lot of code, so you must explicitly import these subs and
-use them instead of the default C<timelocal()> and C<timegm()>.
+The C<time*_modern()> functions do not do this year munging and simply take
+the year value as provided.
-You are B<strongly> encouraged to use these subs in any new code which uses
-this module. It will almost certainly make your code's behavior less
-surprising.
+They perform range checking by default on the input C<$sec>, C<$min>,
+C<$hour>, C<$mday>, and C<$mon> values and will croak (using C<Carp::croak()>)
+if given a value outside the allowed ranges.
=head2 C<timelocal()> and C<timegm()>
This module exports two functions by default, C<timelocal()> and C<timegm()>.
-The C<timelocal()> and C<timegm()> functions perform range checking on the
-input $sec, $min, $hour, $mday, and $mon values by default.
-
-=head2 C<timelocal_nocheck()> and C<timegm_nocheck()>
+They perform range checking by default on the input C<$sec>, C<$min>,
+C<$hour>, C<$mday>, and C<$mon> values and will croak (using C<Carp::croak()>)
+if given a value outside the allowed ranges.
-If you are working with data you know to be valid, you can speed your code up
-by using the "nocheck" variants, C<timelocal_nocheck()> and
-C<timegm_nocheck()>. These variants must be explicitly imported.
+B<Warning: The year value interpretation that these functions and their
+nocheck variants use will almost certainly lead to bugs in your code, if not
+now, then in the future. You are strongly discouraged from using these in new
+code, and you should convert old code to using either the C<*_posix> or
+C<*_modern> functions if possible.>
- use Time::Local 'timelocal_nocheck';
+=head2 C<timelocal_nocheck()> and C<timegm_nocheck()>
- # The 365th day of 1999
- print scalar localtime timelocal_nocheck( 0, 0, 0, 365, 0, 99 );
+If you are working with data you know to be valid, you can use the "nocheck"
+variants, C<timelocal_nocheck()> and C<timegm_nocheck()>. These variants must
+be explicitly imported.
If you supply data which is not valid (month 27, second 1,000) the results
will be unpredictable (so don't do that).
+Note that my benchmarks show that this is just a 3% speed increase over the
+checked versions, so unless calling C<Time::Local> is the hottest spot in your
+application, using these nocheck variants is unlikely to have much impact on
+your application.
+
=head2 Year Value Interpretation
-B<This does not apply to C<timelocal_modern> or C<timegm_modern>. Use those
+B<This does not apply to the C<*_posix> or C<*_modern> functions. Use those
exports if you want to ensure consistent behavior as your code ages.>
Strictly speaking, the year should be specified in a form consistent with
@@ -343,7 +388,9 @@ digit dates. Whenever possible, use an absolute four digit year instead.
=back
The scheme above allows interpretation of a wide range of dates, particularly
-if 4-digit years are used.
+if 4-digit years are used. But it also means that the behavior of your code
+changes as time passes, because the rolling "current century" changes each
+year.
=head2 Limits of time_t
@@ -367,7 +414,7 @@ occurs for two different GMT times on the same day. For example, in the
"Europe/Paris" time zone, the local time of 2001-10-28 02:30:00 can represent
either 2001-10-28 00:30:00 GMT, B<or> 2001-10-28 01:30:00 GMT.
-When given an ambiguous local time, the timelocal() function should always
+When given an ambiguous local time, the timelocal() function will always
return the epoch for the I<earlier> of the two possible GMT times.
=head2 Non-Existent Local Times (DST)
@@ -457,7 +504,7 @@ Unknown <unknown@example.com>
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 1997 - 2018 by Graham Barr & Dave Rolsky.
+This software is copyright (c) 1997 - 2020 by Graham Barr & Dave Rolsky.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
diff --git a/cpan/Time-Local/t/Local.t b/cpan/Time-Local/t/Local.t
index adfb789a85..5c67ff7b29 100644
--- a/cpan/Time-Local/t/Local.t
+++ b/cpan/Time-Local/t/Local.t
@@ -5,8 +5,30 @@ use warnings;
use Config;
use Test::More 0.96;
-use Time::Local
- qw( timegm timelocal timegm_modern timelocal_modern timegm_nocheck timelocal_nocheck );
+use Time::Local qw(
+ timegm
+ timelocal
+ timegm_modern
+ timelocal_modern
+ timegm_nocheck
+ timelocal_nocheck
+ timegm_posix
+ timelocal_posix
+);
+
+my @local_subs = qw(
+ timelocal
+ timelocal_modern
+ timelocal_posix
+ timelocal_nocheck
+);
+
+my @gm_subs = qw(
+ timegm
+ timegm_modern
+ timegm_posix
+ timegm_nocheck
+);
# Use 3 days before the start of the epoch because with Borland on
# Win32 it will work for -3600 _if_ your time zone is +01:00 (or
@@ -16,17 +38,19 @@ my $neg_epoch_ok
my $large_epoch_ok = eval { ( gmtime 2**40 )[5] == 34912 };
-{
- my %tests = _valid_time_tests();
- for my $group ( sort keys %tests ) {
- subtest(
- $group,
- sub { _test_group( $tests{$group} ) },
- );
- }
-}
+subtest( 'valid times', \&_test_valid_times );
+subtest( 'diff between two calls', \&_test_diff_between_two_calls );
+subtest(
+ 'DST transition bug - https://rt.perl.org/Ticket/Display.html?id=19393',
+ \&_test_dst_transition_bug,
+);
+subtest( 'Time::Local::_is_leap_year', \&_test_is_leap_year );
+subtest( 'negative epochs', \&_test_negative_epochs );
+subtest( 'large epoch values', \&_test_large_epoch_values );
+subtest( '2-digit years', \&_test_2_digit_years );
+subtest( 'invalid values', \&_test_invalid_values );
-sub _valid_time_tests {
+sub _test_valid_times {
my %tests = (
'simple times' => [
[ 1970, 1, 2, 0, 0, 0 ],
@@ -64,7 +88,12 @@ sub _valid_time_tests {
[ 1950, 4, 12, 9, 30, 31 ],
] if $neg_epoch_ok;
- return %tests;
+ for my $group ( sort keys %tests ) {
+ subtest(
+ $group,
+ sub { _test_group( $tests{$group} ) },
+ );
+ }
}
sub _test_group {
@@ -77,297 +106,374 @@ sub _test_group {
# 1970 test on VOS fails
next if $^O eq 'vos' && $year == 1970;
- for my $sub (qw( timelocal timelocal_nocheck timelocal_modern )) {
- subtest(
- $sub,
- sub {
- my $time = __PACKAGE__->can($sub)
- ->( $sec, $min, $hour, $mday, $mon, $year );
-
- is_deeply(
- [ ( localtime($time) )[ 0 .. 5 ] ],
- [ int($sec), $min, $hour, $mday, $mon, $year - 1900 ],
- "timelocal for @{$vals}"
- );
+ for my $sub (@local_subs) {
+ my $y = $year;
+ $y -= 1900 if $sub =~ /posix/;
+ my $time = __PACKAGE__->can($sub)
+ ->( $sec, $min, $hour, $mday, $mon, $y );
+
+ my @lt = localtime($time);
+ is_deeply(
+ {
+ second => $lt[0],
+ minute => $lt[1],
+ hour => $lt[2],
+ day => $lt[3],
+ month => $lt[4],
+ year => $lt[5],
},
+ {
+ second => int($sec),
+ minute => $min,
+ hour => $hour,
+ day => $mday,
+ month => $mon,
+ year => $year - 1900,
+ },
+ "$sub( $sec, $min, $hour, $mday, $mon, $y )"
);
}
- for my $sub (qw( timegm timegm_nocheck timegm_modern )) {
- subtest(
- $sub,
- sub {
- my $time = __PACKAGE__->can($sub)
- ->( $sec, $min, $hour, $mday, $mon, $year );
-
- is_deeply(
- [ ( gmtime($time) )[ 0 .. 5 ] ],
- [ int($sec), $min, $hour, $mday, $mon, $year - 1900 ],
- "timegm for @{$vals}"
- );
+ for my $sub (@gm_subs) {
+ my $y = $year;
+ $y -= 1900 if $sub =~ /posix/;
+ my $time = __PACKAGE__->can($sub)
+ ->( $sec, $min, $hour, $mday, $mon, $y );
+
+ my @gt = gmtime($time);
+ is_deeply(
+ {
+ second => $gt[0],
+ minute => $gt[1],
+ hour => $gt[2],
+ day => $gt[3],
+ month => $gt[4],
+ year => $gt[5],
+ },
+ {
+ second => int($sec),
+ minute => $min,
+ hour => $hour,
+ day => $mday,
+ month => $mon,
+ year => $year - 1900,
},
+ "$sub( $sec, $min, $hour, $mday, $mon, $y )"
);
}
}
}
-subtest(
- 'bad times',
- sub {
- my %bad = (
- 'month too large' => [ 1995, 13, 1, 1, 1, 1 ],
- 'day too large' => [ 1995, 2, 30, 1, 1, 1 ],
- 'hour too large' => [ 1995, 2, 10, 25, 1, 1 ],
- 'minute too large' => [ 1995, 2, 10, 1, 60, 1 ],
- 'second too large' => [ 1995, 2, 10, 1, 1, 60 ],
- );
-
- for my $key ( sort keys %bad ) {
- subtest(
- $key,
- sub {
- my ( $year, $mon, $mday, $hour, $min, $sec )
- = @{ $bad{$key} };
- $mon--;
+sub _test_diff_between_two_calls {
+ for my $sub (@local_subs) {
+ subtest(
+ $sub,
+ sub {
+ my $year = 1990;
+ $year -= 1900 if $sub =~ /posix/;
+ my $sub_ref = __PACKAGE__->can($sub);
+ is(
+ $sub_ref->( 0, 0, 1, 1, 0, $year )
+ - $sub_ref->( 0, 0, 0, 1, 0, $year ),
+ 3600,
+ 'one hour difference between two calls'
+ );
- local $@ = undef;
- eval { timegm( $sec, $min, $hour, $mday, $mon, $year ) };
+ is(
+ $sub_ref->( 1, 2, 3, 1, 0, $year + 1 )
+ - $sub_ref->( 1, 2, 3, 31, 11, $year ),
+ 24 * 3600,
+ 'one day difference between two calls across year boundary',
+ );
+ },
+ );
+ }
- like(
- $@, qr/.*out of range.*/,
- "invalid time caused an error - @{$bad{$key}}"
- );
- }
- );
- }
- },
-);
+ for my $sub (@gm_subs) {
+ subtest(
+ $sub,
+ sub {
+ my $year = 1980;
+ $year -= 1900 if $sub =~ /posix/;
+ my $sub_ref = __PACKAGE__->can($sub);
-subtest(
- 'diff between two calls',
- sub {
- is(
- timelocal( 0, 0, 1, 1, 0, 90 ) - timelocal( 0, 0, 0, 1, 0, 90 ),
- 3600,
- 'one hour difference between two calls to timelocal'
+ # Diff beween Jan 1, 1980 and Mar 1, 1980 = (31 + 29 = 60 days)
+ is(
+ $sub_ref->( 0, 0, 0, 1, 2, 80 )
+ - $sub_ref->( 0, 0, 0, 1, 0, 80 ),
+ 60 * 24 * 3600,
+ '60 day difference between two calls',
+ );
+ },
);
+ }
+}
- is(
- timelocal( 1, 2, 3, 1, 0, 100 )
- - timelocal( 1, 2, 3, 31, 11, 99 ),
- 24 * 3600,
- 'one day difference between two calls to timelocal'
+sub _test_dst_transition_bug {
+ for my $sub (@local_subs) {
+ subtest(
+ $sub,
+ sub {
+ my $year = 2002;
+ $year -= 2002 if $sub =~ /posix/;
+ my $sub_ref = __PACKAGE__->can($sub);
+
+ # At a DST transition, the clock skips forward, eg from
+ # 01:59:59 to 03:00:00. In this case, 02:00:00 is an
+ # invalid time, and should be treated like 03:00:00 rather
+ # than 01:00:00 - negative zone offsets used to do the
+ # latter.
+ my $hour
+ = ( localtime( $sub_ref->( 0, 0, 2, 7, 3, 102 ) ) )[2];
+
+ # testers in US/Pacific should get 3,
+ # other testers should get 2
+ ok( $hour == 2 || $hour == 3, 'hour should be 2 or 3' );
+ },
);
+ }
+}
- # Diff beween Jan 1, 1980 and Mar 1, 1980 = (31 + 29 = 60 days)
- is(
- timegm( 0, 0, 0, 1, 2, 80 ) - timegm( 0, 0, 0, 1, 0, 80 ),
- 60 * 24 * 3600,
- '60 day difference between two calls to timegm'
- );
- },
-);
+sub _test_is_leap_year {
+ my @years = (
+ [ 1900 => 0 ],
+ [ 1947 => 0 ],
+ [ 1996 => 1 ],
+ [ 2000 => 1 ],
+ [ 2100 => 0 ],
+ );
-subtest(
- 'DST transition bug - https://rt.perl.org/Ticket/Display.html?id=19393',
- sub {
- # At a DST transition, the clock skips forward, eg from 01:59:59 to
- # 03:00:00. In this case, 02:00:00 is an invalid time, and should be
- # treated like 03:00:00 rather than 01:00:00 - negative zone offsets
- # used to do the latter.
- {
- my $hour = ( localtime( timelocal( 0, 0, 2, 7, 3, 102 ) ) )[2];
-
- # testers in US/Pacific should get 3,
- # other testers should get 2
- ok( $hour == 2 || $hour == 3, 'hour should be 2 or 3' );
- }
- },
-);
+ for my $p (@years) {
+ my ( $year, $is_leap_year ) = @$p;
-subtest(
- 'Time::Local::_is_leap_year',
- sub {
- my @years = (
- [ 1900 => 0 ],
- [ 1947 => 0 ],
- [ 1996 => 1 ],
- [ 2000 => 1 ],
- [ 2100 => 0 ],
+ my $string = $is_leap_year ? 'is' : 'is not';
+ ## no critic (Subroutines::ProtectPrivateSubs)
+ is(
+ Time::Local::_is_leap_year($year), $is_leap_year,
+ "$year $string a leap year"
);
-
- for my $p (@years) {
- my ( $year, $is_leap_year ) = @$p;
-
- my $string = $is_leap_year ? 'is' : 'is not';
- ## no critic (Subroutines::ProtectPrivateSubs)
- is(
- Time::Local::_is_leap_year($year), $is_leap_year,
- "$year $string a leap year"
- );
- }
}
-);
+}
-subtest(
- 'negative epochs',
- sub {
- plan skip_all => 'this platform does not support negative epochs.'
- unless $neg_epoch_ok;
-
- local $@ = undef;
- eval { timegm( 0, 0, 0, 29, 1, 1900 ) };
- like(
- $@, qr/Day '29' out of range 1\.\.28/,
- 'does not accept leap day in 1900'
- );
+sub _test_negative_epochs {
+ plan skip_all => 'this platform does not support negative epochs.'
+ unless $neg_epoch_ok;
- local $@ = undef;
- eval { timegm( 0, 0, 0, 29, 1, 200 ) };
- like(
- $@, qr/Day '29' out of range 1\.\.28/,
- 'does not accept leap day in 2100 (year passed as 200)'
- );
+ for my $sub (@gm_subs) {
+ subtest(
+ $sub,
+ sub {
+ my $year_mod = $sub =~ /posix/ ? -1900 : 0;
+ my $sub_ref = __PACKAGE__->can($sub);
- local $@ = undef;
- eval { timegm( 0, 0, 0, 29, 1, 0 ) };
- is(
- $@, q{},
- 'no error with leap day of 2000 (year passed as 0)'
- );
+ unless ( $sub =~ /nocheck/ ) {
+ local $@ = undef;
+ eval { $sub_ref->( 0, 0, 0, 29, 1, 1900 + $year_mod ); };
+ like(
+ $@, qr/Day '29' out of range 1\.\.28/,
+ 'does not accept leap day in 1900'
+ );
- local $@ = undef;
- eval { timegm( 0, 0, 0, 29, 1, 1904 ) };
- is( $@, q{}, 'no error with leap day of 1904' );
+ local $@ = undef;
+ eval { $sub_ref->( 0, 0, 0, 29, 1, 200 + $year_mod ) };
+ like(
+ $@, qr/Day '29' out of range 1\.\.28/,
+ 'does not accept leap day in 2100 (year passed as 200)'
+ );
+ }
- local $@ = undef;
- eval { timegm( 0, 0, 0, 29, 1, 4 ) };
- is(
- $@, q{},
- 'no error with leap day of 2004 (year passed as 4)'
- );
+ local $@ = undef;
+ eval { $sub_ref->( 0, 0, 0, 29, 1, 0 + $year_mod ) };
+ is(
+ $@, q{},
+ 'no error with leap day of 2000 (year passed as 0)'
+ );
- local $@ = undef;
- eval { timegm( 0, 0, 0, 29, 1, 96 ) };
- is(
- $@, q{},
- 'no error with leap day of 1996 (year passed as 96)'
- );
- },
-);
+ local $@ = undef;
+ eval { $sub_ref->( 0, 0, 0, 29, 1, 1904 + $year_mod ) };
+ is( $@, q{}, 'no error with leap day of 1904' );
-subtest(
- 'Large epoch values',
- sub {
- plan skip_all => 'These tests require support for large epoch values'
- unless $large_epoch_ok;
+ local $@ = undef;
+ eval { $sub_ref->( 0, 0, 0, 29, 1, 4 + $year_mod ) };
+ is(
+ $@, q{},
+ 'no error with leap day of 2004 (year passed as 4)'
+ );
- is(
- timegm( 8, 14, 3, 19, 0, 2038 ), 2**31,
- 'can call timegm for 2**31 epoch seconds'
- );
- is(
- timegm( 16, 28, 6, 7, 1, 2106 ), 2**32,
- 'can call timegm for 2**32 epoch seconds (on a 64-bit system)'
- );
- is(
- timegm( 16, 36, 0, 20, 1, 36812 ), 2**40,
- 'can call timegm for 2**40 epoch seconds (on a 64-bit system)'
+ local $@ = undef;
+ eval { $sub_ref->( 0, 0, 0, 29, 1, 96 + $year_mod ) };
+ is(
+ $@, q{},
+ 'no error with leap day of 1996 (year passed as 96)'
+ );
+ },
);
- },
-);
+ }
+}
-subtest(
- '2-digit years',
- sub {
- my $current_year = ( localtime() )[5];
- my $pre_break = ( $current_year + 49 ) - 100;
- my $break = ( $current_year + 50 ) - 100;
- my $post_break = ( $current_year + 51 ) - 100;
+sub _test_large_epoch_values {
+ plan skip_all => 'These tests require support for large epoch values'
+ unless $large_epoch_ok;
+ for my $sub (@gm_subs) {
subtest(
- 'legacy year munging',
+ $sub,
sub {
- plan skip_all => 'Requires support for an large epoch values'
- unless $large_epoch_ok;
+ my $year_mod = $sub =~ /posix/ ? -1900 : 0;
+ my $sub_ref = __PACKAGE__->can($sub);
is(
- (
- (
- localtime(
- timelocal( 0, 0, 0, 1, 1, $pre_break )
- )
- )[5]
- ),
- $pre_break + 100,
- "year $pre_break is treated as next century",
+ $sub_ref->( 8, 14, 3, 19, 0, 2038 + $year_mod ),
+ 2**31,
+ 'can call with 2**31 epoch seconds',
);
is(
- (
- ( localtime( timelocal( 0, 0, 0, 1, 1, $break ) ) )[5]
- ),
- $break + 100,
- "year $break is treated as next century",
+ $sub_ref->( 16, 28, 6, 7, 1, 2106 + $year_mod ),
+ 2**32,
+ 'can call with 2**32 epoch seconds (on a 64-bit system)',
);
is(
- (
- (
- localtime(
- timelocal( 0, 0, 0, 1, 1, $post_break )
- )
- )[5]
- ),
- $post_break,
- "year $post_break is treated as current century",
+ $sub_ref->( 16, 36, 0, 20, 1, 36812 + $year_mod ),
+ 2**40,
+ 'can call with 2**40 epoch seconds (on a 64-bit system)',
);
- }
+ },
);
+ }
+}
- subtest(
- 'modern',
- sub {
- plan skip_all =>
- 'Requires negative epoch support and large epoch support'
- unless $neg_epoch_ok && $large_epoch_ok;
+sub _test_2_digit_years {
+ my $current_year = ( localtime() )[5];
+ my $pre_break = ( $current_year + 49 ) - 100;
+ my $break = ( $current_year + 50 ) - 100;
+ my $post_break = ( $current_year + 51 ) - 100;
- is(
+ subtest(
+ 'legacy year munging',
+ sub {
+ plan skip_all => 'Requires support for an large epoch values'
+ unless $large_epoch_ok;
+
+ is(
+ (
+ ( localtime( timelocal( 0, 0, 0, 1, 1, $pre_break ) ) )[5]
+ ),
+ $pre_break + 100,
+ "year $pre_break is treated as next century",
+ );
+ is(
+ ( ( localtime( timelocal( 0, 0, 0, 1, 1, $break ) ) )[5] ),
+ $break + 100,
+ "year $break is treated as next century",
+ );
+ is(
+ (
+ ( localtime( timelocal( 0, 0, 0, 1, 1, $post_break ) ) )
+ [5]
+ ),
+ $post_break,
+ "year $post_break is treated as current century",
+ );
+ }
+ );
+
+ subtest(
+ 'modern',
+ sub {
+ plan skip_all =>
+ 'Requires negative epoch support and large epoch support'
+ unless $neg_epoch_ok && $large_epoch_ok;
+
+ is(
+ (
(
- (
- localtime(
- timelocal_modern( 0, 0, 0, 1, 1, $pre_break )
- )
- )[5]
- ) + 1900,
- $pre_break,
- "year $pre_break is treated as year $pre_break",
- );
- is(
+ localtime(
+ timelocal_modern( 0, 0, 0, 1, 1, $pre_break )
+ )
+ )[5]
+ ) + 1900,
+ $pre_break,
+ "year $pre_break is treated as year $pre_break",
+ );
+ is(
+ (
(
- (
- localtime(
- timelocal_modern( 0, 0, 0, 1, 1, $break )
- )
- )[5]
- ) + 1900,
- $break,
- "year $break is treated as year $break",
- );
- is(
+ localtime(
+ timelocal_modern( 0, 0, 0, 1, 1, $break )
+ )
+ )[5]
+ ) + 1900,
+ $break,
+ "year $break is treated as year $break",
+ );
+ is(
+ (
(
- (
- localtime(
- timelocal_modern(
- 0, 0, 0, 1, 1, $post_break
- )
- )
- )[5]
- ) + 1900,
- $post_break,
- "year $post_break is treated as year $post_break",
- );
+ localtime(
+ timelocal_modern( 0, 0, 0, 1, 1, $post_break )
+ )
+ )[5]
+ ) + 1900,
+ $post_break,
+ "year $post_break is treated as year $post_break",
+ );
+ },
+ );
+}
+
+sub _test_invalid_values {
+ my %bad = (
+ 'month > bounds' => [ 1995, 13, 1, 1, 1, 1 ],
+ 'day > bounds' => [ 1995, 2, 30, 1, 1, 1 ],
+ 'hour > bounds' => [ 1995, 2, 10, 25, 1, 1 ],
+ 'minute > bounds' => [ 1995, 2, 10, 1, 60, 1 ],
+ 'second > bounds' => [ 1995, 2, 10, 1, 1, 60 ],
+ 'month < bounds' => [ 1995, -1, 1, 1, 1, 1 ],
+ 'day < bounds' => [ 1995, 2, -1, 1, 1, 1 ],
+ 'hour < bounds' => [ 1995, 2, 10, -1, 1, 1 ],
+ 'minute < bounds' => [ 1995, 2, 10, 1, -1, 1 ],
+ 'second < bounds' => [ 1995, 2, 10, 1, 1, -1 ],
+ );
+
+ for my $sub ( grep { !/nocheck/ } @local_subs, @gm_subs ) {
+ subtest(
+ $sub,
+ sub {
+ for my $key ( sort keys %bad ) {
+ my ( $year, $mon, $mday, $hour, $min, $sec )
+ = @{ $bad{$key} };
+ $mon--;
+
+ local $@ = undef;
+ eval {
+ __PACKAGE__->can($sub)
+ ->( $sec, $min, $hour, $mday, $mon, $year );
+ };
+
+ like(
+ $@, qr/.*out of range.*/,
+ "$key - @{ $bad{$key} }"
+ );
+ }
},
);
- },
-);
+ }
+
+ for my $sub ( grep {/nocheck/} @local_subs, @gm_subs ) {
+ subtest(
+ $sub,
+ sub {
+ for my $key ( sort keys %bad ) {
+ local $@ = q{};
+ eval { __PACKAGE__->can($sub)->( @{ $bad{$key} } ); };
+ is(
+ $@, q{},
+ "$key - @{ $bad{$key} } - no exception with checks disabled"
+ );
+ }
+ },
+ );
+ }
+}
done_testing();