[Orca-checkins] r415 - in trunk/orca: . packages/Time-HiRes-1.65 packages/Time-HiRes-1.66 packages/Time-HiRes-1.66/t

Blair Zajac blair at orcaware.com
Tue Feb 15 22:24:34 PST 2005


Author: blair
Date: Tue Feb 15 22:22:46 2005
New Revision: 415

Added:
   trunk/orca/packages/Time-HiRes-1.66/
      - copied from r414, trunk/orca/packages/Time-HiRes-1.65/
Removed:
   trunk/orca/packages/Time-HiRes-1.65/
Modified:
   trunk/orca/INSTALL
   trunk/orca/configure.in
   trunk/orca/packages/Time-HiRes-1.66/Changes
   trunk/orca/packages/Time-HiRes-1.66/HiRes.pm
   trunk/orca/packages/Time-HiRes-1.66/HiRes.xs
   trunk/orca/packages/Time-HiRes-1.66/META.yml
   trunk/orca/packages/Time-HiRes-1.66/Makefile.PL
   trunk/orca/packages/Time-HiRes-1.66/t/HiRes.t
Log:
Upgrade Time::HiRes from 1.65 to 1.66.

* INSTALL (Determine which Perl modules need compiling and installing):
  Update all references to Time::HiRes's version number from 1.65 to
  1.66.

* configure.in:
  Bump Time::HiRes's version number to 1.66.

* packages/Time-HiRes-1.66:
  Renamed from packages/Time-HiRes-1.65.  Directory contents updated
  from Time-HiRes-1.66.tar.gz.


Modified: trunk/orca/INSTALL
==============================================================================
--- trunk/orca/INSTALL	(original)
+++ trunk/orca/INSTALL	Tue Feb 15 22:22:46 2005
@@ -177,7 +177,7 @@
     Math::IntervalSearch    >= 1.05        >= 1.05      1.05
     RRDs                    >= 1.000491    >= 1.0.49    1.0.49
     Storable                >= 2.13        >= 2.13      2.13
-    Time::HiRes             Not required by Orca        1.65
+    Time::HiRes             Not required by Orca        1.66
     version                 >= 0.42        >= 0.42      0.42
 
     All seven of these modules are included with the Orca distribution
@@ -279,10 +279,10 @@
 
     Time::HiRes
 
-      http://www.perl.com/CPAN/authors/id/J/JH/JHI/Time-HiRes-1.65.tar.gz
+      http://www.perl.com/CPAN/authors/id/J/JH/JHI/Time-HiRes-1.66.tar.gz
 
-      % gunzip -c Time-HiRes-1.65.tar.gz | tar xvf -
-      % cd Time-HiRes-1.65
+      % gunzip -c Time-HiRes-1.66.tar.gz | tar xvf -
+      % cd Time-HiRes-1.66
       % perl Makefile.PL
       % make
       % make test

Modified: trunk/orca/configure.in
==============================================================================
--- trunk/orca/configure.in	(original)
+++ trunk/orca/configure.in	Tue Feb 15 22:22:46 2005
@@ -41,8 +41,8 @@
 RRDTOOL_VER=1.000491
 STORABLE_DIR=Storable-2.13
 STORABLE_VER=2.13
-TIME_HIRES_DIR=Time-HiRes-1.65
-TIME_HIRES_VER=1.65
+TIME_HIRES_DIR=Time-HiRes-1.66
+TIME_HIRES_VER=1.66
 VERSION_DIR=version-0.42
 VERSION_VER=0.42
 

Modified: trunk/orca/packages/Time-HiRes-1.66/Changes
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.65/Changes	(original)
+++ trunk/orca/packages/Time-HiRes-1.66/Changes	Tue Feb 15 22:22:46 2005
@@ -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

Modified: trunk/orca/packages/Time-HiRes-1.66/HiRes.pm
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.65/HiRes.pm	(original)
+++ trunk/orca/packages/Time-HiRes-1.66/HiRes.pm	Tue Feb 15 22:22:46 2005
@@ -10,12 +10,12 @@
 
 @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 @@
 
 =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 @@
 =head1 DESCRIPTION
 
 The C<Time::HiRes> module implements a Perl interface to the
-C<usleep>, C<ualarm>, C<gettimeofday>, and C<setitimer>/C<getitimer>
-system calls, in other words, high resolution time and timers. See the
-L</EXAMPLES> section below and the test scripts for usage; see your
-system documentation for the description of the underlying
-C<nanosleep> or C<usleep>, C<ualarm>, C<gettimeofday>, and
-C<setitimer>/C<getitimer> calls.
+C<usleep>, C<nanosleep>, C<ualarm>, C<gettimeofday>, and
+C<setitimer>/C<getitimer> system calls, in other words, high
+resolution time and timers. See the L</EXAMPLES> section below and the
+test scripts for usage; see your system documentation for the
+description of the underlying C<nanosleep> or C<usleep>, C<ualarm>,
+C<gettimeofday>, and C<setitimer>/C<getitimer> calls.
 
 If your system lacks C<gettimeofday()> or an emulation of it you don't
 get C<gettimeofday()> or the one-argument form of C<tv_interval()>.
 If your system lacks all of C<nanosleep()>, C<usleep()>, and
