> Mainly don't go with hires even though a 'famous' module already does.
Sounds reasonable to me. Here is a revised version of the patch. I made a basic
attempt at testing. The tests I think are questionable are already inside a skip
block. That way it won't break the CVS version and hopefully a few people will
comment out the skip and give it a try before the next release.
-J
--
cvs server: Diffing .
Index: Makefile.PL
===================================================================
RCS file: /cvsroot/perl-date-time/modules/DateTime.pm/Makefile.PL,v
retrieving revision 1.29
diff -u -r1.29 Makefile.PL
--- Makefile.PL 13 Jun 2003 18:04:06 -0000 1.29
+++ Makefile.PL 3 Aug 2003 09:12:13 -0000
@@ -78,6 +78,7 @@
'Params::Validate' => 0.52,
'Test::More' => 0,
'Time::Local' => 1.04,
+ 'Time::HiRes' => 1.50,
'DateTime::LeapSecond' => 0.02,
},
);
cvs server: Diffing lib
Index: lib/DateTime.pm
===================================================================
RCS file: /cvsroot/perl-date-time/modules/DateTime.pm/lib/DateTime.pm,v
retrieving revision 1.232
diff -u -r1.232 DateTime.pm
--- lib/DateTime.pm 31 Jul 2003 23:49:41 -0000 1.232
+++ lib/DateTime.pm 3 Aug 2003 09:12:15 -0000
@@ -48,6 +48,7 @@
use DateTime::LeapSecond;
use Params::Validate qw( validate SCALAR BOOLEAN HASHREF OBJECT );
use Time::Local ();
+use Time::HiRes;
# for some reason, overloading doesn't work unless fallback is listed
# early.
@@ -385,7 +386,7 @@
# Because epoch may come from Time::HiRes
my $fraction = $p{epoch} - int( $p{epoch} );
- $args{nanosecond} = $fraction * MAX_NANOSECONDS
+ $args{nanosecond} = int( $fraction * MAX_NANOSECONDS )
if $fraction;
# Note, for very large negative values this may give a blatantly
@@ -404,6 +405,8 @@
# use scalar time in case someone's loaded Time::Piece
sub now { shift->from_epoch( epoch => (scalar time), @_ ) }
+
+sub now_high_res { shift->from_epoch( epoch => Time::HiRes::time, @_ ) }
sub today { shift->now(@_)->truncate( to => 'day' ) }
cvs server: Diffing lib/DateTime
cvs server: Diffing lib/DateTime/Language
cvs server: Diffing t
Index: t/04epoch.t
===================================================================
RCS file: /cvsroot/perl-date-time/modules/DateTime.pm/t/04epoch.t,v
retrieving revision 1.16
diff -u -r1.16 04epoch.t
--- t/04epoch.t 13 Jun 2003 16:57:54 -0000 1.16
+++ t/04epoch.t 3 Aug 2003 09:12:15 -0000
@@ -2,7 +2,8 @@
use strict;
-use Test::More tests => 31;
+use Test::More tests => 36;
+use Time::HiRes;
use DateTime;
@@ -32,6 +33,24 @@
is( $nowtest->hour, $nowtest2->hour, "Hour: Create without args" );
is( $nowtest->month, $nowtest2->month, "Month : Create without args" );
is( $nowtest->minute, $nowtest2->minute, "Minute: Create without args" );
+}
+
+{
+ # these tests could break if the time changed during the next three lines
+ my $now = Time::HiRes::time;
+ my $nowtest = DateTime->now_high_res();
+ my $nowtest2 = DateTime->from_epoch( epoch => $now );
+ is( $nowtest->hour, $nowtest2->hour, "Hour: Create without args" );
+ is( $nowtest->month, $nowtest2->month, "Month : Create without args" );
+ is( $nowtest->minute, $nowtest2->minute, "Minute: Create without args" );
+ SKIP: {
+ skip "This might be crazy", 2;
+
+ my $dur = $nowtest - $nowtest2;
+ is( $dur->seconds, 0, "Second: Create without args" );
+ ok( $dur->nanoseconds < 100_000_000, "Nanosecond: Create without args" );
+ };
+
}
{
