Revision history for Perl extension Time::HiRes.
+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
+ loop executing an empty block
+ - in the documentation underline the unspecificity of mixing
+ sleeps and alarms
+ - small spelling fixes
+
+1.64
+ - regenerate ppport.h with Devel::PPPort 3.03,
+ now the MY_CXT_CLONE is defined in ppport.h,
+ we no more need to do that.
+
+ - the test #12 would often hang in sigsuspend() (at least that's
+ where Mac OS X' ktrace shows it hanging). With the sleep()s
+ changed to sleep(1)s, the tests still pass but no hang after
+ a few hundred repeats.
+
1.63
- Win32 and any ithread build: ppport.h didn't define
MY_CXT_CLONE, which seems to be a Time-HiResism.
d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
d_nanosleep);
-$VERSION = '1.63';
+$VERSION = '1.65';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
If your subsecond sleeping is implemented with C<nanosleep()> instead
of C<usleep()>, you can mix subsecond sleeping with signals since
-C<nanosleep()> does not use signals. This, however is unportable, and
-you should first check for the truth value of
+C<nanosleep()> 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<nanosleep()> C API documentation for any
peculiarities. (There is no separate interface to call
Issues a C<ualarm> call; the C<$interval_useconds> is optional and
will be zero if unspecified, resulting in C<alarm>-like behaviour.
+Note that the interaction between alarms and sleeps are unspecified.
+
=item tv_interval
tv_interval ( $ref_to_gettimeofday [, $ref_to_later_gettimeofday] )
conspired to produce an apparent bug: if you print the value of
C<Time::HiRes::time()> you seem to be getting only five decimals, not
six as promised (microseconds). Not to worry, the microseconds are
-there (assuming your platform supports such granularity in first
+there (assuming your platform supports such granularity in the first
place). What is going on is that the default floating point format of
Perl only outputs 15 digits. In this case that means ten digits
before the decimal separator and five after. To see the microseconds
=item sleep ( $floating_seconds )
Sleeps for the specified amount of seconds. Returns the number of
-seconds actually slept (a floating point value). This function can be
-imported, resulting in a nice drop-in replacement for the C<sleep>
+seconds actually slept (a floating point value). This function can
+be imported, resulting in a nice drop-in replacement for the C<sleep>
provided with perl, see the L</EXAMPLES> below.
+Note that the interaction between alarms and sleeps are unspecified.
+
=item alarm ( $floating_seconds [, $interval_floating_seconds ] )
The C<SIGALRM> signal is sent after the specified number of seconds.
behaviour. This function can be imported, resulting in a nice drop-in
replacement for the C<alarm> provided with perl, see the L</EXAMPLES> below.
-B<NOTE 1>: With some operating system and Perl release combinations
-C<SIGALRM> restarts C<select()>, instead of interuping it.
-This means that an C<alarm()> followed by a C<select()>
-may together take the sum of the times specified for the the
-C<alarm()> and the C<select()>, not just the time of the C<alarm()>.
+B<NOTE 1>: With some combinations of operating systems and Perl
+releases C<SIGALRM> restarts C<select()>, instead of interrupting it.
+This means that an C<alarm()> followed by a C<select()> may together
+take the sum of the times specified for the the C<alarm()> and the
+C<select()>, not just the time of the C<alarm()>.
+
+Note that the interaction between alarms and sleeps are unspecified.
=item setitimer ( $which, $floating_seconds [, $interval_floating_seconds ] )
Start up an interval timer: after a certain time, a signal arrives,
-and more signals may keep arriving at certain intervals. To disable a
-timer, use C<$floating_seconds> of zero. If the C<$interval_floating_seconds>
-is set to zero (or unspecified), the timer is disabled B<after> the
-next delivered signal.
+and more signals may keep arriving at certain intervals. To disable
+an "itimer", use C<$floating_seconds> of zero. If the
+C<$interval_floating_seconds> is set to zero (or unspecified), the
+timer is disabled B<after> the next delivered signal.
Use of interval timers may interfere with C<alarm()>, C<sleep()>,
and C<usleep()>. In standard-speak the "interaction is unspecified",
}
#endif
-#ifdef START_MY_CXT
-# ifndef MY_CXT_CLONE
-# define MY_CXT_CLONE \
- dMY_CXT_SV; \
- my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
- Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t); \
- sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
-# endif
-#else
-# define MY_CXT_CLONE NOOP
-#endif
-
#ifndef PerlProc_pause
# define PerlProc_pause() Pause()
#endif
#ifdef HAS_PAUSE
# define Pause pause
#else
-# define Pause() sleep(~0)
+# define Pause() sleep(~0) /* Zzz for a long time. */
#endif
/* Though the cpp define ITIMER_VIRTUAL is available the functionality
unless (exists $ENV{PERL_CORE} && $ENV{PERL_CORE}) {
print <<EOM;
Now you may issue '$make'. Do not forget also '$make test'.
-
EOM
if ((exists $ENV{LC_ALL} && $ENV{LC_ALL} =~ /utf-?8/i) ||
(exists $ENV{LC_CTYPE} && $ENV{LC_CTYPE} =~ /utf-?8/i) ||
Makefile:91: *** missing separator
then set the environment variable LC_ALL to "C" and retry
from scratch (re-run perl "Makefile.PL").
-
EOM
}
}
/*
----------------------------------------------------------------------
- ppport.h -- Perl/Pollution/Portability Version 3.01
+ ppport.h -- Perl/Pollution/Portability Version 3.03
Automatically created by Devel::PPPort running under
- perl 5.008003 on Tue Aug 31 18:31:21 2004.
+ perl 5.008004 on Thu Sep 16 09:09:58 2004.
Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
includes in parts/inc/ instead.
=head1 NAME
-ppport.h - Perl/Pollution/Portability version 3.01
+ppport.h - Perl/Pollution/Portability version 3.03
=head1 SYNOPSIS
CvSTASH|||
CvWEAKOUTSIDE|||
DEFSV|5.004050||p
+END_EXTERN_C|5.005000||p
ENTER|||
ERRSV|5.004050||p
EXTEND|||
+EXTERN_C|5.005000||p
FREETMPS|||
GIMME_V||5.004000|n
GIMME|||n
LEAVE|||
LVRET|||
MARK|||
+MY_CXT_CLONE|5.009002||p
MY_CXT_INIT|5.007003||p
MY_CXT|5.007003||p
MoveD|5.009002||p
PAD_SVl|||
PAD_SV|||
PERL_BCDVERSION|5.009002||p
+PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
PERL_INT_MAX|5.004000||p
PERL_INT_MIN|5.004000||p
PERL_LONG_MAX|5.004000||p
PL_copline|5.005000||p
PL_curcop|5.004050||p
PL_curstash|5.004050||p
-PL_debstash|||p
+PL_debstash|5.004050||p
PL_defgv|5.004050||p
-PL_diehook|||p
+PL_diehook|5.004050||p
PL_dirty|5.004050||p
PL_dowarn|||pn
-PL_errgv|||p
+PL_errgv|5.004050||p
PL_hexdigit|5.005000||p
PL_hints|5.005000||p
PL_last_in_gv|||n
PL_modglobal||5.005000|n
PL_na|5.004050||pn
-PL_no_modify|||p
+PL_no_modify|5.006000||p
PL_ofs_sv|||n
-PL_perl_destruct_level|||p
+PL_perl_destruct_level|5.004050||p
PL_perldb|5.004050||p
-PL_ppaddr|||p
+PL_ppaddr|5.006000||p
PL_rsfp_filters|5.004050||p
PL_rsfp|5.004050||p
PL_rs|||n
-PL_stack_base|||p
-PL_stack_sp|||p
+PL_stack_base|5.004050||p
+PL_stack_sp|5.004050||p
PL_stdingv|5.004050||p
-PL_sv_arenaroot|||p
+PL_sv_arenaroot|5.004050||p
PL_sv_no|5.004050||pn
PL_sv_undef|5.004050||pn
PL_sv_yes|5.004050||pn
-PL_tainted|||p
-PL_tainting|||p
+PL_tainted|5.004050||p
+PL_tainting|5.004050||p
POPi|||n
POPl|||n
POPn|||n
SAVE_DEFSV|5.004050||p
SPAGAIN|||
SP|||
+START_EXTERN_C|5.005000||p
START_MY_CXT|5.007003||p
+STMT_END|||p
+STMT_START|||p
ST|||
SVt_IV|||
SVt_NV|||
# endif
#endif /* !INT2PTR */
+
+#undef START_EXTERN_C
+#undef END_EXTERN_C
+#undef EXTERN_C
+#ifdef __cplusplus
+# define START_EXTERN_C extern "C" {
+# define END_EXTERN_C }
+# define EXTERN_C extern "C"
+#else
+# define START_EXTERN_C
+# define END_EXTERN_C
+# define EXTERN_C extern
+#endif
+
+#ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
+# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# endif
+#endif
+
+#undef STMT_START
+#undef STMT_END
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
+# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
+# define STMT_END )
+#else
+# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
+# define STMT_START if (1)
+# define STMT_END else (void)0
+# else
+# define STMT_START do
+# define STMT_END while (0)
+# endif
+#endif
#ifndef boolSV
# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
#endif
#endif
#endif
-#ifndef START_MY_CXT
-
/*
* Boilerplate macros for initializing and accessing interpreter-local
* data from C. All statics in extensions should be reworked to use
#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
+#ifndef START_MY_CXT
+
/* This must appear in all extensions that define a my_cxt_t structure,
* right after the definition (i.e. at file scope). The non-threads
* case below uses it to declare the data as static. */
#define aMY_CXT_ aMY_CXT,
#define _aMY_CXT ,aMY_CXT
+#endif /* START_MY_CXT */
+
+#ifndef MY_CXT_CLONE
+/* Clones the per-interpreter data. */
+#define MY_CXT_CLONE \
+ dMY_CXT_SV; \
+ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+ Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
+ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+#endif
+
#else /* single interpreter */
+#ifndef START_MY_CXT
+
#define START_MY_CXT static my_cxt_t my_cxt;
#define dMY_CXT_SV dNOOP
#define dMY_CXT dNOOP
#define aMY_CXT_
#define _aMY_CXT
-#endif
-
#endif /* START_MY_CXT */
+#ifndef MY_CXT_CLONE
+#define MY_CXT_CLONE NOOP
+#endif
+
+#endif
+
#ifndef IVdf
# if IVSIZE == LONGSIZE
# define IVdf "ld"
}
else {
my $tick = 0;
- local $SIG{ALRM} = sub { $tick++ };
+ local $SIG{ ALRM } = sub { $tick++ };
- my $one = time; $tick = 0; ualarm(10_000); while ($tick == 0) { sleep }
- my $two = time; $tick = 0; ualarm(10_000); while ($tick == 0) { sleep }
+ my $one = time; $tick = 0; ualarm(10_000); while ($tick == 0) { }
+ my $two = time; $tick = 0; ualarm(10_000); while ($tick == 0) { }
my $three = time;
ok 12, $one == $two || $two == $three, "slept too long, $one $two $three";
+ print "# tick = $tick, one = $one, two = $two, three = $three\n";
- $tick = 0;
- ualarm(10_000, 10_000);
- while ($tick < 3) { sleep }
+ $tick = 0; ualarm(10_000, 10_000); while ($tick < 3) { }
ok 13, 1;
ualarm(0);
+ print "# tick = $tick, one = $one, two = $two, three = $three\n";
}
-# new test: did we even get close?
+# Did we even get close?
if (!$have_time) {
- skip 14
+ skip 14;
} else {
my ($s, $n, $i) = (0);
for $i (1 .. 100) {
if (defined $pid) {
print "# Terminating the timer process $pid\n";
kill('TERM', $pid); # We are done, the timer can go.
+ unlink("ktrace.out");
}