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 =~ m?zlopp?) ? 1 : 0;
}
sub reset_zlopp {
reset;
}
package CLINK;
sub ZZIP {
shift =~ m?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 {
m8one8;
}
sub b {
m9two9;
}
use threads;
use threads::shared;
sub wipe {
eval 'no warnings; sub b {}; 1' or die $@;
}
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";
|
