use Test::More; BEGIN { unless ( $ENV{RELEASE_TESTING} ) { plan skip_all => 'these tests are for testing by the release'; } $ENV{PERL_DATETIME_PP} = 1; } use strict; use warnings; use Test::More; use DateTime; my %vals = ( year => 50, month => 3, day => 15, hour => 10, minute => 55, second => 17, nanosecond => 1234, ); { my $dt = DateTime->new(%vals); $dt->truncate( to => 'second' ); foreach my $f (qw( year month day hour minute second )) { is( $dt->$f(), $vals{$f}, "$f should be $vals{$f}" ); } foreach my $f (qw( nanosecond )) { is( $dt->$f(), 0, "$f should be 0" ); } } { my $dt = DateTime->new(%vals); $dt->truncate( to => 'minute' ); foreach my $f (qw( year month day hour minute )) { is( $dt->$f(), $vals{$f}, "$f should be $vals{$f}" ); } foreach my $f (qw( second nanosecond )) { is( $dt->$f(), 0, "$f should be 0" ); } } { my $dt = DateTime->new(%vals); $dt->truncate( to => 'hour' ); foreach my $f (qw( year month day hour )) { is( $dt->$f(), $vals{$f}, "$f should be $vals{$f}" ); } foreach my $f (qw( minute second nanosecond )) { is( $dt->$f(), 0, "$f should be 0" ); } } { my $dt = DateTime->new(%vals); $dt->truncate( to => 'day' ); foreach my $f (qw( year month day )) { is( $dt->$f(), $vals{$f}, "$f should be $vals{$f}" ); } foreach my $f (qw( hour minute second nanosecond )) { is( $dt->$f(), 0, "$f should be 0" ); } } { my $dt = DateTime->new(%vals); $dt->truncate( to => 'month' ); foreach my $f (qw( year month )) { is( $dt->$f(), $vals{$f}, "$f should be $vals{$f}" ); } foreach my $f (qw( day )) { is( $dt->$f(), 1, "$f should be 1" ); } foreach my $f (qw( hour minute second nanosecond )) { is( $dt->$f(), 0, "$f should be 0" ); } } { my $dt = DateTime->new(%vals); $dt->truncate( to => 'year' ); foreach my $f (qw( year )) { is( $dt->$f(), $vals{$f}, "$f should be $vals{$f}" ); } foreach my $f (qw( month day )) { is( $dt->$f(), 1, "$f should be 1" ); } foreach my $f (qw( hour minute second nanosecond )) { is( $dt->$f(), 0, "$f should be 0" ); } } { my $dt = DateTime->new( year => 2003, month => 11, day => 17 ); for ( 1 .. 6 ) { my $trunc = $dt->clone->add( days => $_ )->truncate( to => 'week' ); is( $trunc->day, 17, 'truncate to week should always truncate to monday of week' ); } { my $trunc = $dt->clone->add( days => 7 )->truncate( to => 'week' ); is( $trunc->day, 24, 'truncate to week should always truncate to monday of week' ); } { my $dt = DateTime->new( year => 2003, month => 10, day => 2 ) ->truncate( to => 'week' ); is( $dt->year, 2003, 'truncation to week across month boundary' ); is( $dt->month, 9, 'truncation to week across month boundary' ); is( $dt->day, 29, 'truncation to week across month boundary' ); } } done_testing();