-C<select()>, you don't get C<Time::HiRes::usleep()> or
-C<Time::HiRes::sleep()>.  If your system lacks both C<ualarm()> and
-C<setitimer()> you don't get C<Time::HiRes::ualarm()> or
-C<Time::HiRes::alarm()>.
+C<select()>, you don't get C<Time::HiRes::usleep()>,
+C<Time::HiRes::nanosleep()>, or C<Time::HiRes::sleep()>.  If your
+system lacks both C<ualarm()> and C<setitimer()> you don't get
+C<Time::HiRes::ualarm()> or C<Time::HiRes::alarm()>.
 
 If you try to import an unimplemented function in the C<use> statement
 it will fail at compile time.
@@ -108,9 +109,7 @@
 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<nanosleep()> C API documentation for any
-peculiarities.  (There is no separate interface to call
-C<nanosleep()>; just use C<Time::HiRes::sleep()> or
-C<Time::HiRes::usleep()> with small enough values.)
+peculiarities.
 
 Unless using C<nanosleep> for mixing sleeping with signals, give
 some thought to whether Perl is the tool you should be using for
@@ -129,9 +128,23 @@
 
 =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<usleep> system call. See also C<Time::HiRes::sleep()> 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<usleep> system call. See
+also C<Time::HiRes::usleep()> and C<Time::HiRes::sleep()>.
+
+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<Time::HiRes::sleep()> and
+C<Time::HiRes::usleep()>.
+
+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 ] )
 

Modified: trunk/orca/packages/Time-HiRes-1.66/HiRes.xs
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.65/HiRes.xs	(original)
+++ trunk/orca/packages/Time-HiRes-1.66/HiRes.xs	Tue Feb 15 22:22:46 2005
@@ -351,18 +351,18 @@
   * 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 @@
 		(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 @@
     msec = usec / 1000;
     Sleep (msec);
 }
-#endif
+#endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */
 
 
 #if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
@@ -409,7 +409,7 @@
    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 @@
     }
 }
 
-#endif /* !HAS_UALARM && VMS */
+#endif /* #if !defined(HAS_UALARM) && defined(VMS) */
 
 #ifdef HAS_GETTIMEOFDAY
 
@@ -633,7 +633,7 @@
   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 @@
 	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 @@
 		    * 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 @@
 	OUTPUT:
 	RETVAL
 
-#endif
+#endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
 
 #ifdef HAS_UALARM
 
@@ -766,7 +798,7 @@
 	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 @@
 	RETVAL
 
 #    endif	/* MACOS_TRADITIONAL */
-#endif
+#endif /* #ifdef HAS_GETTIMEOFDAY */
 
 #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER)
 
@@ -879,5 +911,6 @@
 	  }
 	}
 
-#endif
+#endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */
+
 

Modified: trunk/orca/packages/Time-HiRes-1.66/META.yml
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.65/META.yml	(original)
+++ trunk/orca/packages/Time-HiRes-1.66/META.yml	Tue Feb 15 22:22:46 2005
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         Time-HiRes
-version:      1.65
+version:      1.66
 version_from: HiRes.pm
 installdirs:  perl
 requires:

Modified: trunk/orca/packages/Time-HiRes-1.66/Makefile.PL
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.65/Makefile.PL	(original)
+++ trunk/orca/packages/Time-HiRes-1.66/Makefile.PL	Tue Feb 15 22:22:46 2005
@@ -98,7 +98,7 @@
 
 	if ($^O eq 'VMS') {
 	    if ($ENV{PERL_CORE}) {
-		# Fragile if the extensions change hierachy within
+		# Fragile if the extensions change hierarchy within
 		# the Perl core but this should do for now.
                 $cccmd = "$Config{'cc'} /include=([---]) $tmp.c";
 	    } else {

Modified: trunk/orca/packages/Time-HiRes-1.66/t/HiRes.t
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.65/t/HiRes.t	(original)
+++ trunk/orca/packages/Time-HiRes-1.66/t/HiRes.t	Tue Feb 15 22:22:46 2005
@@ -12,7 +12,7 @@
     }
 }
 
-BEGIN { $| = 1; print "1..25\n"; }
+BEGIN { $| = 1; print "1..28\n"; }
 
 END {print "not ok 1\n" unless $loaded;}
 
@@ -26,11 +26,13 @@
 
 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 $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_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");
 }



More information about the Orca-checkins mailing list