From: Rafael Garcia-Suarez Date: Thu, 17 Feb 2005 15:21:55 +0000 (+0000) Subject: Upgrade to Time::HiRes 1.66 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=44d3ce20f589f12b64fe2f9e40734a9bea4663ed;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Time::HiRes 1.66 p4raw-id: //depot/perl@23975 --- diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes index 6277ea6..dfcb9d9 100644 --- a/ext/Time/HiRes/Changes +++ b/ext/Time/HiRes/Changes @@ -1,5 +1,13 @@ Revision history for Perl extension Time::HiRes. +1.66 + - add nanosleep() + - fix the 'hierachy' typo in Makefile.PL [rt.cpan.org #8492] + - should now build in Solaris [rt.cpan.org #7165] (since 1.64) + - should now build in Cygwin [rt.cpan.org #7535] (since 1.64) + - close also [rt.cpan.org #5933] "Time::HiRes::time does not pick up time adjustments like ntp" since ever reproducing it in the same environment + has become rather unlikely + 1.65 - one should not mix u?alarm and sleep (the tests modified by 1.65, #12 and #13, hung in Solaris), now we just busy diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm index e47e09c..42326fd 100644 --- a/ext/Time/HiRes/HiRes.pm +++ b/ext/Time/HiRes/HiRes.pm @@ -10,12 +10,12 @@ require DynaLoader; @EXPORT = qw( ); @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval - getitimer setitimer + getitimer setitimer nanosleep ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer d_nanosleep); -$VERSION = '1.65'; +$VERSION = '1.66'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -54,9 +54,10 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers =head1 SYNOPSIS - use Time::HiRes qw( usleep ualarm gettimeofday tv_interval ); + use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep ); usleep ($microseconds); + nanosleep ($nanoseconds); ualarm ($microseconds); ualarm ($microseconds, $interval_microseconds); @@ -84,20 +85,20 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers =head1 DESCRIPTION The C module implements a Perl interface to the -C, C, C, and C/C -system calls, in other words, high resolution time and timers. See the -L section below and the test scripts for usage; see your -system documentation for the description of the underlying -C or C, C, C, and -C/C calls. +C, C, C, C, and +C/C system calls, in other words, high +resolution time and timers. See the L section below and the +test scripts for usage; see your system documentation for the +description of the underlying C or C, C, +C, and C/C calls. If your system lacks C or an emulation of it you don't get C or the one-argument form of C. If your system lacks all of C, C, and -C, you don't get C or -C. If your system lacks both C and -C you don't get C or -C. +C, you don't get C, +C, or C. If your +system lacks both C and C you don't get +C or C. If you try to import an unimplemented function in the C statement it will fail at compile time. @@ -108,9 +109,7 @@ C does not use signals. This, however, is not portable, and you should first check for the truth value of C<&Time::HiRes::d_nanosleep> to see whether you have nanosleep, and then carefully read your C C API documentation for any -peculiarities. (There is no separate interface to call -C; just use C or -C with small enough values.) +peculiarities. Unless using C for mixing sleeping with signals, give some thought to whether Perl is the tool you should be using for @@ -129,9 +128,23 @@ seconds like C (see below). =item usleep ( $useconds ) -Sleeps for the number of microseconds specified. Returns the number -of microseconds actually slept. Can sleep for more than one second, -unlike the C system call. See also C below. +Sleeps for the number of microseconds (millionths of a second) +specified. Returns the number of microseconds actually slept. Can +sleep for more than one second, unlike the C system call. See +also C and C. + +Do not expect usleep() to be exact down to one microsecond. + +=item nanosleep ( $nanoseconds ) + +Sleeps for the number of nanoseconds (1e9ths of a second) specified. +Returns the number of nanoseconds actually slept (accurate only to +microseconds, the nearest thousand of them). Can sleep for more than +one second. See also C and +C. + +Do not expect nanosleep() to be exact down to one nanosecond. +Getting even accuracy of one thousand nanoseconds is good. =item ualarm ( $useconds [, $interval_useconds ] ) diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs index 76352e2..3272748 100644 --- a/ext/Time/HiRes/HiRes.xs +++ b/ext/Time/HiRes/HiRes.xs @@ -351,18 +351,18 @@ gettimeofday (struct timeval *tp, void *tpz) * The TIME_HIRES_NANOSLEEP is set by Makefile.PL. */ #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) #define HAS_USLEEP -#define usleep hrt_nanosleep /* could conflict with ncurses for static build */ +#define usleep hrt_unanosleep /* could conflict with ncurses for static build */ void -hrt_nanosleep(unsigned long usec) +hrt_unanosleep(unsigned long usec) /* This is used to emulate usleep. */ { struct timespec res; res.tv_sec = usec/1000/1000; res.tv_nsec = ( usec - res.tv_sec*1000*1000 ) * 1000; nanosleep(&res, NULL); } -#endif +#endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */ #if !defined(HAS_USLEEP) && defined(HAS_SELECT) #ifndef SELECT_IS_BROKEN @@ -379,7 +379,7 @@ hrt_usleep(unsigned long usec) (Select_fd_set_t)NULL, &tv); } #endif -#endif +#endif /* #if !defined(HAS_USLEEP) && defined(HAS_SELECT) */ #if !defined(HAS_USLEEP) && defined(WIN32) #define HAS_USLEEP @@ -392,7 +392,7 @@ hrt_usleep(unsigned long usec) msec = usec / 1000; Sleep (msec); } -#endif +#endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */ #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) @@ -409,7 +409,7 @@ hrt_ualarm(int usec, int interval) itv.it_interval.tv_usec = interval % 1000000; return setitimer(ITIMER_REAL, &itv, 0); } -#endif +#endif /* #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) */ #if !defined(HAS_UALARM) && defined(VMS) #define HAS_UALARM @@ -606,7 +606,7 @@ ualarm_AST(Alarm *a) } } -#endif /* !HAS_UALARM && VMS */ +#endif /* #if !defined(HAS_UALARM) && defined(VMS) */ #ifdef HAS_GETTIMEOFDAY @@ -633,7 +633,7 @@ myNVtime() return status == 0 ? Tp.tv_sec + (Tp.tv_usec / 1000000.) : -1.0; } -#endif +#endif /* #ifdef HAS_GETTIMEOFDAY */ MODULE = Time::HiRes PACKAGE = Time::HiRes @@ -700,6 +700,38 @@ usleep(useconds) OUTPUT: RETVAL +#if defined(TIME_HIRES_NANOSLEEP) + +NV +nanosleep(nseconds) + NV nseconds + PREINIT: + struct timeval Ta, Tb; + CODE: + gettimeofday(&Ta, NULL); + if (items > 0) { + struct timespec tsa; + if (nseconds > 1E9) { + IV seconds = (IV) (nseconds / 1E9); + if (seconds) { + sleep(seconds); + nseconds -= 1E9 * seconds; + } + } else if (nseconds < 0.0) + croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented yet", nseconds); + tsa.tv_sec = (IV) (nseconds / 1E9); + tsa.tv_nsec = (IV) nseconds - tsa.tv_sec * 1E9; + nanosleep(&tsa, NULL); + } else + PerlProc_pause(); + gettimeofday(&Tb, NULL); + RETVAL = 1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec)); + + OUTPUT: + RETVAL + +#endif /* #if defined(TIME_HIRES_NANOSLEEP) */ + NV sleep(...) PREINIT: @@ -719,7 +751,7 @@ sleep(...) * circumstances (if the double is cast to UV more * than once?) evaluate to -0.5, instead of 0.5. */ useconds = -(IV)useconds; -#endif +#endif /* #if defined(__sparc64__) && defined(__GNUC__) */ if ((IV)useconds < 0) croak("Time::HiRes::sleep(%"NVgf"): internal error: useconds < 0 (unsigned %"UVuf" signed %"IVdf")", seconds, useconds, (IV)useconds); } @@ -737,7 +769,7 @@ sleep(...) OUTPUT: RETVAL -#endif +#endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */ #ifdef HAS_UALARM @@ -766,7 +798,7 @@ alarm(seconds,interval=0) OUTPUT: RETVAL -#endif +#endif /* #ifdef HAS_UALARM */ #ifdef HAS_GETTIMEOFDAY # ifdef MACOS_TRADITIONAL /* fix epoch TZ and use unsigned time_t */ @@ -832,7 +864,7 @@ time() RETVAL # endif /* MACOS_TRADITIONAL */ -#endif +#endif /* #ifdef HAS_GETTIMEOFDAY */ #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) @@ -879,5 +911,6 @@ getitimer(which) } } -#endif +#endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */ + diff --git a/ext/Time/HiRes/t/HiRes.t b/ext/Time/HiRes/t/HiRes.t index 528ab70..617468e 100644 --- a/ext/Time/HiRes/t/HiRes.t +++ b/ext/Time/HiRes/t/HiRes.t @@ -12,7 +12,7 @@ BEGIN { } } -BEGIN { $| = 1; print "1..25\n"; } +BEGIN { $| = 1; print "1..28\n"; } END {print "not ok 1\n" unless $loaded;} @@ -26,11 +26,13 @@ use strict; my $have_gettimeofday = defined &Time::HiRes::gettimeofday; my $have_usleep = defined &Time::HiRes::usleep; +my $have_nanosleep = defined &Time::HiRes::nanosleep; my $have_ualarm = defined &Time::HiRes::ualarm; my $have_time = defined &Time::HiRes::time; import Time::HiRes 'gettimeofday' if $have_gettimeofday; import Time::HiRes 'usleep' if $have_usleep; +import Time::HiRes 'nanosleep' if $have_nanosleep; import Time::HiRes 'ualarm' if $have_ualarm; use Config; @@ -41,11 +43,10 @@ my $waitfor = 60; # 10 seconds is normal. my $pid; if ($have_fork) { - print "# Testing process $$\n"; - print "# Starting the timer process\n"; + print "# I am process $$, starting the timer process\n"; if (defined ($pid = fork())) { if ($pid == 0) { # We are the kid, set up the timer. - print "# Timer process $$\n"; + print "# I am timer process $$\n"; sleep($waitfor); warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded\n"; print "# Terminating the testing process\n"; @@ -349,29 +350,60 @@ if ($have_gettimeofday) { } } +if (!$have_nanosleep) { + skip 22..23; +} +else { + my $one = CORE::time; + nanosleep(10_000_000); + my $two = CORE::time; + nanosleep(10_000_000); + my $three = CORE::time; + ok 22, $one == $two || $two == $three, "slept too long, $one $two $three"; + + if (!$have_gettimeofday) { + skip 23; + } + else { + my $f = Time::HiRes::time(); + nanosleep(500_000_000); + my $f2 = Time::HiRes::time(); + my $d = $f2 - $f; + ok 23, $d > 0.4 && $d < 0.9, "slept $d secs $f to $f2"; + } +} + eval { sleep(-1) }; print $@ =~ /::sleep\(-1\): negative time not invented yet/ ? - "ok 22\n" : "not ok 22\n"; + "ok 24\n" : "not ok 24\n"; eval { usleep(-2) }; print $@ =~ /::usleep\(-2\): negative time not invented yet/ ? - "ok 23\n" : "not ok 23\n"; + "ok 25\n" : "not ok 25\n"; if ($have_ualarm) { eval { alarm(-3) }; print $@ =~ /::alarm\(-3, 0\): negative time not invented yet/ ? - "ok 24\n" : "not ok 24\n"; + "ok 26\n" : "not ok 26\n"; eval { ualarm(-4) }; print $@ =~ /::ualarm\(-4, 0\): negative time not invented yet/ ? - "ok 25\n" : "not ok 25\n"; + "ok 27\n" : "not ok 27\n"; +} else { + skip 26; + skip 27; +} + +if ($have_nanosleep) { + eval { nanosleep(-5) }; + print $@ =~ /::nanosleep\(-5\): negative time not invented yet/ ? + "ok 28\n" : "not ok 28\n"; } else { - skip 24; - skip 25; + skip 28; } if (defined $pid) { - print "# Terminating the timer process $pid\n"; + print "# I am process $$, terminating the timer process $pid\n"; kill('TERM', $pid); # We are done, the timer can go. unlink("ktrace.out"); }