1#!./perl -w 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6 require './test.pl'; 7} 8use strict; 9 10# Currently only testing the reset of patterns. 11plan tests => 24; 12 13package aiieee; 14 15sub zlopp { 16 (shift =~ ?zlopp?) ? 1 : 0; 17} 18 19sub reset_zlopp { 20 reset; 21} 22 23package CLINK; 24 25sub ZZIP { 26 shift =~ ?ZZIP? ? 1 : 0; 27} 28 29sub reset_ZZIP { 30 reset; 31} 32 33package main; 34 35is(aiieee::zlopp(""), 0, "mismatch doesn't match"); 36is(aiieee::zlopp("zlopp"), 1, "match matches first time"); 37is(aiieee::zlopp(""), 0, "mismatch doesn't match"); 38is(aiieee::zlopp("zlopp"), 0, "match doesn't match second time"); 39aiieee::reset_zlopp(); 40is(aiieee::zlopp("zlopp"), 1, "match matches after reset"); 41is(aiieee::zlopp(""), 0, "mismatch doesn't match"); 42 43aiieee::reset_zlopp(); 44 45is(aiieee::zlopp(""), 0, "mismatch doesn't match"); 46is(aiieee::zlopp("zlopp"), 1, "match matches first time"); 47is(CLINK::ZZIP(""), 0, "mismatch doesn't match"); 48is(CLINK::ZZIP("ZZIP"), 1, "match matches first time"); 49is(CLINK::ZZIP(""), 0, "mismatch doesn't match"); 50is(CLINK::ZZIP("ZZIP"), 0, "match doesn't match second time"); 51is(aiieee::zlopp(""), 0, "mismatch doesn't match"); 52is(aiieee::zlopp("zlopp"), 0, "match doesn't match second time"); 53 54aiieee::reset_zlopp(); 55is(aiieee::zlopp("zlopp"), 1, "match matches after reset"); 56is(aiieee::zlopp(""), 0, "mismatch doesn't match"); 57 58is(CLINK::ZZIP(""), 0, "mismatch doesn't match"); 59is(CLINK::ZZIP("ZZIP"), 0, "match doesn't match third time"); 60 61CLINK::reset_ZZIP(); 62is(CLINK::ZZIP("ZZIP"), 1, "match matches after reset"); 63is(CLINK::ZZIP(""), 0, "mismatch doesn't match"); 64 65 66undef $/; 67my $prog = <DATA>; 68 69SKIP: 70{ 71 eval {require threads; 1} or 72 skip "No threads", 4; 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 86use warnings; 87use strict; 88 89# Note that there are no digits in this program, other than the placeholders 90sub a { 918one8; 92} 93sub b { 949two9; 95} 96 97use threads; 98use threads::shared; 99 100sub wipe { 101 eval 'no warnings; sub b {}'; 102} 103 104sub 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 113my $lock : shared = "A"; 114my $r = \$lock; 115 116my $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; 132print "pass\n"; 133