| Subject: | Thread safety bug |
The attached test case crashes perl. Crashes are much more frequent on multiprocessor boxes. A stack trace from a debugging malloc shows an invalid pointer being indirectly freed by free_pstate().
Running the test case with the -c switch appears not to crash perl, so it appears to have something to do with the code reference.
# test program to show core dump when try/catch is used with "our" vars
use strict;
use warnings;
use threads;
use threads::shared;
use Error qw(:try);
use Getopt::Long;
use Time::HiRes qw(gettimeofday tv_interval);
use HTML::Parser;
my $crash = 1;
my $loops = 30000;
my $start;
my $threads = 10;
my $lock:shared;
Getopt::Long::GetOptions('clean|c' => sub { $crash = 0; },
'loops|l=i' => \$loops, 'threads|t=i' => \$threads);
{
print "Version ". $HTML::Parser::VERSION."\n";
lock($lock);
for (my $i = 0; $i < $threads; $i++) {
threads->new(\&threadfunc);
}
$start = [gettimeofday()];
}
# Loop through all the threads waiting until finished
foreach my $thr (threads->list) {
# Don't join the main thread or ourselves
if ($thr->tid() && !threads::equal($thr, threads->self())) {
$thr->join();
}
}
print tv_interval($start) . " seconds\n";
sub threadfunc() {
{ lock($lock); }
for (my $i=0 ; $i < $loops ; $i++) {
my @result;
my $out;
print "$i loops\n" if ($i % 5000 == 0);
if ($crash) {
my $html = HTML::Parser->new(api_version => 3,
handlers => [text => [sub { $out .= $_[0] if ($_[0]); },
"dtext"] ]);
} else {
my $html = HTML::Parser->new(api_version => 3,
handlers => [text => [\@result,
"dtext"] ]);
}
}
}