Hi, there!
I tried to use Your module, but I was met by the problem:
If the function which was given to alarm_call as second parameter uses
eval-die blocks and is broken when it does eval block, then alarm_call
works incorrectly. Test in atatche showes this problem.
You can see the problem if You try print stack in function which uses as
$SIG{ALRM} handler. stack will point to broken place. If this place is
eval, die from this function will be catched by its eval.
I began to try the problem (limit any function by time) and found the
solve: we must use "bad" goto statement.
Structure of alarm_call must be such this function:
sub dtimeout
{
my ($timeout, $code, @args) = @_;
my $prev_alarm = alarm 0;
my $start_time = time;
my $wantarray = wantarray;
# флаг о том что кончилось время на работу
my $alarmed;
my @res;
eval {
local $SIG{ALRM} = sub {
$alarmed = 1;
goto FOO_DONE;
};
alarm $timeout;
if ($wantarray) {
@res = eval { $code->(@args) };
} elsif (defined $wantarray) {
$res[0] = eval { $code->(@args) };
} else {
eval { $code->(@args) };
}
alarm 0;
die if $@;
};
FOO_DONE:
my $e = $@;
$e = 'Timeout::alarm' if $alarmed;
my $passed_time = time - $start_time;
if ($prev_alarm) {
if ($passed_time >= $prev_alarm) {
kill ALRM => $$;
} else {
alarm $prev_alarm - $passed_time;
}
}
die $e if $e;
return unless defined $wantarray;
return @res if $wantarray;
return $res[0];
}
"bad" goto cleans stack and we can really break the function.
above function was got from my code :)
| Subject: | test.pl |
#!/usr/bin/perl
use warnings;
use strict;
use utf8;
use open qw(:std :utf8);
use Test::More tests => 2;
use 5.10.0;
BEGIN {
use_ok 'Time::HiRes';
use_ok "Sys::AlarmCall";
}
sub test_timeout_eval
{
my @res1 = alarm_call(1, sub { sleep 1.5; sleep 1.5; @_ }, 1, 2, 3);
unless ($res1[0] ~~ 'TIMEOUT') {
diag "alarm_call didn't break test function";
return 0;
}
my $time = Time::HiRes::gettimeofday;
my @res2 =
alarm_call(1, sub { eval { sleep 1.5; }; sleep 1.5; @_ }, 1, 2, 3);
$time = Time::HiRes::gettimeofday - $time;
unless($res2[0] ~~ 'TIMEOUT') {
diag "alarm_call didn't break function with eval, and returned:\n\t" .
join("\n\t", @res2) .
"\nfunction worked: $time seconds\n";
return 0;
}
return 1;
}
ok(test_timeout_eval, "Testing breaking function which uses eval");