use threads;
use threads::shared;
use Win32::MMF::Shareable;

use strict;
use warnings;
#
#    main thread creates the mmf
#
my $mmf;
tie $mmf, 'Win32::MMF::Shareable', 'mmf',
{
    namespace => 'Win32MMFTest',
    size      => 10000,
    reuse     => 0
};
#
#    and inits it
#
$mmf = 'A' x 10000;
#
#    start each thread to run concurrent tests
#
my $locker : shared = 0;
#
#    add a lock for the mmf - even tho !!!we shouldn't need it!!!
#
my $mmflock : shared = 0;

my $thrd1 = threads->create(\&runtest, 0);
my $thrd2 = threads->create(\&runtest, 5000);
my @tids = ($thrd1->tid, $thrd2->tid);
#
#    signal to run
#
{
    lock($locker);
    $locker = 1;
    cond_broadcast($locker);
}
#
#    and wait for completion
#
{
    lock($locker);
    cond_wait($locker)
        while ($locker < 3);
}
#
#    read back each thread's modifications
#
foreach my $i (0..19) {
    foreach (0..$#tids) {
        my ($first, $second, $third) =
            unpack('l d S/a*', substr($mmf, (5000 * $_) + ($i * 200), 200));
        print "$first $second $third\n";
        print STDERR "wires got crossed!!!\n"
            unless ($first == $tids[$_]);
    }
}

$thrd1->join();
$thrd2->join();

sub runtest {
    my $region = shift;
#
#    wait for signal to run
#
    my $tid = threads->self->tid;
    {
        lock($locker);
        cond_wait($locker)
            while ($locker < 1);
    }
#
#    maybe we need to re-require for Win32::MMF::Shareable in a new
#    thread or process ?
#    (see http://www.perlmonks.com/?node_id=331029)
#
    require Win32::MMF::Shareable;
    my $mmf;
    tie $mmf, 'Win32::MMF::Shareable', 'mmf',
    {
        namespace => 'Win32MMFTest',
        size      => 10000,
        reuse     => 1
    };
    print "length of mmf is ", length($mmf), "\n";
#
#    write some stuff to our region
#
    foreach (0..15) {
        print "$tid at ", $region + ($_ * 200), "\n";
        my $entry = "this is the $region region for tid $tid";
        my $len = length($entry);
#
#    why does this die ????
#
        eval {
            lock($mmflock);    #     realy shouldn't be needed!
            substr($mmf, $region + ($_ * 200), $len + 14) =
                pack('l d S a*', $tid, time(), $len, $entry);
        };
        print "Failure in $tid at ", $region + ($_ * 200), "\n" and last
            if $@;
    }
#
#    signal completion
#
    {
        lock($locker);
        $locker++;
        cond_broadcast($locker);
    }
    return 1;
}