Change 14145 by jhi@alpha on 2002/01/09 02:52:39
Add a threads stress test for regular expressions
(mostly just a modified stress_string.t) and doesn't
test that much of regular expressions, just that $1
doesn't get stomped by competing threads (as it does
in the 5005threads of old).
Affected files ...
.... //depot/perl/MANIFEST#698 edit
.... //depot/perl/ext/threads/t/stress_re.t#1 add
Differences ...
==== //depot/perl/MANIFEST#698 (text) ====
==== //depot/perl/ext/threads/t/stress_re.t#1 (text) ====
Index: perl/ext/threads/t/stress_re.t
--- perl/ext/threads/t/stress_re.t.~1~ Tue Jan 8 20:00:06 2002
+++ perl/ext/threads/t/stress_re.t Tue Jan 8 20:00:06 2002
@@ -0,0 +1,53 @@
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require Config; import Config;
+ unless ($Config{'useithreads'}) {
+ print "1..0 # Skip: no useithreads\n";
+ exit 0;
+ }
+}
+
+use ExtUtils::testlib;
+use strict;
+BEGIN { print "1..64\n" };
+use threads;
+
+
+print "ok 1\n";
+
+
+
+
+sub ok {
+ my ($id, $ok, $name) = @_;
+
+ # You have to do it this way or VMS will get confused.
+ print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
+
+ printf "# Failed test at line %d\n", (caller)[2] unless $ok;
+
+ return $ok;
+}
+
+
+ok(2,1,"");
+
+sub test9 {
+ my $s = "abcd" x (1000 + $_);
+ my $t = '';
+ while ($s =~ /(.)/g) { $t .= $1 }
+ print "not ok $_[0]\n" if $s ne $t;
+}
+my @threads;
+for(3..33) {
+ ok($_,1,"Multiple thread test");
+ push @threads ,threads->create('test9',$_);
+}
+
+my $i = 34;
+for(@threads) {
+ $_->join;
+ ok($i++,1,"Thread joined");
+}
+
End of Patch.
