The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl -w

use strict;
use warnings;

BEGIN { require "t/test.pl" }

my $Threads_On;
use Config;
BEGIN {
    if(
        $Config{'useithreads'} && 
        eval { require threads; 'threads'->import; 1; }
    ) 
    {
        note "threads are enabled";
        $Threads_On = 1;
    }
    else {
        note "threads are disabled";
        $Threads_On = 0;
    }
}

# This has to come after the above to threads are on
use TB2::threads::shared;


{
    package WithThreads;

    use TB2::Mouse;

    has 'stuff' =>
      is        => 'rw',
    ;
}


note "threads on"; {
    my $obj = WithThreads->new;

    # Try this stuff even with threads off to make sure they don't blow up.
    my %hash = ( counter => 4, bar => [1,2,3] );
    $obj->stuff( shared_clone(\%hash) );

    my $var = 5;
    share($var);

    my $var2 = 1;
    share($var2);

    note "check lock() works with threads on or off"; {
        lock($var2);
    }

    SKIP: {
        skip "No threads" if !$Threads_On;
        my @threads = map {
            'threads'->create(sub {
                # Simple test for share
                $var++;

                # Simple test for shared_clone
                $obj->stuff->{counter}++;

                # Check lock() is doing its job
                lock($var2);

                # Remember the value of the locked variable
                my $check = $var2;

                # Wait around a few seconds, randomly, so other threads can act
                sleep(int rand(3));

                # Make sure the shared variable remains the same
                # XXX threads are broken in TB2 so don't actually run the test
                # unless it fails
                is $var2, $check, "lock() locks" if $var2 != $check;

                # Change the shared variable to try and effect other threads
                # which have locked it
                $var2 = $var2 * 2;
            })
        } 1..5;

        for my $thread (@threads) {
            $thread->join;
        }

        is $var, 10,                                                "share() shares";
        is $var2, 2**5;
        is_deeply $obj->stuff, { counter => 9, bar => [1,2,3] },    "shared_clone() shares";
    }
}

done_testing;