From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 4 Apr 2007 21:42:26 +0000 (+0000)
Subject: Add TODO tests for the (sometimes) crashing threads/op deletion/reset
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a1f22e0c11d435567d8b189336ae4f9dcc640eea;p=p5sagit%2Fp5-mst-13.2.git

Add TODO tests for the (sometimes) crashing threads/op deletion/reset
combination.

p4raw-id: //depot/perl@30845
---

diff --git a/t/op/reset.t b/t/op/reset.t
index d72bfde..7a9620f 100644
--- a/t/op/reset.t
+++ b/t/op/reset.t
@@ -8,7 +8,7 @@ BEGIN {
 use strict;
 
 # Currently only testing the reset of patterns.
-plan tests => 20;
+plan tests => 24;
 
 package aiieee;
 
@@ -61,3 +61,74 @@ 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;
+    local $::TODO
+	= "Currently performs a read from free()d memory, and may crash";
+    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 {
+8one8;
+}
+sub b {
+9two9;
+}
+
+use threads;
+use threads::shared;
+
+sub wipe {
+    eval 'no warnings; sub b {}';
+}
+
+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";