After some digging through the ugly (and at least partially) bad code, I think I know where the error happens, and what you might do to hide this error. There is a programming error in the code where one of the references to a shared variable gets overwritten by a number. In sub cmdloop, replace the line

        $self->{rw} = 1;
[download]

by

        ${$self->{rw}} = 1;
[download]

This makes the code "work" for me in the sense that the segfault disappears with both Perl versions. It then seems to hang in the PRINT command, but that might well be an error in the programming logic. I've pasted my modified code below, maybe somebody sees the deadlock.

#!/usr/bin/perl -w
use strict;
use threads;

sub threadA {
    for(my $i = 1; $i <= 100; $i++) {
        warn "Thread A: Print $i";
    print FILE "A: $i\n";
    }
}

sub threadB {
    for(my $i = 1; $i <= 100; $i++) {
        warn "Thread B: Print $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;

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;
    warn "Autoloaded $AUTOLOAD";
    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:
        warn "$AUTOLOAD: Sent $method(@_)";
    @{$self->{cmd}} = ($method, @_);
    # Tell command thread that it is waiting:
    {
        lock $self->{cw};
        ${$self->{cw}} = 1;
        cond_signal $self->{cw};
    }
    # Wait for return values
        warn "$AUTOLOAD: waiting";
    {
        lock $self->{rw};
        while (!${$self->{rw}}) {
                warn "$AUTOLOAD: waiting for data";
        cond_wait $self->{rw};
                warn "$AUTOLOAD: done waiting";
        }
        ${$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;
    warn "Entered command loop";
    my $fh = new FileHandle;

    while (1) {
    # Wait for and get command
    {
        warn "Waiting for command ready";
        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)";
    warn "sending \$fh->$method(@args)";
    @{$self->{rv}} = eval $mcall;
    #@{$self->{rv}} = $fh->$method(@args);

    # Record errors
    ${$self->{err}} = $@;
    } continue {
    # Signal that values are waiting
    {
        warn "Signaling data available";
        lock $self->{rw};
        warn "locked 'rw' flag";
        warn "'rw' flag is $self->{rw}";
        ${$self->{rw}} = 1;
        warn "'rw' flag is $self->{rw}";
        cond_signal $self->{rw};
        warn "signalled 'rw' flag";
    }
    }
}

1;
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.