From 31623e47b5a5de87609f69bb07d5757a8d12702f Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Wed, 9 Jan 2002 02:52:39 +0000
Subject: 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).

p4raw-id: //depot/perl@14145
---
 ext/threads/t/stress_re.t | 53 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 53 insertions(+)
 create mode 100644 ext/threads/t/stress_re.t

(limited to 'ext')

diff --git a/ext/threads/t/stress_re.t b/ext/threads/t/stress_re.t
new file mode 100644
index 0000000000..cfee92f06b
--- /dev/null
+++ b/ext/threads/t/stress_re.t
@@ -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");
+}
+
-- 
cgit v1.2.1