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 =~ ?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");
  64
  65
  66 undef $/;
  67 my $prog = <DATA>;
  68
  69 SKIP:
  70 {
  71     eval {require threads; 1} or
  72         skip "No threads", 4;
  73     local $::TODO
  74         = "Currently performs a read from free()d memory, and may crash";
  75     foreach my $eight ('/', '?') {
  76         foreach my $nine ('/', '?') {
  77             my $copy = $prog;
  78             $copy =~ s/8/$eight/gm;
  79             $copy =~ s/9/$nine/gm;
  80             fresh_perl_is($copy, "pass", "",
  81                           "first pattern $eight$eight, second $nine$nine");
  82         }
  83     }
  84 }
  85
  86 __DATA__
  87 #!perl
  88 use warnings;
  89 use strict;
  90
  91 # Note that there are no digits in this program, other than the placeholders
  92 sub a {
  93 8one8;
  94 }
  95 sub b {
  96 9two9;
  97 }
  98
  99 use threads;
 100 use threads::shared;
 101
 102 sub wipe {
 103     eval 'no warnings; sub b {}';
 104 }
 105
 106 sub lock_then_wipe {
 107     my $l_r = shift;
 108     lock $$l_r;
 109     cond_wait($$l_r) until $$l_r eq "B";
 110     wipe;
 111     $$l_r = "C";
 112     cond_signal $$l_r;
 113 }
 114
 115 my $lock : shared = "A";
 116 my $r = \$lock;
 117
 118 my $t;
 119 {
 120     lock $$r;
 121     $t = threads->new(\&lock_then_wipe, $r);
 122     wipe;
 123     $lock = "B";
 124     cond_signal $lock;
 125 }
 126
 127 {
 128     lock $lock;
 129     cond_wait($lock) until $lock eq "C";
 130     reset;
 131 }
 132
 133 $t->join;
 134 print "pass\n";