Perl threading of object method

Question

Perl rookie here, so please be gentle :)

I've written following code to keep track of my dogs when I'm hunting (not really). Every time a dog finds a duck, it signals the main thread, which then collects information from each of the dogs in the pack.

#!/usr/bin/env perl

use strict;
use warnings;
use v5.14;

use threads;

{
    package Dog;

    sub new {
        my ($class, $name, $dt) = @_;
        my $self = {
            dt => $dt,      # will find a duck every $dt seconds
            name => $name,
            ducksfound => 0
        };
        bless $self, $class;
    }

    sub hunt {
        #
        # the "thread" method -- the dog will hang around for $dt seconds,
        # then alert the main thread by sending SIGUSR1
        #
        my $self = shift;
        while (1) {
            sleep $self->{dt};
            $self->{ducksfound} += 1;
            kill USR1 => $$;
        }
    }

    sub bark {
        my $self = shift;
        sprintf "%s: found %d ducks!", ($self->{name}, $self->{ducksfound});
    }

    1;
}

my @dogs;

$SIG{USR1} = sub {
    say join ", ", map { $_->bark } @dogs;
};


push @dogs, Dog->new("Labrador", 1);
push @dogs, Dog->new("Retriever", 2);
push @dogs, Dog->new("Shepherd", 3);

threads->create( sub { $_->hunt } ) for @dogs;
$_->join for threads->list;

Expected output of the above code would be something like:

Labrador: found 1 ducks!, Retriever: found 0 ducks!, Shepherd: found 0 ducks!

Labrador: found 2 ducks!, Retriever: found 0 ducks!, Shepherd: found 0 ducks!

Labrador: found 3 ducks!, Retriever: found 0 ducks!, Shepherd: found 0 ducks!

Labrador: found 3 ducks!, Retriever: found 1 ducks!, Shepherd: found 0 ducks!

Labrador: found 4 ducks!, Retriever: found 1 ducks!, Shepherd: found 0 ducks!

Labrador: found 5 ducks!, Retriever: found 1 ducks!, Shepherd: found 0 ducks!

Labrador: found 6 ducks!, Retriever: found 1 ducks!, Shepherd: found 0 ducks!

Labrador: found 6 ducks!, Retriever: found 1 ducks!, Shepherd: found 0 ducks!

Labrador: found 6 ducks!, Retriever: found 1 ducks!, Shepherd: found 1 ducks!

Instead, what I get is the following:

Labrador: found 1 ducks!, Retriever: found 0 ducks!, Shepherd: found 0 ducks!

Labrador: found 2 ducks!, Retriever: found 0 ducks!, Shepherd: found 0 ducks!

Labrador: found 3 ducks!, Retriever: found 0 ducks!, Shepherd: found 0 ducks!

Labrador: found 0 ducks!, Retriever: found 1 ducks!, Shepherd: found 0 ducks!

Labrador: found 4 ducks!, Retriever: found 0 ducks!, Shepherd: found 0 ducks!

Labrador: found 5 ducks!, Retriever: found 0 ducks!, Shepherd: found 0 ducks!

Labrador: found 0 ducks!, Retriever: found 2 ducks!, Shepherd: found 0 ducks!

Labrador: found 0 ducks!, Retriever: found 0 ducks!, Shepherd: found 1 ducks!

Notice how every dog's duck count resets to zero whan another dog is speaking.

Any insights as to which particular footnote I must have glossed over while reading the Llama?

Answer 1

The fundamental problem is that Perl variables are not shared by default, which combines with a bit of weirdness about which thread is servicing which signal to produce the result you're seeing.

When you spawn your hunting threads, each of them gets its own copy of @dogs and its contents. That's just the way Perl threads work: the interpreter and its current state -- @dogs, %SIG, the open STDOUT -- is cloned entire. To see how that works, consider this code:

my %dog_decls = (
    Labrador    => 1,
    Retriever   => 2,
    Shepherd    => 3,
);

while (my ($name, $delay) = each %dog_decls) {
    my $dog = Dog->new($name, $delay);
    push @dogs, $dog;
    threads->create(sub { $dog->hunt });
}

$_->join for threads->list;

The cloning happens at threads->create time, so each of these threads is getting a different version of @dogs to take with it. As a consequence, the list of Dogs that bark when one of them catches a duck depends on which thread catches the signal! (Also note that you can infer the order in which each happened to emit the hash from this output.)

Retriever: found 0 ducks!, Labrador: found 1 ducks!

Retriever: found 0 ducks!, Labrador: found 2 ducks!

Retriever: found 1 ducks!

Retriever: found 0 ducks!, Labrador: found 3 ducks!

Retriever: found 0 ducks!, Labrador: found 4 ducks!

Retriever: found 0 ducks!, Labrador: found 0 ducks!, Shepherd: found 1 ducks!

Back to your code: When the Labrador thread (thread 1) wakes up, it updates the Labrador's ducksfound and sends a SIGUSR1. Someone (and we'll talk more about who in a second) sees the signal and barks all the Dogs. But the only Labrador that's been changed is the one in thread 1. The Retriever and Shepherd threads (threads 2 and 3 respectively) have not seen the update to Labrador's ducksfound.

Why then is the value for ducksfound printed correctly at first? Because of the way you installed the signal handler. You installed it process-wide -- recall that I said %SIG was among the things cloned to your threads. So each of the threads has a handler for USR1 that causes all the Dogs to bark. When you send USR1 to $$, whichever thread happens to be awake at that moment catches it. And it so happens that the thread that sent the signal is the thread that is awake.

And that explains why when the Retriever catches its first duck, its ducksfound value is correct but the Labrador's is not. Retriever catches the duck in thread 2, which sends SIGUSR1 to itself and then barks all its Dogs. But in thread 2, the Labrador has never been updated, and so the bark shows 0 for Labrador and 1 for Retriever.

The problem of unshared variables can be gotten around fairly simply by use of threads::shared:

use threads::shared;
...
my @dogs :shared;
...
push @dogs, shared_clone(Dog->new("Labrador",  1));

Now when one thread updates a Dog, all threads will see it and so it doesn't matter which thread is servicing the signal. Which is good, because in your code the "main thread" (thread 0) never gets back control. This might be okay, but probably leads to slightly weirder behavior than you expect.

If you actually want there to exist a manager thread, you probably need to spawn it explicitly:

# in Dog::new
        my ($class, $name, $hunter, $dt) = @_;
        ...
        hunter => $hunter,
# in Dog::hunt
        $self->{hunter}->kill('USR1');
# in main
my $hunter_thread = threads->create(
    sub {
        local $SIG{USR1} = sub {
            say join ", ", map { $_->bark } @dogs;
        };
        while (1) { usleep 100_000 } # higher resolution than hunt events
    }
);
...
push @dogs, shared_clone(Dog->new("Labrador", $hunter_thread, 1));

Note that just putting in a manager thread without sharing your Dogs would result in a thread that wakes up to print a bunch of zeroes. You need to do both to get the results you were expecting.