Improve handling of Perl's block eval errors
Taken from `Perl::Critic`:
A common idiom in perl for dealing with possible errors is to use `eval`
followed by a check of `$@`/`$EVAL_ERROR`:
eval {
...
};
if ($EVAL_ERROR) {
...
}
There's a problem with this: the value of `$EVAL_ERROR` (`$@`) can change
between the end of the `eval` and the `if` statement. The issue are object
destructors:
package Foo;
...
sub DESTROY {
...
eval { ... };
...
}
package main;
eval {
my $foo = Foo->new();
...
};
if ($EVAL_ERROR) {
...
}
Assuming there are no other references to `$foo` created, when the
`eval` block in `main` is exited, `Foo::DESTROY()` will be invoked,
regardless of whether the `eval` finished normally or not. If the `eval`
in `main` fails, but the `eval` in `Foo::DESTROY()` succeeds, then
`$EVAL_ERROR` will be empty by the time that the `if` is executed.
Additional issues arise if you depend upon the exact contents of
`$EVAL_ERROR` and both `eval`s fail, because the messages from both will
be concatenated.
Even if there isn't an `eval` directly in the `DESTROY()` method code,
it may invoke code that does use `eval` or otherwise affects
`$EVAL_ERROR`.
The solution is to ensure that, upon normal exit, an `eval` returns a
true value and to test that value:
# Constructors are no problem.
my $object = eval { Class->new() };
# To cover the possiblity that an operation may correctly return a
# false value, end the block with "1":
if ( eval { something(); 1 } ) {
...
}
eval {
...
1;
}
or do {
# Error handling here
};
Unfortunately, you can't use the `defined` function to test the result;
`eval` returns an empty string on failure.
Various modules have been written to take some of the pain out of
properly localizing and checking `$@`/`$EVAL_ERROR`. For example:
use Try::Tiny;
try {
...
} catch {
# Error handling here;
# The exception is in $_/$ARG, not $@/$EVAL_ERROR.
}; # Note semicolon.
"But we don't use DESTROY() anywhere in our code!" you say. That may be
the case, but do any of the third-party modules you use have them? What
about any you may use in the future or updated versions of the ones you
already use?
This commit is contained in:
@@ -74,11 +74,11 @@ sub handleDeclarativeJobsetBuild {
|
|||||||
my $declPath = ($build->buildoutputs)[0]->path;
|
my $declPath = ($build->buildoutputs)[0]->path;
|
||||||
my $declText = eval {
|
my $declText = eval {
|
||||||
readNixFile($declPath)
|
readNixFile($declPath)
|
||||||
};
|
} or do {
|
||||||
if ($@) {
|
# If readNixFile errors or returns an undef or an empty string
|
||||||
print STDERR "ERROR: failed to readNixFile $declPath: ", $@, "\n";
|
print STDERR "ERROR: failed to readNixFile $declPath: ", $@, "\n";
|
||||||
die;
|
die;
|
||||||
}
|
};
|
||||||
|
|
||||||
my $declSpec = decode_json($declText);
|
my $declSpec = decode_json($declText);
|
||||||
$db->txn_do(sub {
|
$db->txn_do(sub {
|
||||||
@@ -88,16 +88,17 @@ sub handleDeclarativeJobsetBuild {
|
|||||||
while ((my $jobsetName, my $spec) = each %$declSpec) {
|
while ((my $jobsetName, my $spec) = each %$declSpec) {
|
||||||
eval {
|
eval {
|
||||||
updateDeclarativeJobset($db, $project, $jobsetName, $spec);
|
updateDeclarativeJobset($db, $project, $jobsetName, $spec);
|
||||||
};
|
1;
|
||||||
if ($@) {
|
} or do {
|
||||||
print STDERR "ERROR: failed to process declarative jobset ", $project->name, ":${jobsetName}, ", $@, "\n";
|
print STDERR "ERROR: failed to process declarative jobset ", $project->name, ":${jobsetName}, ", $@, "\n";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
});
|
});
|
||||||
};
|
1;
|
||||||
|
} or do {
|
||||||
|
# note the error in the database in the case eval fails for whatever reason
|
||||||
$project->jobsets->find({ name => ".jobsets" })->update({ errormsg => $@, errortime => time, fetcherrormsg => undef })
|
$project->jobsets->find({ name => ".jobsets" })->update({ errormsg => $@, errortime => time, fetcherrormsg => undef })
|
||||||
if defined $@;
|
};
|
||||||
|
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -356,15 +356,14 @@ sub captureStdoutStderr {
|
|||||||
alarm $timeout;
|
alarm $timeout;
|
||||||
IPC::Run::run(\@cmd, \$stdin, \$stdout, \$stderr);
|
IPC::Run::run(\@cmd, \$stdin, \$stdout, \$stderr);
|
||||||
alarm 0;
|
alarm 0;
|
||||||
};
|
1;
|
||||||
|
} or do {
|
||||||
if ($@) {
|
|
||||||
die unless $@ eq "timeout\n"; # propagate unexpected errors
|
die unless $@ eq "timeout\n"; # propagate unexpected errors
|
||||||
return (-1, $stdout, ($stderr // "") . "timeout\n");
|
return (-1, $stdout, ($stderr // "") . "timeout\n");
|
||||||
} else {
|
};
|
||||||
|
|
||||||
return ($?, $stdout, $stderr);
|
return ($?, $stdout, $stderr);
|
||||||
}
|
}
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub run {
|
sub run {
|
||||||
@@ -391,16 +390,15 @@ sub run {
|
|||||||
}
|
}
|
||||||
});
|
});
|
||||||
alarm 0;
|
alarm 0;
|
||||||
};
|
$res->{status} = $?;
|
||||||
|
chomp $res->{stdout} if $args{chomp} // 0;
|
||||||
|
|
||||||
if ($@) {
|
1;
|
||||||
|
} or do {
|
||||||
die unless $@ eq "timeout\n"; # propagate unexpected errors
|
die unless $@ eq "timeout\n"; # propagate unexpected errors
|
||||||
$res->{status} = -1;
|
$res->{status} = -1;
|
||||||
$res->{stderr} = "timeout\n";
|
$res->{stderr} = "timeout\n";
|
||||||
} else {
|
};
|
||||||
$res->{status} = $?;
|
|
||||||
chomp $res->{stdout} if $args{chomp} // 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
return $res;
|
return $res;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -29,9 +29,11 @@ sub buildStarted {
|
|||||||
or die "build $buildId does not exist\n";
|
or die "build $buildId does not exist\n";
|
||||||
|
|
||||||
foreach my $plugin (@plugins) {
|
foreach my $plugin (@plugins) {
|
||||||
eval { $plugin->buildStarted($build); };
|
eval {
|
||||||
if ($@) {
|
$plugin->buildStarted($build);
|
||||||
print STDERR "$plugin->buildStarted: $@\n";
|
1;
|
||||||
|
} or do {
|
||||||
|
print STDERR "error with $plugin->buildStarted: $@\n";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -53,9 +55,11 @@ sub buildFinished {
|
|||||||
}
|
}
|
||||||
|
|
||||||
foreach my $plugin (@plugins) {
|
foreach my $plugin (@plugins) {
|
||||||
eval { $plugin->buildFinished($build, [@dependents]); };
|
eval {
|
||||||
if ($@) {
|
$plugin->buildFinished($build, [@dependents]);
|
||||||
print STDERR "$plugin->buildFinished: $@\n";
|
1;
|
||||||
|
} or do {
|
||||||
|
print STDERR "error with $plugin->buildFinished: $@\n";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -74,9 +78,11 @@ sub stepFinished {
|
|||||||
$logPath = undef if $logPath eq "-";
|
$logPath = undef if $logPath eq "-";
|
||||||
|
|
||||||
foreach my $plugin (@plugins) {
|
foreach my $plugin (@plugins) {
|
||||||
eval { $plugin->stepFinished($step, $logPath); };
|
eval {
|
||||||
if ($@) {
|
$plugin->stepFinished($step, $logPath);
|
||||||
print STDERR "$plugin->stepFinished: $@\n";
|
1;
|
||||||
|
} or do {
|
||||||
|
print STDERR "error with $plugin->stepFinished: $@\n";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -115,8 +121,8 @@ while (1) {
|
|||||||
} elsif ($channelName eq "step_finished") {
|
} elsif ($channelName eq "step_finished") {
|
||||||
stepFinished(int($payload[0]), int($payload[1]));
|
stepFinished(int($payload[0]), int($payload[1]));
|
||||||
}
|
}
|
||||||
};
|
1;
|
||||||
if ($@) {
|
} or do {
|
||||||
print STDERR "error processing message '$payload' on channel '$channelName': $@\n";
|
print STDERR "error processing message '$payload' on channel '$channelName': $@\n";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -60,8 +60,10 @@ sub sendQueueRunnerStats {
|
|||||||
}
|
}
|
||||||
|
|
||||||
while (1) {
|
while (1) {
|
||||||
eval { sendQueueRunnerStats(); };
|
eval {
|
||||||
if ($@) { warn "$@"; }
|
sendQueueRunnerStats();
|
||||||
|
1;
|
||||||
|
} or do { warn "$@"; }
|
||||||
|
|
||||||
my $meminfo = read_file("/proc/meminfo", err_mode => 'quiet') // "";
|
my $meminfo = read_file("/proc/meminfo", err_mode => 'quiet') // "";
|
||||||
$meminfo =~ m/Dirty:\s*(\d+) kB/;
|
$meminfo =~ m/Dirty:\s*(\d+) kB/;
|
||||||
|
|||||||
Reference in New Issue
Block a user