Commit | Line | Data |
2f3c5f77 |
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 |
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 |
64 | |
65 | |
66 | undef $/; |
67 | my $prog = <DATA>; |
68 | |
69 | SKIP: |
70 | { |
71 | eval {require threads; 1} or |
72 | skip "No threads", 4; |
a1f22e0c |
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"; |