diff options
author | Steve Hay <steve.m.hay@googlemail.com> | 2020-10-12 17:26:34 +0100 |
---|---|---|
committer | Steve Hay <steve.m.hay@googlemail.com> | 2020-10-12 17:26:34 +0100 |
commit | 3485785629a9d0a5fb09c4e1f08f1d22567d7665 (patch) | |
tree | 1667e3fe801ce674fa2dc73f5d978192bfa73f8a | |
parent | 048ed1a13e87c617826385b40c9afc93a27c7763 (diff) | |
download | perl-3485785629a9d0a5fb09c4e1f08f1d22567d7665.tar.gz |
Update Time-Local from version 1.28 to 1.30
-rwxr-xr-x | Porting/Maintainers.pl | 5 | ||||
-rw-r--r-- | cpan/Time-Local/lib/Time/Local.pm | 117 | ||||
-rw-r--r-- | cpan/Time-Local/t/Local.t | 618 |
3 files changed, 447 insertions, 293 deletions
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index dfa2d3af4e..6c69bce13d 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1188,11 +1188,12 @@ use File::Glob qw(:case); }, 'Time::Local' => { - 'DISTRIBUTION' => 'DROLSKY/Time-Local-1.28.tar.gz', + 'DISTRIBUTION' => 'DROLSKY/Time-Local-1.30.tar.gz', 'FILES' => q[cpan/Time-Local], 'EXCLUDED' => [ qr{^xt/}, - qw( appveyor.yml + qw( CODE_OF_CONDUCT.md + azure-pipelines.yml perlcriticrc perltidyrc tidyall.ini 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(); |