Commit | Line | Data |
---|---|---|
2f3c5f77 NC |
1 | #!./perl -w |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | } | |
8 | use strict; | |
9 | ||
10 | # Currently only testing the reset of patterns. | |
a1f22e0c | 11 | plan tests => 24; |
2f3c5f77 NC |
12 | |
13 | package aiieee; | |
14 | ||
15 | sub zlopp { | |
16 | (shift =~ ?zlopp?) ? 1 : 0; | |
17 | } | |
18 | ||
19 | sub reset_zlopp { | |
20 | reset; | |
21 | } | |
22 | ||
23 | package CLINK; | |
24 | ||
25 | sub ZZIP { | |
26 | shift =~ ?ZZIP? ? 1 : 0; | |
27 | } | |
28 | ||
29 | sub reset_ZZIP { | |
30 | reset; | |
31 | } | |
32 | ||
33 | package main; | |
34 | ||
35 | is(aiieee::zlopp(""), 0, "mismatch doesn't match"); | |
36 | is(aiieee::zlopp("zlopp"), 1, "match matches first time"); | |
37 | is(aiieee::zlopp(""), 0, "mismatch doesn't match"); | |
38 | is(aiieee::zlopp("zlopp"), 0, "match doesn't match second time"); | |
39 | aiieee::reset_zlopp(); | |
40 | is(aiieee::zlopp("zlopp"), 1, "match matches after reset"); | |
41 | is(aiieee::zlopp(""), 0, "mismatch doesn't match"); | |
42 | ||
43 | aiieee::reset_zlopp(); | |
44 | ||
45 | is(aiieee::zlopp(""), 0, "mismatch doesn't match"); | |
46 | is(aiieee::zlopp("zlopp"), 1, "match matches first time"); | |
47 | is(CLINK::ZZIP(""), 0, "mismatch doesn't match"); | |
48 | is(CLINK::ZZIP("ZZIP"), 1, "match matches first time"); | |
49 | is(CLINK::ZZIP(""), 0, "mismatch doesn't match"); | |
50 | is(CLINK::ZZIP("ZZIP"), 0, "match doesn't match second time"); | |
51 | is(aiieee::zlopp(""), 0, "mismatch doesn't match"); | |
52 | is(aiieee::zlopp("zlopp"), 0, "match doesn't match second time"); | |
53 | ||
54 | aiieee::reset_zlopp(); | |
55 | is(aiieee::zlopp("zlopp"), 1, "match matches after reset"); | |
56 | is(aiieee::zlopp(""), 0, "mismatch doesn't match"); | |
57 | ||
58 | is(CLINK::ZZIP(""), 0, "mismatch doesn't match"); | |
59 | is(CLINK::ZZIP("ZZIP"), 0, "match doesn't match third time"); | |
60 | ||
61 | CLINK::reset_ZZIP(); | |
62 | is(CLINK::ZZIP("ZZIP"), 1, "match matches after reset"); | |
63 | is(CLINK::ZZIP(""), 0, "mismatch doesn't match"); | |
a1f22e0c NC |
64 | |
65 | ||
66 | undef $/; | |
67 | my $prog = <DATA>; | |
68 | ||
69 | SKIP: | |
70 | { | |
71 | eval {require threads; 1} or | |
72 | skip "No threads", 4; | |
a1f22e0c NC |
73 | foreach my $eight ('/', '?') { |
74 | foreach my $nine ('/', '?') { | |
75 | my $copy = $prog; | |
76 | $copy =~ s/8/$eight/gm; | |
77 | $copy =~ s/9/$nine/gm; | |
78 | fresh_perl_is($copy, "pass", "", | |
79 | "first pattern $eight$eight, second $nine$nine"); | |
80 | } | |
81 | } | |
82 | } | |
83 | ||
84 | __DATA__ | |
85 | #!perl | |
86 | use warnings; | |
87 | use strict; | |
88 | ||
89 | # Note that there are no digits in this program, other than the placeholders | |
90 | sub a { | |
91 | 8one8; | |
92 | } | |
93 | sub b { | |
94 | 9two9; | |
95 | } | |
96 | ||
97 | use threads; | |
98 | use threads::shared; | |
99 | ||
100 | sub wipe { | |
101 | eval 'no warnings; sub b {}'; | |
102 | } | |
103 | ||
104 | sub lock_then_wipe { | |
105 | my $l_r = shift; | |
106 | lock $$l_r; | |
107 | cond_wait($$l_r) until $$l_r eq "B"; | |
108 | wipe; | |
109 | $$l_r = "C"; | |
110 | cond_signal $$l_r; | |
111 | } | |
112 | ||
113 | my $lock : shared = "A"; | |
114 | my $r = \$lock; | |
115 | ||
116 | my $t; | |
117 | { | |
118 | lock $$r; | |
119 | $t = threads->new(\&lock_then_wipe, $r); | |
120 | wipe; | |
121 | $lock = "B"; | |
122 | cond_signal $lock; | |
123 | } | |
124 | ||
125 | { | |
126 | lock $lock; | |
127 | cond_wait($lock) until $lock eq "C"; | |
128 | reset; | |
129 | } | |
130 | ||
131 | $t->join; | |
132 | print "pass\n"; |