diff options
| -rw-r--r-- | ext/Time/HiRes/Changes | 18 | ||||
| -rw-r--r-- | ext/Time/HiRes/HiRes.pm | 36 | ||||
| -rw-r--r-- | ext/Time/HiRes/HiRes.xs | 14 | ||||
| -rw-r--r-- | ext/Time/HiRes/Makefile.PL | 2 | ||||
| -rw-r--r-- | ext/Time/HiRes/ppport.h | 94 | ||||
| -rw-r--r-- | ext/Time/HiRes/t/HiRes.t | 17 |
6 files changed, 125 insertions, 56 deletions
diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes index 06d2effeb3..6277ea6b18 100644 --- a/ext/Time/HiRes/Changes +++ b/ext/Time/HiRes/Changes @@ -1,5 +1,23 @@ 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. diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm index 057b983f2a..e47e09c75e 100644 --- a/ext/Time/HiRes/HiRes.pm +++ b/ext/Time/HiRes/HiRes.pm @@ -15,7 +15,7 @@ require DynaLoader; d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer d_nanosleep); -$VERSION = '1.63'; +$VERSION = '1.65'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -104,8 +104,8 @@ it will fail at compile time. 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 @@ -138,6 +138,8 @@ unlike the C<usleep> system call. See also C<Time::HiRes::sleep()> below. 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] ) @@ -164,7 +166,7 @@ default floating point format of Perl and the seconds since epoch have 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 @@ -175,10 +177,12 @@ seconds and microseconds as two separate values. =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. @@ -187,19 +191,21 @@ is optional and will be zero if unspecified, resulting in C<alarm()>-like 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", diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs index 2fb9d23230..76352e2acd 100644 --- a/ext/Time/HiRes/HiRes.xs +++ b/ext/Time/HiRes/HiRes.xs @@ -24,18 +24,6 @@ extern "C" { } #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 @@ -43,7 +31,7 @@ extern "C" { #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 diff --git a/ext/Time/HiRes/Makefile.PL b/ext/Time/HiRes/Makefile.PL index 449129be3c..2f191ccf52 100644 --- a/ext/Time/HiRes/Makefile.PL +++ b/ext/Time/HiRes/Makefile.PL @@ -470,7 +470,6 @@ sub main { 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) || @@ -480,7 +479,6 @@ NOTE: if you get an error like this (the line number may vary): Makefile:91: *** missing separator then set the environment variable LC_ALL to "C" and retry from scratch (re-run perl "Makefile.PL"). - EOM } } diff --git a/ext/Time/HiRes/ppport.h b/ext/Time/HiRes/ppport.h index 6f93e81939..23d8894bdf 100644 --- a/ext/Time/HiRes/ppport.h +++ b/ext/Time/HiRes/ppport.h @@ -4,10 +4,10 @@ /* ---------------------------------------------------------------------- - 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. @@ -22,7 +22,7 @@ SKIP =head1 NAME -ppport.h - Perl/Pollution/Portability version 3.01 +ppport.h - Perl/Pollution/Portability version 3.03 =head1 SYNOPSIS @@ -399,9 +399,11 @@ CvPADLIST||| 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 @@ -442,6 +444,7 @@ IVdf|5.006000||p LEAVE||| LVRET||| MARK||| +MY_CXT_CLONE|5.009002||p MY_CXT_INIT|5.007003||p MY_CXT|5.007003||p MoveD|5.009002||p @@ -478,6 +481,7 @@ PAD_SET_CUR||| 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 @@ -551,34 +555,34 @@ PL_compiling|5.004050||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 @@ -632,7 +636,10 @@ SAVETMPS||| 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||| @@ -3014,6 +3021,40 @@ typedef NVTYPE 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 @@ -3341,8 +3382,6 @@ DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv) #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 @@ -3365,6 +3404,8 @@ DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv) #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. */ @@ -3409,8 +3450,21 @@ DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv) #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 @@ -3424,10 +3478,14 @@ DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv) #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" diff --git a/ext/Time/HiRes/t/HiRes.t b/ext/Time/HiRes/t/HiRes.t index f81a3ffb05..528ab70b78 100644 --- a/ext/Time/HiRes/t/HiRes.t +++ b/ext/Time/HiRes/t/HiRes.t @@ -166,24 +166,24 @@ if (!$have_ualarm || !$have_alarm) { } 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) { @@ -373,5 +373,6 @@ if ($have_ualarm) { if (defined $pid) { print "# Terminating the timer process $pid\n"; kill('TERM', $pid); # We are done, the timer can go. + unlink("ktrace.out"); } |