t/op/reset.t

   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.
  11 plan tests => 24;
  12
  13 package aiieee;
  14
  15 sub zlopp {
  16     (shift =~ m?zlopp?) ? 1 : 0;
  17 }
  18
  19 sub reset_zlopp {
  20     reset;
  21 }
  22
  23 package CLINK;
  24
  25 sub ZZIP {
  26     shift =~ m?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");
  64
  65
  66 undef $/;
  67 my $prog = <DATA>;
  68
  69 SKIP:
  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
  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 m8one8;
  92 }
  93 sub b {
  94 m9two9;
  95 }
  96
  97 use threads;
  98 use threads::shared;
  99
 100 sub wipe {
 101     eval 'no warnings; sub b {}; 1' or die $@;
 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";