Variants of several regression tests that run the actul tests inside

a new thread, to test ithread's cloning, particularly of regexps.

p4raw-id: //depot/perl@32931

12 files changed, 225 insertions, 68 deletions

diff --git a/t/op/index.t b/t/op/index.t
index b384bef445..38da96c5e3 100755
--- a/t/op/index.t
+++ b/t/op/index.t
@@ -9,6 +9,10 @@ BEGIN {
 use strict;
 plan( tests => 69 );
 
+run_tests() unless caller;
+
+sub run_tests {
+
 my $foo = 'Now is the time for all good men to come to the aid of their country.';
 
 my $first = substr($foo,0,index($foo,'the'));
@@ -155,3 +159,5 @@ SKIP: {
     local ${^UTF8CACHE} = -1;
     is(index($t, 'xyz'), 4, "0xfffffffd and utf8cache");
 }
+
+}
diff --git a/t/op/index_thr.t b/t/op/index_thr.t
new file mode 100644
index 0000000000..3a97741625
--- /dev/null
+++ b/t/op/index_thr.t
@@ -0,0 +1,7 @@
+#!./perl
+
+chdir 't' if -d 't';
+@INC = ('../lib', '.');
+
+require 'thread_it.pl';
+thread_it(qw(op index.t));
diff --git a/t/op/pat.t b/t/op/pat.t
index 0e16cd9ff6..2ccc07cf84 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -16,6 +16,10 @@ our $Message = "Noname test";
 
 eval 'use Config';          #  Defaults assumed if this fails
 
+run_tests() unless caller;
+
+sub run_tests {
+
 $x = "abc\ndef\n";
 
 if ($x =~ /^abc/) {print "ok 1\n";} else {print "not ok 1\n";}
@@ -533,25 +537,32 @@ print "not " unless $1 and /$1/;
 print "ok $test\n";
 $test++;
 
+if ($::running_as_thread) {
+    print "not ok $test # TODO & SKIP: croaks in 5.10 when threaded\n";
+    $test++;
+} else {
 $a=qr/(?{++$b})/;
 $b = 7;
 /$a$a/;
 print "not " unless $b eq '9';
 print "ok $test\n";
 $test++;
+}
 
-$c="$a";
-/$a$a/;
-print "not " unless $b eq '11';
-print "ok $test\n";
-$test++;
+{
+    local $TODO = $::running_as_thread;
+    $c="$a";
+    /$a$a/;
+    iseq($b, '11');
+}
 
 {
   use re "eval";
   /$a$c$a/;
-  print "not " unless $b eq '14';
-  print "ok $test\n";
-  $test++;
+  {
+      local $TODO = $::running_as_thread;
+      iseq($b, '14');
+  }
 
   local $lex_a = 2;
   my $lex_a = 43;
@@ -571,10 +582,10 @@ $test++;
 
   no re "eval";
   $match = eval { /$a$c$a/ };
-  print "not "
-    unless $b eq '14' and $@ =~ /Eval-group not allowed/ and not $match;
-  print "ok $test\n";
-  $test++;
+  # FIXME - split this one. That would require removing a lot of hard coded
+  # test numbers.
+  local $TODO = $::running_as_thread;
+  ok($b eq '14' and $@ =~ /Eval-group not allowed/ and not $match);
 }
 
 {
@@ -789,9 +800,10 @@ print "not " if $str =~ /^...\G/;
 print "ok $test\n";
 $test++;
 
-print "not " unless $str =~ /.\G./ and $& eq 'bc';
-print "ok $test\n";
-$test++;
+{
+    local $TODO = $::running_as_thread;
+    ok($str =~ /.\G./ and $& eq 'bc');
+}
 
 print "not " unless $str =~ /\G../ and $& eq 'cd';
 print "ok $test\n";
@@ -875,23 +887,29 @@ $foo='aabbccddeeffgg';
 pos($foo)=1;
 
 $foo=~/.\G(..)/g;
-iseq($1,'ab');
+{
+    local $TODO = $::running_as_thread;
+    iseq($1,'ab');
+}
 
 pos($foo) += 1;
 $foo=~/.\G(..)/g;
-print "not " unless($1 eq 'cc');
-print "ok $test\n";
-$test++;
+{
+    local $TODO = $::running_as_thread;
+    iseq($1, 'cc');
+}
 
 pos($foo) += 1;
 $foo=~/.\G(..)/g;
-print "not " unless($1 eq 'de');
-print "ok $test\n";
-$test++;
+{
+    local $TODO = $::running_as_thread;
+    iseq($1, 'de');
+}
 
-print "not " unless $foo =~ /\Gef/g;
-print "ok $test\n";
-$test++;
+{
+    local $TODO = $::running_as_thread;
+    ok($foo =~ /\Gef/g);
+}
 
 undef pos $foo;
 
@@ -1279,7 +1297,10 @@ print "ok 246\n";
 print "not " unless "\x{abcd}" =~ /\x{abcd}/;
 print "ok 247\n";
 
-{
+if ($::running_as_thread) {
+    print "not ok 248 # TODO & SKIP: SEGVs in 5.10 when threaded\n";
+    print "not ok 249 # TODO & SKIP: SEGVs in 5.10 when threaded\n";
+} else {
     # bug id 20001008.001
 
     $test = 248;
@@ -4525,7 +4546,12 @@ sub kt
      s/(*:X)A+|(*:Y)B+|(*:Z)C+/$REGMARK/g;
      iseq $_, "ZYX";
 }
-{
+if ($::running_as_thread) {
+    for (1..3) {
+	print "not ok $test # TODO & SKIP: croaks when threaded\n";
+	$test++;
+    }
+} else {
     our @ctl_n=();
     our @plus=();
     our $nested_tags;
@@ -4606,8 +4632,13 @@ ok($@=~/\QSequence \k... not terminated in regex;\E/);
 
 # Put new tests above the dotted line about a page above this comment
 iseq(0+$::test,$::TestCount,"Got the right number of tests!");
+
+} # end of sub pat_tests
+
 # Don't forget to update this!
 BEGIN {
     $::TestCount = 4019;
     print "1..$::TestCount\n";
 }
+
+"Truth";
diff --git a/t/op/pat_thr.t b/t/op/pat_thr.t
new file mode 100644
index 0000000000..3228b33a65
--- /dev/null
+++ b/t/op/pat_thr.t
@@ -0,0 +1,7 @@
+#!./perl
+
+chdir 't' if -d 't';
+@INC = ('../lib', '.');
+
+require 'thread_it.pl';
+thread_it(qw(op pat.t));
diff --git a/t/op/re_tests b/t/op/re_tests
index c2397e68b6..6f4db07dc4 100644
--- a/t/op/re_tests
+++ b/t/op/re_tests
@@ -503,14 +503,14 @@ a(?:b|(c|e){1,2}?|d)+?(.)	ace	y	$1$2	ce
 '(ab)\d\1'i	Ab4ab	y	$1	Ab
 '(ab)\d\1'i	ab4Ab	y	$1	ab
 foo\w*\d{4}baz	foobar1234baz	y	$&	foobar1234baz
-a(?{})b	cabd	y	$&	ab
+a(?{})b	cabd	yt	$&	ab	threads confuse eval
 a(?{)b	-	c	-	Sequence (?{...}) not terminated or not {}-balanced
 a(?{{})b	-	c	-	Sequence (?{...}) not terminated or not {}-balanced
 a(?{}})b	-	c	-	
 a(?{"{"})b	-	c	-	Sequence (?{...}) not terminated or not {}-balanced
-a(?{"\{"})b	cabd	y	$&	ab
+a(?{"\{"})b	cabd	yt	$&	ab	threads confuse eval
 a(?{"{"}})b	-	c	-	Unmatched right curly bracket
-a(?{$::bl="\{"}).b	caxbd	y	$::bl	{
+a(?{$::bl="\{"}).b	caxbd	yt	$::bl	{	threads confuse eval
 x(~~)*(?:(?:F)?)?	x~~	y	-	-
 ^a(?#xxx){3}c	aaac	y	$&	aaac
 '^a (?#xxx) (?#yyy) {3}c'x	aaac	y	$&	aaac
@@ -550,10 +550,10 @@ x(~~)*(?:(?:F)?)?	x~~	y	-	-
 ^(\(+)?blah(?(1)(\)))$	(blah	n	-	-
 (?(1?)a|b)	a	c	-	Switch condition not recognized
 (?(1)a|b|c)	a	c	-	Switch (?(condition)... contains too many branches
-(?(?{0})a|b)	a	n	-	-
-(?(?{0})b|a)	a	y	$&	a
-(?(?{1})b|a)	a	n	-	-
-(?(?{1})a|b)	a	y	$&	a
+(?(?{0})a|b)	a	nt	-	-	threads confuse eval
+(?(?{0})b|a)	a	yt	$&	a	threads confuse eval
+(?(?{1})b|a)	a	nt	-	-	threads confuse eval
+(?(?{1})a|b)	a	yt	$&	a	threads confuse eval
 (?(?!a)a|b)	a	n	-	-
 (?(?!a)b|a)	a	y	$&	a
 (?(?=a)b|a)	a	n	-	-
@@ -573,8 +573,8 @@ $(?<=^(a))	a	y	$1	a
 ([\w:]+::)?(\w+)$	abcd	y	$1-$2	-abcd
 ([\w:]+::)?(\w+)$	xy:z:::abcd	y	$1-$2	xy:z:::-abcd
 ^[^bcd]*(c+)	aexycd	y	$1	c
-(?{$a=2})a*aa(?{local$a=$a+1})k*c(?{$b=$a})	yaaxxaaaacd	y	$b	3
-(?{$a=2})(a(?{local$a=$a+1}))*aak*c(?{$b=$a})	yaaxxaaaacd	y	$b	4
+(?{$a=2})a*aa(?{local$a=$a+1})k*c(?{$b=$a})	yaaxxaaaacd	yt	$b	3	threads confuse eval
+(?{$a=2})(a(?{local$a=$a+1}))*aak*c(?{$b=$a})	yaaxxaaaacd	yt	$b	4	threads confuse eval
 (>a+)ab	aaab	n	-	-
 (?>a+)b	aaab	y	-	-
 ([[:]+)	a:[b]:	y	$1	:[
@@ -817,7 +817,7 @@ abb$	b\nca	n	-	-
 'abb$'m	b\nca	n	-	-
 (^|x)(c)	ca	y	$2	c
 a*abc?xyz+pqr{3}ab{2,}xy{4,5}pq{0,6}AB{0,}zz	x	n	-	-
-a(?{$a=2;$b=3;($b)=$a})b	yabz	y	$b	2
+a(?{$a=2;$b=3;($b)=$a})b	yabz	yt	$b	2	threads confuse eval
 round\(((?>[^()]+))\)	_I(round(xs * sz),1)	y	$1	xs * sz
 '((?x:.) )'	x 	y	$1-	x -
 '((?-x:.) )'x	x 	y	$1-	x-
@@ -896,7 +896,7 @@ tt+$	xxxtt	y	-	-
 (abc)?(abc)+	abc	y	$1:$2	:abc	-
 'b\s^'m	a\nb\n	n	-	-
 \ba	a	y	-	-
-^(a(??{"(?!)"})|(a)(?{1}))b	ab	y	$2	a	# [ID 20010811.006]
+^(a(??{"(?!)"})|(a)(?{1}))b	ab	yt	$2	a	# [ID 20010811.006]	threads confuse eval
 ab(?i)cd	AbCd	n	-	-	# [ID 20010809.023]
 ab(?i)cd	abCd	y	-	-
 (A|B)*(?(1)(CD)|(CD))	CD	y	$2-$3	-CD
@@ -941,7 +941,7 @@ ab(?i)cd	abCd	y	-	-
 (.*?)(?<=[bc])	abcd	y	$1	ab
 (.*?)(?<=[bc])c	abcd	y	$1	ab
 2(]*)?$\1	2	y	$&	2
-(??{})	x	y	-	-
+(??{})	x	yt	-	-	threads confuse eval
 a(b)??	abc	y	<$1>	<>	# undef [perl #16773]
 (\d{1,3}\.){3,}	128.134.142.8	y	<$1>	<142.>	# [perl #18019]
 ^.{3,4}(.+)\1\z	foobarbar	y	$1	bar	# 16 tests for [perl #23171]
@@ -974,8 +974,8 @@ x(?#	x	c	-	Sequence (?#... not terminated
 (x.|foo|fool|x.|money|parted|y.)$	fools	n	-	-
 (foo|fool|money|parted)$	fools	n	-	-
 (a|aa|aaa||aaaa|aaaaa|aaaaaa)(b|c)	aaaaaaaaaaaaaaab	y	$1$2	aaaaaab
-(a|aa|aaa||aaaa|aaaaa|aaaaaa)(??{$1&&""})(b|c)	aaaaaaaaaaaaaaab	y	$1$2	aaaaaab
-(a|aa|aaa|aaaa|aaaaa|aaaaaa)(??{$1&&"foo"})(b|c)	aaaaaaaaaaaaaaab	n	-	-
+(a|aa|aaa||aaaa|aaaaa|aaaaaa)(??{$1&&""})(b|c)	aaaaaaaaaaaaaaab	yt	$1$2	aaaaaab	threads confuse eval
+(a|aa|aaa|aaaa|aaaaa|aaaaaa)(??{$1&&"foo"})(b|c)	aaaaaaaaaaaaaaab	nt	-	-	threads confuse eval
 ^(a*?)(?!(aa|aaaa)*$)	aaaaaaaaaaaaaaaaaaaa	y	$1	a	# [perl #34195]
 ^(a*?)(?!(aa|aaaa)*$)(?=a\z)	aaaaaaaa	y	$1	aaaaaaa
 ^(.)\s+.$(?(1))	A B	y	$1	A	# [perl #37688]
@@ -1019,18 +1019,18 @@ X(?=foo)	..XfooY..	y	pos	3
 X(?<=foo.)[YZ]	..XfooXY..	y	pos	8
 (?=XY*foo)	Xfoo	y	pos	0
 ^(?=XY*foo)	Xfoo	y	pos	0
-^(??{"a+"})a	aa	y	$&	aa
-^(?:(??{"a+"})|b)a	aa	y	$&	aa
-^(??{chr 0x100}).$	\x{100}\x{100}	y	$&	\x{100}\x{100}
-^(??{q(\x{100})}).	\x{100}\x{100}	y	$&	\x{100}\x{100}
-^(??{q(.+)})\x{100}	\x{100}\x{100}	y	$&	\x{100}\x{100}
-^(??{q(.)})\x{100}	\x{100}\x{100}	y	$&	\x{100}\x{100}
-^(??{chr 0x100})\xbb	\x{100}\x{bb}	y	$&	\x{100}\x{bb}
-^(.)(??{"(.)(.)"})(.)$	abcd	y	$1-$2	a-d
-^(.)(??{"(bz+|.)(.)"})(.)$	abcd	y	$1-$2	a-d
-^(.)((??{"(.)(cz+)"})|.)	abcd	y	$1-$2	a-b
-^a(?>(??{q(b)}))(??{q(c)})d	abcd	y	-	-
-^x(??{""})+$	x	y	$&	x
+^(??{"a+"})a	aa	yt	$&	aa	threads confuse eval
+^(?:(??{"a+"})|b)a	aa	yt	$&	aa	threads confuse eval
+^(??{chr 0x100}).$	\x{100}\x{100}	yt	$&	\x{100}\x{100}	threads confuse eval
+^(??{q(\x{100})}).	\x{100}\x{100}	yt	$&	\x{100}\x{100}	threads confuse eval
+^(??{q(.+)})\x{100}	\x{100}\x{100}	yt	$&	\x{100}\x{100}	threads confuse eval
+^(??{q(.)})\x{100}	\x{100}\x{100}	yt	$&	\x{100}\x{100}	threads confuse eval
+^(??{chr 0x100})\xbb	\x{100}\x{bb}	yt	$&	\x{100}\x{bb}	threads confuse eval
+^(.)(??{"(.)(.)"})(.)$	abcd	yt	$1-$2	a-d	threads confuse eval
+^(.)(??{"(bz+|.)(.)"})(.)$	abcd	yt	$1-$2	a-d	threads confuse eval
+^(.)((??{"(.)(cz+)"})|.)	abcd	yt	$1-$2	a-b	threads confuse eval
+^a(?>(??{q(b)}))(??{q(c)})d	abcd	yt	-	-	threads confuse eval
+^x(??{""})+$	x	yt	$&	x	threads confuse eval
 ^(<(?:[^<>]+|(?3)|(?1))*>)()(!>!>!>)$	<<!>!>!>><>>!>!>!>	y	$1	<<!>!>!>><>>
 ^(<(?:[^<>]+|(?1))*>)$	<<><<<><>>>>	y	$1	<<><<<><>>>>
 ((?2)*)([fF]o+)	fooFoFoo	y	$1-$2	fooFo-Foo
@@ -1040,13 +1040,13 @@ X(?<=foo.)[YZ]	..XfooXY..	y	pos	8
 (?<n>foo|bar|baz)(?<m>[ew]+)	snofooewa	y	$+{n}	foo
 (?<n>foo|bar|baz)(?<m>[ew]+)	snofooewa	y	$+{m}	ew
 (?<n>foo)|(?<n>bar)|(?<n>baz)	snofooewa	y	$+{n}	foo
-(?<n>foo)(??{ $+{n} })	snofooefoofoowaa	y	$+{n}	foo
+(?<n>foo)(??{ $+{n} })	snofooefoofoowaa	yt	$+{n}	foo	threads confuse eval
 (?P<n>foo|bar|baz)	snofooewa	y	$1	foo
 (?P<n>foo|bar|baz)	snofooewa	y	$+{n}	foo
 (?P<n>foo|bar|baz)(?P<m>[ew]+)	snofooewa	y	$+{n}	foo
 (?P<n>foo|bar|baz)(?P<m>[ew]+)	snofooewa	y	$+{m}	ew
 (?P<n>foo)|(?P<n>bar)|(?P<n>baz)	snofooewa	y	$+{n}	foo
-(?P<n>foo)(??{ $+{n} })	snofooefoofoowaa	y	$+{n}	foo
+(?P<n>foo)(??{ $+{n} })	snofooefoofoowaa	yt	$+{n}	foo	threads confuse eval
 (?P<=n>foo|bar|baz)	snofooewa	c	-	Sequence (?P<=...) not recognized
 (?P<!n>foo|bar|baz)	snofooewa	c	-	Sequence (?P<!...) not recognized
 (?PX<n>foo|bar|baz)	snofooewa	c	-	Sequence (?PX<...) not recognized
@@ -1055,7 +1055,7 @@ X(?<=foo.)[YZ]	..XfooXY..	y	pos	8
 /(?'n'foo|bar|baz)(?'m'[ew]+)/	snofooewa	y	$+{n}	foo
 /(?'n'foo|bar|baz)(?'m'[ew]+)/	snofooewa	y	$+{m}	ew
 /(?'n'foo)|(?'n'bar)|(?<n>baz)/	snobazewa	y	$+{n}	baz
-/(?'n'foo)(??{ $+{n} })/	snofooefoofoowaa	y	$+{n}	foo
+/(?'n'foo)(??{ $+{n} })/	snofooefoofoowaa	yt	$+{n}	foo	threads confuse eval
 /(?'n'foo)\k<n>/	..foofoo..	y	$1	foo
 /(?'n'foo)\k<n>/	..foofoo..	y	$+{n}	foo
 /(?<n>foo)\k'n'/	..foofoo..	y	$1	foo
@@ -1295,7 +1295,7 @@ X(\w+)(?=\s)|X(\w+)	Xab	y	[$1-$2]	[-ab]
 #Bug #41492
 (?(DEFINE)(?<A>(?&B)+)(?<B>a))(?&A)	a	y	$&	a
 (?(DEFINE)(?<A>(?&B)+)(?<B>a))(?&A)	aa	y	$&	aa
-\x{100}?(??{""})xxx	xxx	y	$&	xxx
+\x{100}?(??{""})xxx	xxx	yt	$&	xxx	threads confuse eval
 
 foo(\R)bar	foo\r\nbar	y	$1	\r\n
 foo(\R)bar	foo\nbar	y	$1	\n
diff --git a/t/op/reg_email.t b/t/op/reg_email.t
index c53dd82860..177820c222 100644
--- a/t/op/reg_email.t
+++ b/t/op/reg_email.t
@@ -66,13 +66,18 @@ my $email = qr {
     (?&address)
 }x;
 
-my $count = 0;
 
-$| = 1;
-while (<DATA>) {
-    chomp;
-    next if /^#/;
-    print /^$email$/ ? "ok " : "not ok ", ++ $count, "\n";
+run_tests() unless caller;
+
+sub run_tests {
+    my $count = 0;
+
+    $| = 1;
+    while (<DATA>) {
+	chomp;
+	next if /^#/;
+	print /^$email$/ ? "ok " : "not ok ", ++ $count, "\n";
+    }
 }
 
 #
diff --git a/t/op/reg_email_thr.t b/t/op/reg_email_thr.t
new file mode 100644
index 0000000000..8eafc0588d
--- /dev/null
+++ b/t/op/reg_email_thr.t
@@ -0,0 +1,7 @@
+#!./perl
+
+chdir 't' if -d 't';
+@INC = ('../lib', '.');
+
+require 'thread_it.pl';
+thread_it(qw(op reg_email.t));
diff --git a/t/op/regexp.t b/t/op/regexp.t
index 8a13dd2158..793a474d3f 100755
--- a/t/op/regexp.t
+++ b/t/op/regexp.t
@@ -15,6 +15,7 @@
 # 	c	expect an error
 #	B	test exposes a known bug in Perl, should be skipped
 #	b	test exposes a known bug in Perl, should be skipped if noamp
+#	t	test exposes a bug with threading, TODO if qr_embed_thr
 #
 # Columns 4 and 5 are used only if column 3 contains C<y> or C<c>.
 #
@@ -49,12 +50,25 @@ BEGIN {
 
     chdir 't' if -d 't';
     @INC = '../lib';
+
+    if ($qr_embed_thr) {
+	require Config;
+	if (!$Config::Config{useithreads}) {
+	    print "1..0 # Skip: no ithreads\n";
+		exit 0;
+	}
+	if ($ENV{PERL_CORE_MINITEST}) {
+	    print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
+		exit 0;
+	}
+	require threads;
+    }
 }
 
 use strict;
 use warnings FATAL=>"all";
 use vars qw($iters $numtests $bang $ffff $nulnul $OP);
-use vars qw($qr $skip_amp $qr_embed); # set by our callers
+use vars qw($qr $skip_amp $qr_embed $qr_embed_thr); # set by our callers
 
 
 if (!defined $file) {
@@ -73,6 +87,7 @@ $OP = $qr ? 'qr' : 'm';
 
 $| = 1;
 printf "1..%d\n# $iters iterations\n", scalar @tests;
+
 my $test;
 TEST:
 foreach (@tests) {
@@ -93,6 +108,7 @@ foreach (@tests) {
     $subject = eval qq("$subject"); die $@ if $@;
     $expect  = eval qq("$expect"); die $@ if $@;
     $expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/;
+    my $todo = $qr_embed_thr && ($result =~ s/t//);
     my $skip = ($skip_amp ? ($result =~ s/B//i) : ($result =~ s/B//));
     $reason = 'skipping $&' if $reason eq  '' && $skip_amp;
     $result =~ s/B//i unless $skip;
@@ -120,6 +136,16 @@ EOFCODE
                 \$got = "$repl";
 EOFCODE
         }
+        elsif ($qr_embed_thr) {
+            $code= <<EOFCODE;
+		# Can't run the match in a subthread, but can do this and
+	 	# clone the pattern the other way.
+                my \$RE = threads->new(sub {qr$pat})->join();
+                $study;
+                \$match = (\$subject =~ /(?:)\$RE(?:)/) while \$c--;
+                \$got = "$repl";
+EOFCODE
+        }
         else {
             $code= <<EOFCODE;
                 $study;
@@ -146,10 +172,14 @@ EOFCODE
 	    print "ok $test # skipped", length($reason) ? " $reason" : '', "\n";
 	    next TEST;
 	}
+	elsif ( $todo ) {
+	    print "not ok $test # todo", length($reason) ? " - $reason" : '', "\n";
+	    next TEST;
+	}
 	elsif ($@) {
 	    print "not ok $test $input => error `$err'\n$code\n$@\n"; next TEST;
 	}
-	elsif ($result eq 'n') {
+	elsif ($result =~ /^n/) {
 	    if ($match) { print "not ok $test ($study) $input => false positive\n"; next TEST }
 	}
 	else {
diff --git a/t/op/regexp_qr_embed_thr.t b/t/op/regexp_qr_embed_thr.t
new file mode 100644
index 0000000000..4f91bd4f2c
--- /dev/null
+++ b/t/op/regexp_qr_embed_thr.t
@@ -0,0 +1,11 @@
+#!./perl
+
+$qr = 1;
+$qr_embed_thr = 1;
+for $file ('./op/regexp.t', './t/op/regexp.t', ':op:regexp.t') {
+    if (-r $file) {
+	do $file or die $@;
+	exit;
+    }
+}
+die "Cannot find ./op/regexp.t or ./t/op/regexp.t\n";
diff --git a/t/op/substr.t b/t/op/substr.t
index 40f87662e3..81c87be87b 100755
--- a/t/op/substr.t
+++ b/t/op/substr.t
@@ -25,6 +25,12 @@ require './test.pl';
 
 plan(334);
 
+run_tests() unless caller;
+
+my $krunch = "a";
+
+sub run_tests {
+
 $FATAL_MSG = qr/^substr outside of string/;
 
 is(substr($a,0,3), 'abc');   # P=Q R S
@@ -643,11 +649,10 @@ is($x, "\x{100}\x{200}\xFFb");
 # [perl #24200] string corruption with lvalue sub
 
 {
-    my $foo = "a";
-    sub bar: lvalue { substr $foo, 0 }
+    sub bar: lvalue { substr $krunch, 0 }
     bar = "XXX";
     is(bar, 'XXX');
-    $foo = '123456789';
+    $krunch = '123456789';
     is(bar, '123456789');
 }
 
@@ -675,3 +680,5 @@ is($x, "\x{100}\x{200}\xFFb");
     is(substr($a,1,2), 'bc');
     is(substr($a,1,1), 'b');
 }
+
+}
diff --git a/t/op/substr_thr.t b/t/op/substr_thr.t
new file mode 100644
index 0000000000..babb48d8ec
--- /dev/null
+++ b/t/op/substr_thr.t
@@ -0,0 +1,7 @@
+#!./perl
+
+chdir 't' if -d 't';
+@INC = ('../lib', '.');
+
+require 'thread_it.pl';
+thread_it(qw(op substr.t));
diff --git a/t/thread_it.pl b/t/thread_it.pl
new file mode 100644
index 0000000000..feec254664
--- /dev/null
+++ b/t/thread_it.pl
@@ -0,0 +1,39 @@
+#!perl
+use strict;
+use warnings;
+
+use Config;
+if (!$Config{useithreads}) {
+    print "1..0 # Skip: no ithreads\n";
+    exit 0;
+}
+if ($ENV{PERL_CORE_MINITEST}) {
+    print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
+    exit 0;
+}
+
+require threads;
+
+sub thread_it {
+    # Generate things like './op/regexp.t', './t/op/regexp.t', ':op:regexp.t'
+    my @paths
+	= (join ('/', '.', @_), join ('/', '.', 't', @_), join (':', @_));
+		 
+    for my $file (@paths) {
+	if (-r $file) {
+	    print "# found tests in $file\n";
+	    $::running_as_thread = "running tests in a new thread";
+	    do $file or die $@;
+	    print "# running tests in a new thread\n";
+	    my $curr = threads->create(sub {
+		run_tests();
+		return defined &curr_test ? curr_test() : ()
+	    })->join();
+	    curr_test($curr) if defined $curr;
+	    exit;
+	}
+    }
+    die "Cannot find " . join (" or ", @paths) . "\n";
+}
+
+1;