Your message dated Wed, 06 Jan 2010 19:26:58 +0200
with message-id <[email protected]>
and subject line closing #203579
has caused the Debian Bug report #203579,
regarding perl 5.8.0 segfaults while doing thread data sharing
to be marked as done.
This means that you claim that the problem has been dealt with.
If this is not the case it is now your responsibility to reopen the
Bug report if necessary, and/or fix the problem forthwith.
(NB: If you are a system administrator and have no idea what this
message is talking about, this may indicate a serious mail system
misconfiguration somewhere. Please contact [email protected]
immediately.)
--
203579: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=203579
Debian Bug Tracking System
Contact [email protected] with problems
--- Begin Message ---
Package: perl
Version: 5.8.0-19
Severity: normal
perl segfaults while running the following script (a test script for a
module designed to allow sharing filehandles between threads through a
simple tie mechanism and a dedicated thread that controls access to
the filehandle):
test-fhshare:
----------------------------------------------------------------------
#!/usr/bin/perl -w
use strict;
use threads;
use FHShare;
sub threadA {
for(my $i = 1; $i <= 100; $i++) {
print FILE "A: $i\n";
}
}
sub threadB {
for(my $i = 1; $i <= 100; $i++) {
print FILE "B: $i\n";
}
}
tie *FILE, 'FHShare';
open FILE, '>fhshare.out';
autoflush FILE;
my $a = threads->create('threadA');
threadB();
$a->join;
close FILE;
----------------------------------------------------------------------
FHShare.pm:
----------------------------------------------------------------------
package FHShare;
# A package to share filehandles between threads via tie()
use strict;
use threads;
use threads::shared;
use FileHandle;
# Subroutine to start thread that accesses filehandle
sub start_thread {
my $self = shift;
$self->cmdloop();
}
sub TIEHANDLE {
my $class = shift;
my $sem : shared;
my $cw : shared = 0;
my $rw : shared = 0;
my @cmd : shared;
my @rv : shared;
my $err : shared;
my $self = {
cmd => \...@cmd, # Command
rv => \...@rv, # Return value
err => \$err, # Error from calling filehandle method
# A semaphore to lock access to send commands to the command
# thread:
sem => \$sem,
# A semaphore for the command thread to notify it that it has
# a command waiting:
cw => \$cw, # 1 for command waiting
# A semaphore for the command thread to notify other threads
# that return values are waiting:
rw => \$rw }; # 1 for values waiting
bless $self, $class;
# Create thread attached to this handle
threads->create('start_thread', $self)->detach();
return $self;
}
sub DESTROY {
my $self = shift;
lock $self->{sem};
${$self->{cmd}} = (); # Empty list to quit
{
lock $self->{cw};
${$self->{cw}} = 1;
cond_signal $self->{cw};
}
{
lock $self->{rw};
while (!${$self->{rw}}) {
cond_wait $self->{rw};
}
}
}
# Autoload section -- convert uppercase method names called to
# lowercase method names for the underlying filehandle.
our $AUTOLOAD;
sub AUTOLOAD {
my $self = shift;
my $method = lc($AUTOLOAD); # Convert method to lc.
$method =~ s/^.*:://; # Remove prefix.
FileHandle->can($method) or
die "Error: filehandles have no '$method' method";
my @ret; # Return value
{
lock $self->{sem}; # Lock access
# Send command:
@{$self->{cmd}} = ($method, @_);
# Tell command thread that it is waiting:
{
lock $self->{cw};
${$self->{cw}} = 1;
cond_signal $self->{cw};
}
# Wait for return values
{
lock $self->{rw};
while (!${$self->{rw}}) {
cond_wait $self->{rw};
}
${$self->{rw}} = 0; # Reset
}
# Handle errors
if (my $err = ${$self->{err}}) {
chomp $err;
my($filename, $line) = (caller)[2,3];
die "$err at $filename line $line\n";
}
@ret = @{$self->{rv}}; # Get return values
}
return @ret; # Return w/ return vals
}
# Method for thread that accesses underlying filehandle to loop
# through commands
sub cmdloop {
my $self = shift;
my $fh = new FileHandle;
while (1) {
# Wait for and get command
{
lock $self->{cw};
while (!${$self->{cw}}) {
cond_wait $self->{cw};
}
$self->{cw} = 0; # Reset
}
# Get the method and arguments
my @cmd = @{$self->{cmd}} or last; # Quit on empty list
my $method = shift @cmd;
my @args = @cmd;
# Call the method, enqueue the return value(s)
my $mcall = "\$fh->$method(\...@args)";
@{$self->{rv}} = eval $mcall;
# Record errors
${$self->{err}} = $@;
} continue {
# Signal that values are waiting
{
lock $self->{rw};
$self->{rw} = 1;
cond_signal $self->{rw};
}
}
}
1;
----------------------------------------------------------------------
-- System Information:
Debian Release: testing/unstable
Architecture: i386
Kernel: Linux frankenstein 2.4.18-686 #1 Sun Apr 14 11:32:47 EST 2002 i686
Locale: LANG=en_US, LC_CTYPE=en_US
Versions of packages perl depends on:
ii libc6 2.3.1-17 GNU C Library: Shared libraries an
ii libdb4.0 4.0.14-1.2 Berkeley v4.0 Database Libraries [
ii libgdbm3 1.8.3-1 GNU dbm database routines (runtime
ii perl-base 5.8.0-19 The Pathologically Eclectic Rubbis
ii perl-modules 5.8.0-19 Core Perl modules.
-- no debconf information
--- End Message ---
--- Begin Message ---
Version: 5.10.1-5
No objections/comments from bug reporter, bug seems to be fixed in Perl
5.10.1, marking as fixed in verified version.
Re-open if you object.
--
Eugene V. Lyubimkin aka JackYF, JID: jackyf.devel(maildog)gmail.com
C++/Perl developer, Debian Developer
signature.asc
Description: OpenPGP digital signature
--- End Message ---
