1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132
|
#!./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";
|