I recently fixed an extremely odd bug in one of my perl
scripts. Here's the general context. I loop through a
number of files (lets say 10 of them) in serial. For each
file, I spawn off a system process that runs on a simulation
on that file. The behaviour of the simulator makes it so
that sometimes the simulator will deadlock and the simulator's
parent needs to kill the process. So I used
$SIG{ALRM}
to trap this. If I haven't received output after 5 seconds,
I kill the process (actually the entire group of processes it
might have spawned), close the filehandle, and process the next
file in the list.
Here's the odd part. If I ever manually kill the file through the
sig alarm handler, then the next time I execute the open pipe,
perl seg-faults. The only way (that I've found) to fix this
problem is to read either
$! or
$?
after the
close(). When the script reads one of
these variables, the script no longer seg-faults.
Here is the output of
perl -v:
This is perl, version 5.005_03 built for i386-linux
Copyright 1987-1999, Larry Wall
Perl may be copied only under the terms of either the Artistic License
+ or the
GNU General Public License, which may be found in the Perl 5.0 source
+kit.
Complete documentation for Perl, including FAQ lists, should be found
+on
this system using `man perl' or `perldoc perl'. If you have access to
+ the
Internet, point your browser at http://www.perl.com/, the Perl Home Pa
+ge.
And here is the subroutine that's causing these problems:
sub anysim_tests {
my ($flag, $class, $tests) = @_;
my $program = $flag . "sim";
my $progname = uc($flag) . "sim";
return 1 unless flag_present($tests, $flag);
print "\n\n*** ", uc($program), " TESTING ***\n\n";
# Autoflush sim output
local $| = 1;
foreach my $file (sort keys %$tests) {
# Check if this file didn't need xsim testing
next if index($tests->{$file}[0], $flag) < 0;
# Compute actual file names
my $output = $file;
$output =~ s/vo$/${program}.mem/g or next; # Should never fail
delete_mem($output) or next; # Delete old memory image
use vars qw($abort $pid $sim);
local $sim = new FileHandle;
local $pid =
open($sim, "exec /usr/local/java/bin/java $class $file 2>&1
+|");
unless (defined($pid)) {
print "Warning: Could not run 'java $class $file': $!\n\n"
+;
next;
}
print "\n$progname testing $file\n";
local $abort = 0;
local $SIG{ALRM} =
sub {
alarm(0);
print "\nWarning: $progname deadlocked on $file\n";
kill "TERM", $pid;
# This close will probably fail
close($sim);
# We need to read $! or $?, or else the next open pipe
+will
# seg fault perl
my $garbage = $!;
$abort = -1;
};
my $found_data = 0;
do {
alarm(5);
$_ = <$sim>;
if (defined $_) {
++$found_data;
print "#" if ($found_data % 500) == 0;
} else {
$abort = 1 unless $abort;
}
} while (!$abort);
print $/;
alarm(0);
if ($abort > 0 && !close($sim)) {
print "Warning: $progname could not successfully run $file
+\n";
next;
} else {
my $source = $progname . ".vout";
system "mv $source $output" if is_readable($source);
}
}
}
-Ted