Hello community,
here is the log from the commit of package perl-Sys-SigAction for
openSUSE:Factory checked in at 2013-08-13 10:19:11
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Sys-SigAction (Old)
and /work/SRC/openSUSE:Factory/.perl-Sys-SigAction.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Sys-SigAction"
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-Sys-SigAction/perl-Sys-SigAction.changes
2013-07-29 17:50:50.000000000 +0200
+++
/work/SRC/openSUSE:Factory/.perl-Sys-SigAction.new/perl-Sys-SigAction.changes
2013-08-13 10:19:13.000000000 +0200
@@ -1,0 +2,40 @@
+Tue Aug 6 17:49:06 UTC 2013 - [email protected]
+
+- updated to 0.20
+ Even if C<Time::HiRes::ualarm()> exists, it may not necessarily
+ work. (There were way too many broken smoke tests with were
+ the result of this. One reason for this may bave been that the test
+ was looking for too small an interval of sub-second timeouts. On busy
+ systems, this may have been causing tests to fail.
+
+ Got rid of the attempt at tracking broken environments in timeout.t
+ (the hash structure mentioned in the previous change.
+
+ The sub-second timer tests now set a timeout at 0.1 seconds, and check
+ for a delta time the is less then 0.8 seconds. Proving that they completed
+ in under 1 second, but give a wide range of execution time to account
+ for busy systems.
+
+ Also Makefile.PL now looks for C<Time::HiRes::ualarm()>, and tests it.
+ If it works, high resolution timeouts are enabled in Sys
+ Makefile.PL reports what it finds, and t/timeout.t reports when high
+ resolution tests are disabled, but timeout.t should not fail because of
+ this... it will just run fewer tests.
+
+ =head2 Changes in Sys::SigAction 0.19 27 Jul 2013
+
+ Change sig_alarm() to use HiRes::ualarm() instead of
+ HiRes::alarm(). Hoping to fix hires test failures
+ on some platforms.
+
+ Build a hash structure in timeout.t to disable
+ the HiRes tests on certain platforms where these functions may
+ to be consistently broken, but disable them for at least
+ another round, hoping that the change to using HiRes::ualarm()
+ solves the problem.
+
+ Also, restructure timeout.t to hardcode the number of tests
+ run. Apparently Test::More on perl 5.8.x insisteds on getting
+ the plan before ANY tests are run.
+
+-------------------------------------------------------------------
Old:
----
Sys-SigAction-0.18.tar.gz
New:
----
Sys-SigAction-0.20.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Sys-SigAction.spec ++++++
--- /var/tmp/diff_new_pack.gbNLPY/_old 2013-08-13 10:19:13.000000000 +0200
+++ /var/tmp/diff_new_pack.gbNLPY/_new 2013-08-13 10:19:13.000000000 +0200
@@ -17,7 +17,7 @@
Name: perl-Sys-SigAction
-Version: 0.18
+Version: 0.20
Release: 0
%define cpan_name Sys-SigAction
Summary: Perl extension for Consistent Signal Handling
++++++ Sys-SigAction-0.18.tar.gz -> Sys-SigAction-0.20.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Sys-SigAction-0.18/Changes
new/Sys-SigAction-0.20/Changes
--- old/Sys-SigAction-0.18/Changes 2013-07-25 00:38:14.000000000 +0200
+++ new/Sys-SigAction-0.20/Changes 2013-08-05 02:32:59.000000000 +0200
@@ -8,6 +8,59 @@
Revision history for Sys::SigAction.
+=head2 Changes in Sys::SigAction 0.20 4 Aug 2013
+
+Even if C<Time::HiRes::ualarm()> exists, it may not necessarily
+work. (There were way too many broken smoke tests with were
+the result of this. One reason for this may bave been that the test
+was looking for too small an interval of sub-second timeouts. On busy
+systems, this may have been causing tests to fail.
+
+Got rid of the attempt at tracking broken environments in timeout.t
+(the hash structure mentioned in the previous change.
+
+The sub-second timer tests now set a timeout at 0.1 seconds, and check
+for a delta time the is less then 0.8 seconds. Proving that they completed
+in under 1 second, but give a wide range of execution time to account
+for busy systems.
+
+Also Makefile.PL now looks for C<Time::HiRes::ualarm()>, and tests it.
+If it works, high resolution timeouts are enabled in Sys
+Makefile.PL reports what it finds, and t/timeout.t reports when high
+resolution tests are disabled, but timeout.t should not fail because of
+this... it will just run fewer tests.
+
+=head2 Changes in Sys::SigAction 0.19 27 Jul 2013
+
+Change sig_alarm() to use HiRes::ualarm() instead of
+HiRes::alarm(). Hoping to fix hires test failures
+on some platforms.
+
+Build a hash structure in timeout.t to disable
+the HiRes tests on certain platforms where these functions may
+to be consistently broken, but disable them for at least
+another round, hoping that the change to using HiRes::ualarm()
+solves the problem.
+
+Also, restructure timeout.t to hardcode the number of tests
+run. Apparently Test::More on perl 5.8.x insisteds on getting
+the plan before ANY tests are run.
+
+Build similar structure in mask.t to disable
+the test on certain platforms were signal masking appears
+to be broken. Currently this is set to
+
+ my $mask_broken_platforms = {
+ 'archname' => { 'i686-cygwin-thread-multi-64int' => 1
+ }
+ ,'perlver' => { 'v5.10.1' => 1
+ }
+ };
+
+
+Update Makefile.PL to note the fact the HiRes timeouts may
+broken on some platforms.
+
=head2 Changes in Sys::SigAction 0.18 24 Jul 2013
Fix "bareword" error on some platforms at least, by explicitly importing
@@ -28,7 +81,7 @@
caught in the POD. (bug #79130).
When Time::HiRes is present, allow for long timeouts longer than the
-POSIX::MAX_INT microseconds when Time::HiRes is present. Just call
+POSIX::INT_MAX microseconds when Time::HiRes is present. Just call
call alarm() instead of ualarm() in the case where input argument
would result in a msecs value in an argument to ualarm which is
larger than POSIX::INT_MAX (and, of course, add a test for this in
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Sys-SigAction-0.18/MANIFEST
new/Sys-SigAction-0.20/MANIFEST
--- old/Sys-SigAction-0.18/MANIFEST 2006-10-09 16:19:50.000000000 +0200
+++ new/Sys-SigAction-0.20/MANIFEST 2013-08-04 23:39:37.000000000 +0200
@@ -1,5 +1,4 @@
Changes
-lib/Sys/SigAction.pm
Makefile.PL
META.yml Module meta-data (added by MakeMaker)
README
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Sys-SigAction-0.18/META.yml
new/Sys-SigAction-0.20/META.yml
--- old/Sys-SigAction-0.18/META.yml 2013-07-25 01:06:02.000000000 +0200
+++ new/Sys-SigAction-0.20/META.yml 2013-08-05 02:35:55.000000000 +0200
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Sys-SigAction
-version: 0.18
+version: 0.20
abstract: Perl extension for Consistent Signal Handling
author:
- Lincoln A. Baxter <lab-at-lincolnbaxter-dot-com>
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Sys-SigAction-0.18/Makefile.PL
new/Sys-SigAction-0.20/Makefile.PL
--- old/Sys-SigAction-0.18/Makefile.PL 2011-06-22 13:56:21.000000000 +0200
+++ new/Sys-SigAction-0.20/Makefile.PL 2013-08-05 02:33:05.000000000 +0200
@@ -31,20 +31,10 @@
if ( ! $@ || $Config{usethreads} || $Config{useithreads} ||
$Config{use5005threads} ) {
warn q{
- Using Signals in a multi-thread perl application is unsupported
- by Sys::SigAction.
-
- Read the following from perldoc perlthrtut:
-
- ...mixing signals and threads may be problematic.
- Implementations are platform-dependent, and even the POSIX semantics
- may not be what you expect (and Perl doesn't even give you the full
- POSIX API). For example, there is no way to guarantee that a signal
- sent to a multi-threaded Perl application will get intercepted by
- any particular thread.
-
-
- You are on your own if we use this module in a multi threaded application
+ This perl has multithread support enabled, this is not a problem for
+ single threaded perl applications.
+
+ Please see "MULTITHREAD PERL in the Sys::SigAction POD for more information
Lincoln
@@ -67,8 +57,6 @@
This perl is not supported.
Perl must be built with 'useposix' and 'sigaction' defined.
- Lincoln
-
};
}
@@ -89,18 +77,107 @@
};
}
-print "Checking for Time::HiRes (support for fractional seconds in
timeouts)\n";
-eval "use Time::HiRes qw( ualarm )";
-if ( $@ ) {
+print "Checking for cygwin... (masking signals is broken on some versions at
least)\n";
+if ( $^O =~ /cygwin/ ) {
warn q(
-
- Time::HiRes is not available. Fractional seconds in timeout_call()
- will be raised to the next high integer value with POSIX::ceil().
-
+ Smoke testers have discovered that t/mask.t fails on at least
+ some verions cygwin. Specific versions of the os and perl
+ and now protected... but others may be found. On this platforms
+ masking signals probably does not work. See the hash reference
+ \$broken_platforms for platforms known to be broken.
+
);
}
+my $SAAD = "lib/Sys/SigAction/" ;
+my $SAA = "$SAAD/Alarm.pm" ;
+print "Writing $SAA\n" ;
+mkdir $SAAD if ( not -d $SAAD );
+
+open( SAH, ">$SAA" );
+print SAH q(
+package Sys::SigAction::Alarm;
+require 5.005;
+use strict;
+#use warnings;
+use vars qw( @ISA @EXPORT_OK );
+require Exporter;
+@ISA = qw( Exporter );
+@EXPORT_OK = qw( ssa_alarm );
+my $have_hires = scalar eval 'use Time::HiRes; Time::HiRes::ualarm(0); 1;';
+use POSIX qw( INT_MAX ceil ) ;
+my $hrworks;
+sub ssa_alarm($)
+{
+ my $secs = shift;
+ #print print "secs=$secs\n";
+
+ if ( $hrworks and ($secs le (INT_MAX()/1_000_000.0) ) )
+ {
+ Time::HiRes::ualarm( $secs * 1_000_000 );
+ }
+ else
+ {
+ alarm( ceil( $secs ) );
+ }
+}
+
+sub hires_works { return $hrworks; }; #test support
+
+);
+print "Looking for Time::HiRes with a working ualarm()... \n" ;
+use constant HR => eval 'use Time::HiRes; Time::HiRes::ualarm(0); 1;' ;
+sub forever { pause(); }
+sub handler { die "TIMEDOUT"; }
+my $et, $st;
+my $hr_works = 0;
+if ( not HR )
+{
+ print q(
+ Time::HiRes is not installed.
+ High resolution timeouts disabled.
+);
+}
+else {
+ print "Testing Time::HiRes::ualarm()\n" ;
+ $SIG{'ALRM'} = \&handler;
+ eval {
+ $st = Time::HiRes::time();
+ eval {
+ Time::HiRes::ualarm( 0.1 * 1_000_000 );
+ forever();
+ };
+ Time::HiRes::ualarm( 0 );
+ $et = Time::HiRes::time();
+ #print "outside forever eval\n" ;
+ };
+ my $delta = $et - $st;
+ if ( $delta < 0.8 ) {
+ print q(
+ Time::HiRes::ualarm() exists and works.
+ High resolution timeouts enabled."
+);
+ $hr_works = 1;
+ }
+ else
+ {
+ warn q(
+ Time::HiRes exists on this platform but Time::HiRes::ualarm
+ appears to be broken. High resolution timeouts disabled.
+);
+ }
+}
+print SAH '$hrworks = '."$hr_works; 1;\n" ;
+close( SAH );
+print "\nWrote $SAA\n" ;
+
+if ( not $hr_works ) {
+ warn q(
+ Fractional seconds in timeout_call() may be used but will be
+ raised to the next higher integer value with POSIX::ceil().
+);
+}
#ok... enough defensiveness...
my $args = {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Sys-SigAction-0.18/lib/Sys/SigAction.pm
new/Sys-SigAction-0.20/lib/Sys/SigAction.pm
--- old/Sys-SigAction-0.18/lib/Sys/SigAction.pm 2013-07-25 01:02:39.000000000
+0200
+++ new/Sys-SigAction-0.20/lib/Sys/SigAction.pm 2013-08-04 23:29:04.000000000
+0200
@@ -1,5 +1,5 @@
#
-# Copyright (c) 2004-2009 Lincoln A. Baxter
+# Copyright (c) 2004-2013 Lincoln A. Baxter
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file,
@@ -17,29 +17,19 @@
#or core alarm with the ceil of the value passed otherwise.
#timeout_call uses sig_alarm()
-use constant HAVE_HIRES => scalar eval 'use Time::HiRes ();
Time::HiRes::alarm(0); 1;';
-
-sub have_hires() { HAVE_HIRES }; #test support
-
-sub sig_alarm #replacement for alarm, takes factional seconds in floating
point format
+#replacement for alarm, factional second arg in floating point format:
+use Sys::SigAction::Alarm qw( ssa_alarm );
+sub sig_alarm
{
my $secs = shift;
- #print print "secs=$secs\n";
-
- if ( HAVE_HIRES && $secs*1_000_000 <= INT_MAX ) {
- Time::HiRes::alarm( $secs );
- }
- else
- {
- alarm( ceil( $secs ) );
- }
+ ssa_alarm( $secs );
}
#use Data::Dumper;
@ISA = qw( Exporter );
@EXPORT_OK = qw( set_sig_handler timeout_call sig_name sig_number sig_alarm );
-$VERSION = '0.18';
+$VERSION = '0.20';
use Config;
my %signame = ();
@@ -281,7 +271,10 @@
code reference and optional arguments, and executes the code reference
wrapped with an alarm timeout. timeout_call accepts seconds in floating
point format, so you can time out call with a resolution of 0.000001
-seconds (assumes Time::HiRes is loadable).
+seconds. If C<Time::HiRes> is not loadable or C<Time::HiRes::ualarm()> does
+not work, then the factional part of the time value passed to C<timeout_call()>
+will be raise to the next higher integer with POSIX::ceil(). This means
+that the shortest a timeout can be in 1 second.
Finally, two convenience routines are defined which allow one to get the
@@ -523,13 +516,35 @@
sig_number( 'INT' ) returns the integer value of SIGINT;
+=head1 MULTITHREADED PERL
+
+
+Sys::SigAction works just fine on perls built with multithread support in
+single threaded perl applications. However, please note that
+using Signals in a multi-thread perl application is unsupported.
+
+Read the following from perldoc perlthrtut:
+
+ ... mixing signals and threads may be problematic.
+ Implementations are platform-dependent, and even the POSIX semantics
+ may not be what you expect (and Perl doesn't even give you the full
+ POSIX API). For example, there is no way to guarantee that a signal
+ sent to a multi-threaded Perl application will get intercepted by
+ any particular thread.
+
+That said, perl documentation for perl threading discusses a a way of
+emulating signals in multi-threaded applications, when safe signals
+is in effect. See perldoc threads and search for THREAD SIGNALLING.
+I have no test of multithreading and this module. If you thing they
+could used compatibly, and would provide value, patches are welcome.
+
=head1 AUTHOR
Lincoln A. Baxter <lab-at-lincolnbaxter-dot-com>
=head1 COPYRIGHT
- Copyright (c) 2004-2009 Lincoln A. Baxter
+ Copyright (c) 2004-2013 Lincoln A. Baxter
All rights reserved.
You may distribute under the terms of either the GNU General Public
@@ -541,7 +556,11 @@
perldoc perlvar
perldoc POSIX
-The dbd-oracle-timeout.pod file included with this module. This includes a
DBD-Oracle
-test script, which illustrates the use of this module with the DBI with the
DBD-Oracle
-driver.
+=head NOTE
+
+Recent versions of DBD::Oracle no longer reference this module in the
+POD, so DBD::Oracle may now have solved the connection timeout problem
+internally. For older versions, the dbd-oracle-timeout.pod file provides
+a DBD-Oracle test script, which illustrates the use of this
+module with the DBD-Oracle driver.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Sys-SigAction-0.18/t/mask.t
new/Sys-SigAction-0.20/t/mask.t
--- old/Sys-SigAction-0.18/t/mask.t 2008-10-16 12:09:19.000000000 +0200
+++ new/Sys-SigAction-0.20/t/mask.t 2013-07-27 22:12:09.000000000 +0200
@@ -19,13 +19,27 @@
use strict;
#use warnings;
-
-
+use Config;
use Carp qw( carp cluck croak confess );
use Data::Dumper;
use POSIX ':signal_h' ;
use Sys::SigAction qw( set_sig_handler sig_name sig_number );
+### identify platforms I don't think can be supported per the smoke testers
+my $mask_broken_platforms = {
+ 'archname' => { 'i686-cygwin-thread-multi-64int' => 1
+ }
+ ,'perlver' => { 'v5.10.1' => 1
+ }
+};
+
+
+my $on_broken_platform = (
+ exists ( $mask_broken_platforms->{'archname'}->{$Config{'archname'}} )
+ && exists ( $mask_broken_platforms->{'perlver'}->{$^V} )
+ );
+
+
my $hup = 0;
my $int = 0;
my $usr = 0;
@@ -91,6 +105,8 @@
#then we do the same thing for new sig handers on INT and USR1
#
SKIP: {
+ plan skip_all => "perl $^V on $Config{'archname'} does not appear to mask
signals correctly." if ( $on_broken_platform );
+ #plan skip_all => "masking signals is broken on at least some versions of
cygwin" if ( $^O =~ /cygwin/ );
plan skip_all => "requires perl 5.8.0 or later" if ( $] < 5.008 );
plan tests => $tests;
@@ -100,6 +116,7 @@
# Not testing safe=>1 for now\n";
+
set_sig_handler( 'HUP' ,\&sigHUP ,{ mask=>[ qw( INT USR1 ) ] } );
#,safe=>0 } );
#set_sig_handler( 'HUP' ,\&sigHUP ,{ mask=>[ qw( INT USR1 ) ]
,safe=>undef } );
set_sig_handler( 'INT' ,\&sigINT_1 ,{ mask=>[ qw( USR1 )] } ); #,safe=>0 }
);
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Sys-SigAction-0.18/t/safe.t
new/Sys-SigAction-0.20/t/safe.t
--- old/Sys-SigAction-0.18/t/safe.t 2008-10-16 13:39:23.000000000 +0200
+++ new/Sys-SigAction-0.20/t/safe.t 2013-07-27 22:07:52.000000000 +0200
@@ -101,8 +101,8 @@
print STDERR "
NOTE: Setting safe=>1... with masked signals does not seem to work.
- The problem is that the masked signals are not masked, but when
- safe=>0 they are.
+ The problem is that the masked signals are not masked when safe=>1.
+ When safe=>0 they are.
If you have an application for safe=>1 and can come up with
a test that works in the context of this module's installation
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Sys-SigAction-0.18/t/timeout.t
new/Sys-SigAction-0.20/t/timeout.t
--- old/Sys-SigAction-0.18/t/timeout.t 2013-07-25 00:48:14.000000000 +0200
+++ new/Sys-SigAction-0.20/t/timeout.t 2013-08-05 02:33:26.000000000 +0200
@@ -8,13 +8,14 @@
use Test::More;
my $do_subsec = 0;
-BEGIN {
- use_ok('Sys::SigAction');
- if ( Sys::SigAction::have_hires() )
- {
- eval "use Time::HiRes qw( time );";
- }
-}
+
+#BEGIN {
+# use_ok('Sys::SigAction');
+# if ( Sys::SigAction::have_hires() )
+# {
+# eval "use Time::HiRes qw( time );";
+# }
+#}
#########################
# Insert your test code below, the Test::More module is use()ed here so read
@@ -25,8 +26,38 @@
use Carp qw( carp cluck croak confess );
use Data::Dumper;
+use Sys::SigAction::Alarm;
use Sys::SigAction qw( set_sig_handler timeout_call );
use POSIX qw( INT_MAX pause :signal_h );
+use Config;
+
+### identify platforms I don't think can be supported per the smoke testers
+#my $broken_hires_platforms = {
+# 'archname' => {
+##poss 'amd64-midnightbsd-thread-multi' => 1
+##testing ,'i486-linux-gnu-thread-multi-64int' => 1
+# }
+# ,'perlver' => {
+##poss 'v5.16.2' => 1
+##testing ,'v5.14.2' => 1
+# }
+#};
+#
+#
+#my $broken_hires = (
+# exists ( $broken_hires_platforms->{archname}->{$Config{archname}} )
+# && exists ( $broken_hires_platforms->{perlver}->{$^V} )
+# );
+
+#$broken_hires = 1; #force broken path
+
+if ( Sys::SigAction::Alarm::hires_works() ) {
+ $do_subsec = 1;
+ eval "use Time::HiRes;";
+ plan tests => 19;
+} else {
+ plan tests => 14;
+}
my $num_args_seen;
my $sum_args_seen;
@@ -42,19 +73,18 @@
}
my $ret = 0;
-my $num_tests = 1; #start at 1 because of use_ok above
eval {
$ret = timeout_call( 1, \&hash );
};
-ok( (ref( $@ ) and exists($@->{'hash'})) ,'die with hash' ); $num_tests++;
-ok( $ret == 0 ,'hash did not timeout' ); $num_tests++;
+ok( (ref( $@ ) and exists($@->{'hash'})) ,'die with hash' );
+ok( $ret == 0 ,'hash did not timeout' );
$ret = 0;
eval {
$ret = timeout_call( 1, \&immediate );
};
-ok( (not ref($@) and $@ ),'immediate -- die with string' ); $num_tests++;
-ok( $ret == 0 ,'immediate did not timeout' ); $num_tests++;
+ok( (not ref($@) and $@ ),'immediate -- die with string' );
+ok( $ret == 0 ,'immediate did not timeout' );
$ret = 0;
eval {
@@ -65,8 +95,8 @@
{
print "why did forever throw exception:" .Dumper( $@ );
}
-ok( (not $@ ) ,'forever did NOT die' ); $num_tests++;
-ok( $ret ,'forever timed out' ); $num_tests++;
+ok( (not $@ ) ,'forever did NOT die' );
+ok( $ret ,'forever timed out' );
foreach my $args ([1], [2, 3]) {
$ret = 0;
@@ -78,46 +108,49 @@
$ret = Sys::SigAction::timeout_call( 1, \&forever_w_args, @$args );
};
local $" = ', ';
- ok( (not $@ ) ,"forever_w_args(@$args) did NOT die" ); $num_tests++;
- ok( $ret ,"forever_w_args(@$args) timed out" ); $num_tests++;
- ok( $num_args_seen == $num_args_ok,"forever_w_args(@$args) got
$num_args_seen args" ); $num_tests++;
- ok( $sum_args_seen == $sum_args_ok,"forever_w_args(@$args) args sum is
$sum_args_seen" ); $num_tests++;
+ ok( (not $@ ) ,"forever_w_args(@$args) did NOT die" );
+ ok( $ret ,"forever_w_args(@$args) timed out" );
+ ok( $num_args_seen == $num_args_ok,"forever_w_args(@$args) got
$num_args_seen args" );
+ ok( $sum_args_seen == $sum_args_ok,"forever_w_args(@$args) args sum is
$sum_args_seen" );
}
-if ( Sys::SigAction::have_hires() )
+if ( not Sys::SigAction::Alarm::hires_works() )
+{
+ diag "\nTime::HiRes is not installed or Time::HiRes::ualarm() is
broken\nFractional second timeout tests skipped\n" ;
+}
+else
{
- diag( "fractional second timeout tests" );
+ #diag( "\nFractional second tests:\n" );
+
+ #5 more tests...
$ret = 0;
my $btime;
my $etime;
eval {
- $btime = time();
+ $btime = Time::HiRes::time();
$ret = Sys::SigAction::timeout_call( 0.1, \&forever );
};
if ( $@ )
{
print "hires: why did forever throw exception:" .Dumper( $@ );
}
- $etime = time();
+ $etime = Time::HiRes::time();
- ok( (not $@ ) ,'hires: forever did NOT die' ); $num_tests++;
- ok( $ret ,'hires: forever timed out' ); $num_tests++;
- ok( (($etime - $btime) < 0.2 ), "hires: timeout in < 0.2 seconds" );
$num_tests++;
-
- #diag( "testing HiRes where msecs would be greater than maxint ("
.POSIX::INT_MAX.")" );
- my $toobig = INT_MAX/1_000_000.0 + 1.1;
+ ok( (not $@ ) ,'hires: forever did NOT die' );
+ ok( $ret ,'hires: forever timed out' );
+ my $delta = $etime - $btime;
+ diag( "delta time was ".sprintf( "%.6f" ,$delta ).", timer was for 0.1
secconds" );
+ ok( ($delta < 0.8 ), "timeout in < 0.8 seconds" );
+
+ #diag( "Testing HiRes where msecs is greater than maxint ("
.POSIX::INT_MAX().")" );
+ my $toobig = INT_MAX();
+ $toobig = ($toobig/1_000_000.0) + 1.1;
$ret = 0;
eval {
$ret = timeout_call( $toobig, \&sleep_one );
};
- ok( (not ref($@) and $@ ),"immediate -- die with string (toobig=$toobig)"
); $num_tests++;
- ok( $ret == 0 ,"immediate did not timeout (with toobig=$toobig)" );
$num_tests++;
-
-}
-else
-{
- diag "fractional second timeout test skipped: Time::HiRes is not installed"
;
+ ok( (not ref($@) and $@ ),"immediate -- die with string (toobig=$toobig)"
);
+ ok( $ret == 0 ,"immediate did not timeout (with toobig=$toobig)" );
}
-plan tests => $num_tests;
exit;
--
To unsubscribe, e-mail: [email protected]
For additional commands, e-mail: [email protected]
