#!./perl -w
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
}
use strict;
# Currently only testing the reset of patterns.
plan tests => 24;
package aiieee;
sub zlopp {
(shift =~ ?zlopp?) ? 1 : 0;
}
sub reset_zlopp {
reset;
}
package CLINK;
sub ZZIP {
shift =~ ?ZZIP? ? 1 : 0;
}
sub reset_ZZIP {
reset;
}
package main;
is(aiieee::zlopp(""), 0, "mismatch doesn't match");
is(aiieee::zlopp("zlopp"), 1, "match matches first time");
is(aiieee::zlopp(""), 0, "mismatch doesn't match");
is(aiieee::zlopp("zlopp"), 0, "match doesn't match second time");
aiieee::reset_zlopp();
is(aiieee::zlopp("zlopp"), 1, "match matches after reset");
is(aiieee::zlopp(""), 0, "mismatch doesn't match");
aiieee::reset_zlopp();
is(aiieee::zlopp(""), 0, "mismatch doesn't match");
is(aiieee::zlopp("zlopp"), 1, "match matches first time");
is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
is(CLINK::ZZIP("ZZIP"), 1, "match matches first time");
is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
is(CLINK::ZZIP("ZZIP"), 0, "match doesn't match second time");
is(aiieee::zlopp(""), 0, "mismatch doesn't match");
is(aiieee::zlopp("zlopp"), 0, "match doesn't match second time");
aiieee::reset_zlopp();
is(aiieee::zlopp("zlopp"), 1, "match matches after reset");
is(aiieee::zlopp(""), 0, "mismatch doesn't match");
is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
is(CLINK::ZZIP("ZZIP"), 0, "match doesn't match third time");
CLINK::reset_ZZIP();
is(CLINK::ZZIP("ZZIP"), 1, "match matches after reset");
is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
undef $/;
my $prog = <DATA>;
SKIP:
{
eval {require threads; 1} or
skip "No threads", 4;
foreach my $eight ('/', '?') {
foreach my $nine ('/', '?') {
my $copy = $prog;
$copy =~ s/8/$eight/gm;
$copy =~ s/9/$nine/gm;
fresh_perl_is($copy, "pass", "",
"first pattern $eight$eight, second $nine$nine");
}
}
}
__DATA__
#!perl
use warnings;
use strict;
# Note that there are no digits in this program, other than the placeholders
sub a {
8one8;
}
sub b {
9two9;
}
use threads;
use threads::shared;
sub wipe {
eval 'no warnings; sub b {}';
}
sub lock_then_wipe {
my $l_r = shift;
lock $$l_r;
cond_wait($$l_r) until $$l_r eq "B";
wipe;
$$l_r = "C";
cond_signal $$l_r;
}
my $lock : shared = "A";
my $r = \$lock;
my $t;
{
lock $$r;
$t = threads->new(\&lock_then_wipe, $r);
wipe;
$lock = "B";
cond_signal $lock;
}
{
lock $lock;
cond_wait($lock) until $lock eq "C";
reset;
}
$t->join;
print "pass\n";