ext/Thread/unsync2.t Test thread implicit synchronisation
ext/Thread/unsync3.t Test thread implicit synchronisation
ext/Thread/unsync4.t Test thread implicit synchronisation
+ext/Time/HiRes/Changes Time::HiRes
+ext/Time/HiRes/HiRes.pm Time::HiRes
+ext/Time/HiRes/HiRes.xs Time::HiRes
+ext/Time/HiRes/Makefile.PL Time::HiRes
ext/XS/Typemap/Makefile.PL XS::Typemap extension
ext/XS/Typemap/README XS::Typemap extension
ext/XS/Typemap/Typemap.pm XS::Typemap extension
t/lib/tie-stdhandle.t Test for Tie::StdHandle
t/lib/tie-stdpush.t Test for Tie::StdArray
t/lib/tie-substrhash.t Test for Tie::SubstrHash
+t/lib/time-hires.t Time::HiRes
t/lib/timelocal.t See if Time::Local works
t/lib/trig.t See if Math::Trig works
t/lib/xs-typemap.t test that typemaps work
--- /dev/null
+Revision history for Perl extension Time::HiRes.
+
+1.20 Wed Feb 24 21:30 1999
+ - make our usleep and ualarm substitutes into hrt_usleep
+ and hrt_ualarm. This helps static links of Perl with other
+ packages that also have usleep, etc. From
+ Ilya Zakharevich <ilya@math.ohio-state.edu>
+ - add C API stuff. From Joshua Pritikin
+ <joshua.pritikin@db.com>
+ - VMS Makefile.PL fun. From pvhp@forte.com (Peter Prymmer)
+ - hopefully correct "-lc" fix for SCO.
+ - add PPD stuff
+
+1.19 Tue Sep 29 22:30 1998
+ - put VMS gettimeofday() in. Patch is from Sebastian Bazley
+ <seb@stian.demon.co.uk>
+ - change GIMME_V to GIMME to help people with older versions of
+ Perl.
+ - fix Win32 version of gettimeofday(). It didn't affect anything,
+ but it confuses people reading the code when the return value
+ is backwards (0 is success).
+ - fix Makefile.PL (more) so that detection of gettimeofday is
+ more correct.
+
+1.18 Mon Jul 6 22:40 1998
+ - add usleep() for Win32.
+ - fix Makefile.PL to fix reported HP/UX feature where unresolved
+ externals still cause an executable to be generated (though no
+ x bit set). Thanks to David Kozinn for report and explanation.
+ Problems with the fix are mine :)
+
+1.17 Wed Jul 1 20:10 1998
+ - fix setitimer calls so microseconds is not more than 1000000.
+ Hp/UX 9 doesn't like that. Provided by Roland B Robert, PhD.
+ - make Win32. We only get gettimeofday (the select hack doesn't
+ seem to work on my Win95 system).
+ - fix test 4 on 01test.t. add test to see if time() and
+ Time::HiRes::time() are close.
+
+1.16 Wed Nov 12 21:05 1997
+ - add missing EXTEND in new gettimeofday scalar code.
+
+1.15 Mon Nov 10 21:30 1997
+ - HiRes.pm: update pod. Provided by Gisle Aas.
+ - HiRes.xs: if gettimeofday() called in scalar context, do
+ something more useful than before. Provided by Gisle Aas.
+ - README: tell of xsubpp '-nolinenumber' woes. thanks to
+ Edward Henigin <ed@texas.net> for pointing out the problem.
+
+1.14 Wed Nov 5 9:40 1997
+ - Makefile.PL: look for setitimer
+ - HiRes.xs: if missing ualarm, but we have setitimer, make up
+ our own setitimer. These were provided by Gisle Aas.
+
+1.13 Tue Nov 4 23:30 1997
+ - Makefile.PL: fix autodetect mechanism to do try linking in addition
+ to just compiling; should fix Linux build problem. Fix was provided
+ by Gisle Aas.
+
+1.12 Sun Oct 12 12:00:00 1997
+ - Makefile.PL: set XSOPT to '-nolinenumbers' to work around xsubpp bug;
+ you may need to comment this back out if you have an older xsubpp.
+ - HiRes.xs: set PROTOTYPES: DISABLE
+
+1.11 Fri Sep 05 16:00:00 1997
+ - Makefile.PL:
+ Had some line commented out that shouldn't have been (testing
+ remnants)
+ - README:
+ Previous version was corrupted.
+
+1.10 Thu May 22 20:20:00 1997
+ - HiRes.xs, HiRes.pm, t/*:
+ - only compile what we have OS support for (or can
+ fake with select())
+ - only test what we compiled
+ - gross improvement to the test suite
+ - fix EXPORT_FAIL.
+ This work was all done by Roderick Schertler
+ <roderick@argon.org>. If you run Linux or
+ one of the other ualarm-less platoforms, and you like this
+ module, let Roderick know; without him, it still wouldn't
+ be working on those boxes...
+ - Makefile.PL: figure out what routines the OS has and
+ only build what we need. These bits were written by Jarkko
+ Hietaniemi <jhi@iki.fi>. Again, gratitude is due...
+
+1.02 Mon Dec 30 08:00:00 1996
+ - HiRes.pm: update documentation to say what to do when missing
+ ualarm() and friends.
+ - README: update to warn that ualarm() and friends need to exist
+
+1.01 Fri Oct 17 08:00:00 1996
+ - Makefile.PL: make XSPROTOARGS => '-noprototyopes'
+ - HiRes.pm: put blank line between __END__ and =head1 so that
+ pod2man works.
+
+1.00 Tue Sep 03 13:00:00 1996
+ - original version; created by h2xs 1.16
--- /dev/null
+package Time::HiRes;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK @EXPORT_FAIL);
+
+require Exporter;
+require DynaLoader;
+
+@ISA = qw(Exporter DynaLoader);
+
+@EXPORT = qw( );
+@EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval);
+
+$VERSION = do{my@r=q$Revision: 1.20 $=~/\d+/g;sprintf '%02d.'.'%02d'x$#r,@r};
+
+bootstrap Time::HiRes $VERSION;
+
+@EXPORT_FAIL = grep { ! defined &$_ } @EXPORT_OK;
+
+# Preloaded methods go here.
+
+sub tv_interval {
+ # probably could have been done in C
+ my ($a, $b) = @_;
+ $b = [gettimeofday()] unless defined($b);
+ (${$b}[0] - ${$a}[0]) + ((${$b}[1] - ${$a}[1]) / 1_000_000);
+}
+
+# I'm only supplying this because the version of it in 5.003's Export.pm
+# is buggy (it doesn't shift off the class name).
+
+sub export_fail {
+ my $self = shift;
+ @_;
+}
+
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+1;
+__END__
+
+=head1 NAME
+
+Time::HiRes - High resolution ualarm, usleep, and gettimeofday
+
+=head1 SYNOPSIS
+
+ use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
+
+ usleep ($microseconds);
+
+ ualarm ($microseconds);
+ ualarm ($microseconds, $interval_microseconds);
+
+ $t0 = [gettimeofday];
+ ($seconds, $microseconds) = gettimeofday;
+
+ $elapsed = tv_interval ( $t0, [$seconds, $microseconds]);
+ $elapsed = tv_interval ( $t0, [gettimeofday]);
+ $elapsed = tv_interval ( $t0 );
+
+ use Time::HiRes qw ( time alarm sleep );
+ $now_fractions = time;
+ sleep ($floating_seconds);
+ alarm ($floating_seconds);
+ alarm ($floating_seconds, $floating_interval);
+
+=head1 DESCRIPTION
+
+The C<Time::HiRes> module implements a Perl interface to the usleep, ualarm,
+and gettimeofday system calls. See the EXAMPLES section below and the test
+scripts for usage; see your system documentation for the description of
+the underlying gettimeofday, usleep, and ualarm calls.
+
+If your system lacks gettimeofday(2) you don't get gettimeofday() or the
+one-arg form of tv_interval(). If you don't have usleep(3) or select(2)
+you don't get usleep() or sleep(). If your system don't have ualarm(3)
+or setitimer(2) you don't
+get ualarm() or alarm(). If you try to import an unimplemented function
+in the C<use> statement it will fail at compile time.
+
+The following functions can be imported from this module. No
+functions are exported by default.
+
+=over 4
+
+=item gettimeofday ()
+
+In array context it returns a 2 element array with the seconds and
+microseconds since the epoch. In scalar context it returns floating
+seconds like Time::HiRes::time() (see below).
+
+=item usleep ( $useconds )
+
+Issues a usleep for the number of microseconds specified. See also
+Time::HiRes::sleep() below.
+
+=item ualarm ( $useconds [, $interval_useconds ] )
+
+Issues a ualarm call; interval_useconds is optional and will be 0 if
+unspecified, resulting in alarm-like behaviour.
+
+=item tv_interval ( $ref_to_gettimeofday [, $ref_to_later_gettimeofday] )
+
+Returns the floating seconds between the two times, which should have been
+returned by gettimeofday(). If the second argument is omitted, then the
+current time is used.
+
+=item time ()
+
+Returns a floating seconds since the epoch. This function can be imported,
+resulting in a nice drop-in replacement for the C<time> provided with perl,
+see the EXAMPLES below.
+
+=item sleep ( $floating_seconds )
+
+Converts $floating_seconds to microseconds and issues a usleep for the
+result. This function can be imported, resulting in a nice drop-in
+replacement for the C<sleep> provided with perl, see the EXAMPLES below.
+
+=item alarm ( $floating_seconds [, $interval_floating_seconds ] )
+
+Converts $floating_seconds and $interval_floating_seconds and issues
+a ualarm for the results. The $interval_floating_seconds argument
+is optional and will be 0 if unspecified, resulting in alarm-like
+behaviour. This function can be imported, resulting in a nice drop-in
+replacement for the C<alarm> provided with perl, see the EXAMPLES below.
+
+=back
+
+=head1 EXAMPLES
+
+ use Time::HiRes qw(usleep ualarm gettimeofday tv_interval);
+
+ $microseconds = 750_000;
+ usleep $microseconds;
+
+ # signal alarm in 2.5s & every .1s thereafter
+ ualarm 2_500_000, 100_000;
+
+ # get seconds and microseconds since the epoch
+ ($s, $usec) = gettimeofday;
+
+ # measure elapsed time
+ # (could also do by subtracting 2 gettimeofday return values)
+ $t0 = [gettimeofday];
+ # do bunch of stuff here
+ $t1 = [gettimeofday];
+ # do more stuff here
+ $t0_t1 = tv_interval $t0, $t1;
+
+ $elapsed = tv_interval ($t0, [gettimeofday]);
+ $elapsed = tv_interval ($t0); # equivalent code
+
+ #
+ # replacements for time, alarm and sleep that know about
+ # floating seconds
+ #
+ use Time::HiRes;
+ $now_fractions = Time::HiRes::time;
+ Time::HiRes::sleep (2.5);
+ Time::HiRes::alarm (10.6666666);
+
+ use Time::HiRes qw ( time alarm sleep );
+ $now_fractions = time;
+ sleep (2.5);
+ alarm (10.6666666);
+
+=head1 C API
+
+In addition to the perl API described above, a C API is available for
+extension writers. The following C functions are available in the
+modglobal hash:
+
+ name C prototype
+ --------------- ----------------------
+ Time::NVtime double (*)()
+ Time::U2time void (*)(UV ret[2])
+
+Both functions return equivalent information (like C<gettimeofday>)
+but with different representations. The names C<NVtime> and C<U2time>
+were selected mainly because they are operating system independent.
+(C<gettimeofday> is Un*x-centric.)
+
+Here is an example of using NVtime from C:
+
+ double (*myNVtime)();
+ SV **svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0);
+ if (!svp) croak("Time::HiRes is required");
+ if (!SvIOK(*svp)) croak("Time::NVtime isn't a function pointer");
+ myNVtime = (double(*)()) SvIV(*svp);
+ printf("The current time is: %f\n", (*myNVtime)());
+
+=head1 AUTHORS
+
+D. Wegscheid <wegscd@whirlpool.com>
+R. Schertler <roderick@argon.org>
+J. Hietaniemi <jhi@iki.fi>
+G. Aas <gisle@aas.no>
+
+=head1 REVISION
+
+$Id: HiRes.pm,v 1.20 1999/03/16 02:26:13 wegscd Exp $
+
+$Log: HiRes.pm,v $
+Revision 1.20 1999/03/16 02:26:13 wegscd
+Add documentation for NVTime and U2Time.
+
+Revision 1.19 1998/09/30 02:34:42 wegscd
+No changes, bump version.
+
+Revision 1.18 1998/07/07 02:41:35 wegscd
+No changes, bump version.
+
+Revision 1.17 1998/07/02 01:45:13 wegscd
+Bump version to 1.17
+
+Revision 1.16 1997/11/13 02:06:36 wegscd
+version bump to accomodate HiRes.xs fix.
+
+Revision 1.15 1997/11/11 02:17:59 wegscd
+POD editing, courtesy of Gisle Aas.
+
+Revision 1.14 1997/11/06 03:14:35 wegscd
+Update version # for Makefile.PL and HiRes.xs changes.
+
+Revision 1.13 1997/11/05 05:36:25 wegscd
+change version # for Makefile.pl and HiRes.xs changes.
+
+Revision 1.12 1997/10/13 20:55:33 wegscd
+Force a new version for Makefile.PL changes.
+
+Revision 1.11 1997/09/05 19:59:33 wegscd
+New version to bump version for README and Makefile.PL fixes.
+Fix bad RCS log.
+
+Revision 1.10 1997/05/23 01:11:38 wegscd
+Conditional compilation; EXPORT_FAIL fixes.
+
+Revision 1.2 1996/12/30 13:28:40 wegscd
+Update documentation for what to do when missing ualarm() and friends.
+
+Revision 1.1 1996/10/17 20:53:31 wegscd
+Fix =head1 being next to __END__ so pod2man works
+
+Revision 1.0 1996/09/03 18:25:15 wegscd
+Initial revision
+
+=head1 COPYRIGHT
+
+Copyright (c) 1996-1997 Douglas E. Wegscheid.
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
--- /dev/null
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#ifdef WIN32
+#include <time.h>
+#else
+#include <sys/time.h>
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+#if !defined(HAS_GETTIMEOFDAY) && defined(WIN32)
+#define HAS_GETTIMEOFDAY
+
+/* shows up in winsock.h?
+struct timeval {
+ long tv_sec;
+ long tv_usec;
+}
+*/
+
+int
+gettimeofday (struct timeval *tp, int nothing)
+{
+ SYSTEMTIME st;
+ time_t tt;
+ struct tm tmtm;
+ /* mktime converts local to UTC */
+ GetLocalTime (&st);
+ tmtm.tm_sec = st.wSecond;
+ tmtm.tm_min = st.wMinute;
+ tmtm.tm_hour = st.wHour;
+ tmtm.tm_mday = st.wDay;
+ tmtm.tm_mon = st.wMonth - 1;
+ tmtm.tm_year = st.wYear - 1900;
+ tmtm.tm_isdst = -1;
+ tt = mktime (&tmtm);
+ tp->tv_sec = tt;
+ tp->tv_usec = st.wMilliseconds * 1000;
+ return 0;
+}
+#endif
+
+#if !defined(HAS_GETTIMEOFDAY) && defined(VMS)
+#define HAS_GETTIMEOFDAY
+
+#include <time.h> /* gettimeofday */
+#include <stdlib.h> /* qdiv */
+#include <starlet.h> /* sys$gettim */
+#include <descrip.h>
+
+/*
+ VMS binary time is expressed in 100 nano-seconds since
+ system base time which is 17-NOV-1858 00:00:00.00
+*/
+
+#define DIV_100NS_TO_SECS 10000000L
+#define DIV_100NS_TO_USECS 10L
+
+/*
+ gettimeofday is supposed to return times since the epoch
+ so need to determine this in terms of VMS base time
+*/
+static $DESCRIPTOR(dscepoch,"01-JAN-1970 00:00:00.00");
+
+static __int64 base_adjust=0;
+
+int
+gettimeofday (struct timeval *tp, void *tpz)
+{
+ long ret;
+ __int64 quad;
+ __qdiv_t ans1,ans2;
+
+/*
+ In case of error, tv_usec = 0 and tv_sec = VMS condition code.
+ The return from function is also set to -1.
+ This is not exactly as per the manual page.
+*/
+
+ tp->tv_usec = 0;
+
+ if (base_adjust==0) { /* Need to determine epoch adjustment */
+ ret=sys$bintim(&dscepoch,&base_adjust);
+ if (1 != (ret &&1)) {
+ tp->tv_sec = ret;
+ return -1;
+ }
+ }
+
+ ret=sys$gettim(&quad); /* Get VMS system time */
+ if ((1 && ret) == 1) {
+ quad -= base_adjust; /* convert to epoch offset */
+ ans1=qdiv(quad,DIV_100NS_TO_SECS);
+ ans2=qdiv(ans1.rem,DIV_100NS_TO_USECS);
+ tp->tv_sec = ans1.quot; /* Whole seconds */
+ tp->tv_usec = ans2.quot; /* Micro-seconds */
+ } else {
+ tp->tv_sec = ret;
+ return -1;
+ }
+ return 0;
+}
+#endif
+
+#if !defined(HAS_USLEEP) && defined(HAS_SELECT)
+#ifndef SELECT_IS_BROKEN
+#define HAS_USLEEP
+#define usleep hrt_usleep /* could conflict with ncurses for static build */
+
+void
+hrt_usleep(unsigned long usec)
+{
+ struct timeval tv;
+ tv.tv_sec = 0;
+ tv.tv_usec = usec;
+ select(0, (Select_fd_set_t)NULL, (Select_fd_set_t)NULL,
+ (Select_fd_set_t)NULL, &tv);
+}
+#endif
+#endif
+
+#if !defined(HAS_USLEEP) && defined(WIN32)
+#define HAS_USLEEP
+#define usleep hrt_usleep /* could conflict with ncurses for static build */
+
+void
+hrt_usleep(unsigned long usec)
+{
+ long msec;
+ msec = usec / 1000;
+ Sleep (msec);
+}
+#endif
+
+
+#if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
+#define HAS_UALARM
+#define ualarm hrt_ualarm /* could conflict with ncurses for static build */
+
+int
+hrt_ualarm(int usec, int interval)
+{
+ struct itimerval itv;
+ itv.it_value.tv_sec = usec / 1000000;
+ itv.it_value.tv_usec = usec % 1000000;
+ itv.it_interval.tv_sec = interval / 1000000;
+ itv.it_interval.tv_usec = interval % 1000000;
+ return setitimer(ITIMER_REAL, &itv, 0);
+}
+#endif
+
+#ifdef HAS_GETTIMEOFDAY
+
+static void
+myU2time(UV *ret)
+{
+ struct timeval Tp;
+ int status;
+ status = gettimeofday (&Tp, NULL);
+ ret[0] = Tp.tv_sec;
+ ret[1] = Tp.tv_usec;
+}
+
+static double
+myNVtime()
+{
+ struct timeval Tp;
+ int status;
+ status = gettimeofday (&Tp, NULL);
+ return Tp.tv_sec + (Tp.tv_usec / 1000000.);
+}
+
+#endif
+
+MODULE = Time::HiRes PACKAGE = Time::HiRes
+
+PROTOTYPES: ENABLE
+
+BOOT:
+#ifdef ATLEASTFIVEOHOHFIVE
+#ifdef HAS_GETTIMEOFDAY
+ hv_store(PL_modglobal, "Time::NVtime", 12, newSViv((IV) myNVtime), 0);
+ hv_store(PL_modglobal, "Time::U2time", 12, newSViv((IV) myU2time), 0);
+#endif
+#endif
+
+#ifdef HAS_USLEEP
+
+void
+usleep(useconds)
+ int useconds
+
+void
+sleep(fseconds)
+ double fseconds
+ CODE:
+ int useconds = fseconds * 1000000;
+ usleep (useconds);
+
+#endif
+
+#ifdef HAS_UALARM
+
+int
+ualarm(useconds,interval=0)
+ int useconds
+ int interval
+
+int
+alarm(fseconds,finterval=0)
+ double fseconds
+ double finterval
+ PREINIT:
+ int useconds, uinterval;
+ CODE:
+ useconds = fseconds * 1000000;
+ uinterval = finterval * 1000000;
+ RETVAL = ualarm (useconds, uinterval);
+
+#endif
+
+#ifdef HAS_GETTIMEOFDAY
+
+void
+gettimeofday()
+ PREINIT:
+ struct timeval Tp;
+ PPCODE:
+ int status;
+ status = gettimeofday (&Tp, NULL);
+ if (GIMME == G_ARRAY) {
+ EXTEND(sp, 2);
+ PUSHs(sv_2mortal(newSViv(Tp.tv_sec)));
+ PUSHs(sv_2mortal(newSViv(Tp.tv_usec)));
+ } else {
+ EXTEND(sp, 1);
+ PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / 1000000.0))));
+ }
+
+double
+time()
+ PREINIT:
+ struct timeval Tp;
+ CODE:
+ int status;
+ status = gettimeofday (&Tp, NULL);
+ RETVAL = Tp.tv_sec + (Tp.tv_usec / 1000000.);
+ OUTPUT:
+ RETVAL
+
+#endif
+
+# $Id: HiRes.xs,v 1.11 1999/03/16 02:27:38 wegscd Exp wegscd $
+
+# $Log: HiRes.xs,v $
+# Revision 1.11 1999/03/16 02:27:38 wegscd
+# Add U2time, NVtime. Fix symbols for static link.
+#
+# Revision 1.10 1998/09/30 02:36:25 wegscd
+# Add VMS changes.
+#
+# Revision 1.9 1998/07/07 02:42:06 wegscd
+# Win32 usleep()
+#
+# Revision 1.8 1998/07/02 01:47:26 wegscd
+# Add Win32 code for gettimeofday.
+#
+# Revision 1.7 1997/11/13 02:08:12 wegscd
+# Add missing EXTEND in gettimeofday() scalar code.
+#
+# Revision 1.6 1997/11/11 02:32:35 wegscd
+# Do something useful when calling gettimeofday() in a scalar context.
+# The patch is courtesy of Gisle Aas.
+#
+# Revision 1.5 1997/11/06 03:10:47 wegscd
+# Fake ualarm() if we have setitimer.
+#
+# Revision 1.4 1997/11/05 05:41:23 wegscd
+# Turn prototypes ON (suggested by Gisle Aas)
+#
+# Revision 1.3 1997/10/13 20:56:15 wegscd
+# Add PROTOTYPES: DISABLE
+#
+# Revision 1.2 1997/05/23 01:01:38 wegscd
+# Conditional compilation, depending on what the OS gives us.
+#
+# Revision 1.1 1996/09/03 18:26:35 wegscd
+# Initial revision
+#
+#
--- /dev/null
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+#
+
+use strict;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'Time::HiRes',
+ 'VERSION_FROM' => 'HiRes.pm',
+);
+
--- /dev/null
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+BEGIN { $| = 1; print "1..17\n"; }
+
+END {print "not ok 1\n" unless $loaded;}
+
+use Time::HiRes qw(tv_interval);
+
+$loaded = 1;
+
+print "ok 1\n";
+
+use strict;
+
+my $have_gettimeofday = defined &Time::HiRes::gettimeofday;
+my $have_usleep = defined &Time::HiRes::usleep;
+my $have_ualarm = defined &Time::HiRes::ualarm;
+
+import Time::HiRes 'gettimeofday' if $have_gettimeofday;
+import Time::HiRes 'usleep' if $have_usleep;
+import Time::HiRes 'ualarm' if $have_ualarm;
+
+sub skip {
+ map { print "ok $_ (skipped)\n" } @_;
+}
+
+sub ok {
+ my ($n, $result, @info) = @_;
+ if ($result) {
+ print "ok $n\n";
+ }
+ else {
+ print "not ok $n\n";
+ print "# @info\n" if @info;
+ }
+}
+
+if (!$have_gettimeofday) {
+ skip 2..6;
+}
+else {
+ my @one = gettimeofday();
+ ok 2, @one == 2, 'gettimeofday returned ', 0+@one, ' args';
+ ok 3, $one[0] > 850_000_000, "@one too small";
+
+ sleep 1;
+
+ my @two = gettimeofday();
+ ok 4, ($two[0] > $one[0] || ($two[0] == $one[0] && $two[1] > $one[1])),
+ "@two is not greater than @one";
+
+ my $f = Time::HiRes::time;
+ ok 5, $f > 850_000_000, "$f too small";
+ ok 6, $f - $two[0] < 2, "$f - @two >= 2";
+}
+
+if (!$have_usleep) {
+ skip 7..8;
+}
+else {
+ my $one = time;
+ usleep(10_000);
+ my $two = time;
+ usleep(10_000);
+ my $three = time;
+ ok 7, $one == $two || $two == $three, "slept too long, $one $two $three";
+
+ if (!$have_gettimeofday) {
+ skip 8;
+ }
+ else {
+ my $f = Time::HiRes::time;
+ usleep(500_000);
+ my $f2 = Time::HiRes::time;
+ my $d = $f2 - $f;
+ ok 8, $d > 0.4 && $d < 0.8, "slept $d secs $f to $f2";
+ }
+}
+
+# Two-arg tv_interval() is always available.
+{
+ my $f = tv_interval [5, 100_000], [10, 500_000];
+ ok 9, $f == 5.4, $f;
+}
+
+if (!$have_gettimeofday) {
+ skip 10;
+}
+else {
+ my $r = [gettimeofday()];
+ my $f = tv_interval $r;
+ ok 10, $f < 2, $f;
+}
+
+if (!$have_usleep) {
+ skip 11;
+}
+else {
+ my $r = [gettimeofday()];
+ #jTime::HiRes::sleep 0.5;
+ Time::HiRes::sleep( 0.5 );
+ my $f = tv_interval $r;
+ ok 11, $f > 0.4 && $f < 0.8, "slept $f secs";
+}
+
+if (!$have_ualarm) {
+ skip 12..13;
+}
+else {
+ my $tick = 0;
+ local $SIG{ALRM} = sub { $tick++ };
+
+ my $one = time; $tick = 0; ualarm(10_000); sleep until $tick;
+ my $two = time; $tick = 0; ualarm(10_000); sleep until $tick;
+ my $three = time;
+ ok 12, $one == $two || $two == $three, "slept too long, $one $two $three";
+
+ $tick = 0;
+ ualarm(10_000, 10_000);
+ sleep until $tick >= 3;
+ ok 13, 1;
+ ualarm(0);
+}
+
+# new test: did we even get close?
+
+{
+ my $t = time();
+ my $tf = Time::HiRes::time();
+ ok 14, ($tf >= $t) && (($tf - $t) <= 1),
+ "time $t differs from Time::HiRes::time $tf";
+}
+
+unless (defined &Time::HiRes::gettimeofday
+ && defined &Time::HiRes::ualarm
+ && defined &Time::HiRes::usleep) {
+ for (15..17) {
+ print "ok $_ # skipped\n";
+ }
+} else {
+ use Time::HiRes qw (time alarm sleep);
+
+ my ($f, $r, $i);
+
+ print "# time...";
+ $f = time;
+ print "$f\nok 15\n";
+
+ print "# sleep...";
+ $r = [Time::HiRes::gettimeofday];
+ sleep (0.5);
+ print Time::HiRes::tv_interval($r), "\nok 16\n";
+
+ $r = [Time::HiRes::gettimeofday];
+ $i = 5;
+ $SIG{ALRM} = "tick";
+ while ($i)
+ {
+ alarm(2.5);
+ select (undef, undef, undef, 10);
+ print "# Select returned! ", Time::HiRes::tv_interval ($r), "\n";
+ }
+
+ sub tick
+ {
+ print "# Tick! ", Time::HiRes::tv_interval ($r), "\n";
+ $i--;
+ }
+ $SIG{ALRM} = 'DEFAULT';
+
+ print "ok 17\n";
+}
+
projects / p5sagit/p5-mst-13.2.git / commitdiff