This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
utf8cache.t: Skip only the XS-dependent test
[perl5.git] / t / op / reset.t
index d72bfde..3094979 100644 (file)
@@ -8,12 +8,12 @@ BEGIN {
 use strict;
 
 # Currently only testing the reset of patterns.
-plan tests => 20;
+plan tests => 24;
 
 package aiieee;
 
 sub zlopp {
-    (shift =~ ?zlopp?) ? 1 : 0;
+    (shift =~ m?zlopp?) ? 1 : 0;
 }
 
 sub reset_zlopp {
@@ -23,7 +23,7 @@ sub reset_zlopp {
 package CLINK;
 
 sub ZZIP {
-    shift =~ ?ZZIP? ? 1 : 0;
+    shift =~ m?ZZIP? ? 1 : 0;
 }
 
 sub reset_ZZIP {
@@ -61,3 +61,72 @@ is(CLINK::ZZIP("ZZIP"), 0, "match doesn't match third time");
 CLINK::reset_ZZIP();
 is(CLINK::ZZIP("ZZIP"), 1, "match matches after reset");
 is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
+
+
+undef $/;
+my $prog = <DATA>;
+
+SKIP:
+{
+    eval {require threads; 1} or
+       skip "No threads", 4;
+    foreach my $eight ('/', '?') {
+       foreach my $nine ('/', '?') {
+           my $copy = $prog;
+           $copy =~ s/8/$eight/gm;
+           $copy =~ s/9/$nine/gm;
+           fresh_perl_is($copy, "pass", "",
+                         "first pattern $eight$eight, second $nine$nine");
+       }
+    }
+}
+
+__DATA__
+#!perl
+use warnings;
+use strict;
+
+# Note that there are no digits in this program, other than the placeholders
+sub a {
+m8one8;
+}
+sub b {
+m9two9;
+}
+
+use threads;
+use threads::shared;
+
+sub wipe {
+    eval 'no warnings; sub b {}; 1' or die $@;
+}
+
+sub lock_then_wipe {
+    my $l_r = shift;
+    lock $$l_r;
+    cond_wait($$l_r) until $$l_r eq "B";
+    wipe;
+    $$l_r = "C";
+    cond_signal $$l_r;
+}
+
+my $lock : shared = "A";
+my $r = \$lock;
+
+my $t;
+{
+    lock $$r;
+    $t = threads->new(\&lock_then_wipe, $r);
+    wipe;
+    $lock = "B";
+    cond_signal $lock;
+}
+
+{
+    lock $lock;
+    cond_wait($lock) until $lock eq "C";
+    reset;
+}
+
+$t->join;
+print "pass\n";