Integrate:

[ 22186]
Add a new test file for situations where threads may interfere.
Subject: Re: "restricted hashes" hit again !
From: Stas Bekman <stas@stason.org>
Date: Tue, 23 Dec 2003 15:32:26 -0800
Message-ID: <3FE8D08A.4090806@stason.org>

[ 25920]
Coverage stats showed that there were no tests for taking a slice
from ().

[ 25922]
Tests for index/rindex with empty search string,
adapted from a patch by Rick Delaney

[ 25949]
Lowercase barewords considered harmful to your health.

[ 25950]
Ambiguous test cases may be hazardous to your health.

[ 25965]
Test case should not execute /no_such_process if it does exist.

[ 25967]
Clean up some test files.

[ 25974]
Add appropriate skips to t/io/fs.t to fix test failures on Cygwin.

[ 26045]
From: SADAHIRO Tomoyuki <bqw10602@nifty.com>
Subject: Re: A surprising segfault
Date: Tue, 08 Nov 2005 23:36:13 +0900
Message-Id: <20051108233535.735D.BQW10602@nifty.com>

[ 26079]
Subject: [PATCH] Suppress leaked warnings in ExtUtils tests
From: Dominic Dunlop <domo@computer.org>
Date: Thu, 10 Nov 2005 18:10:00 +0100
Message-Id: <D2949A21-7EE3-449F-BEF2-38FAD7B4A483@computer.org>

[ 26183]
Thread failures on AIX (and others) caused by interleaved output

Subject: Smoke [5.9.3] 26168 FAIL(X) AIX 4.3.3.0/ML11 (PPC/1 cpu)
From: "H.Merijn Brand" <h.m.brand@xs4all.nl>
Date: Sun, 20 Nov 2005 14:36 +0100
Message-Id: <200511201337.jAKDbc1O066213@smtp-vbr6.xs4all.nl>

[ 26186]
Subject: patch@26180 - t/op/array.t : Can't reset %ENV on VMS
From: "John E. Malmberg" <wb8tyw@qsl.net>
Date: Mon, 21 Nov 2005 21:19:31 -0500
Message-ID: <43828033.9040708@qsl.net>

[ 26187]
Subject: patch@26180 - t/op/pat.t : Can't reset %ENV on VMS
From: "John E. Malmberg" <wb8tyw@qsl.net>
Date: Mon, 21 Nov 2005 22:09:17 -0500
Message-ID: <43828BDD.7080302@qsl.net>

[ 26197]
Note the URL describing the vast riches awaiting us.

[ 26323]
Move the $data and $result munging into the test preparation loop.

[ 26324]
Move the rest of the data munging into the test preparation loop.

[ 26398]
TODO-SKIP tests must be "not ok", or else the test harness will think
it's an unexpected success

Subject: Re: Change 26165 broke ext/threads/t/stress_re.t test on Win32 (and patch to t/test.pl and/or Test::Harness)
From: demerphq <demerphq@gmail.com>
Date: Sat, 17 Dec 2005 17:23:23 +0100
Message-ID: <9b18b3110512170823q1bb2cd27h838b4d4dcdba72c9@mail.gmail.com>

[ 26428]
Remove some hardcoded references to ./perl in tests

[ 26469]
like and unlike weren't reporting failure where correctly in test.pl

[ 26543]
Convert t/op/sleep.t to using test.pl
p4raw-link: @26543 on //depot/perl: f9e4a5e8b675d9f0b82120fd33801982344ad4ca
p4raw-link: @26469 on //depot/perl: 8fb276b815a6ad571450952d0012113a8db9e3f4
p4raw-link: @26428 on //depot/perl: c8d62b7117d70c1e6d3a6c3c41603445934b9a83
p4raw-link: @26398 on //depot/perl: a27e4e7f280a6900800142247279c369dc3b8673
p4raw-link: @26324 on //depot/perl: 57c348a981665d6305f7f38920ab85e57a77ae65
p4raw-link: @26323 on //depot/perl: 0a52d15ba5fbf8c2d2178fca6186b8b527a2e596
p4raw-link: @26197 on //depot/perl: 983d1c140ccc5a6746b60b1d15f8f50901ff7b51
p4raw-link: @26187 on //depot/perl: 1606b0c75b28d460075c09d3a6b2203fda3d6db3
p4raw-link: @26186 on //depot/perl: 14ce8c55775aeffb1a1bfc5e3d60b3e29b1aab67
p4raw-link: @26183 on //depot/perl: 5769096374a9658adfca59be4bba59ad77acf00b
p4raw-link: @26079 on //depot/perl: 6e908d91c0cee96c2ca2c5cfebad8cdcb01a656e
p4raw-link: @26045 on //depot/perl: 1937c63eabbbeefba39986529a3c98e62f3dcab4
p4raw-link: @25974 on //depot/perl: b0fdffbddaf257157ac815b3869f2328fc8ab9a0
p4raw-link: @25967 on //depot/perl: 1031ca5cb29f226276d55908e55745187e79d1c8
p4raw-link: @25965 on //depot/perl: 38efdb82c659a45925093d890b9a6cb896cb9c47
p4raw-link: @25950 on //depot/perl: 7f6b17e490f2974227b30f0c61ca2e8729fa877f
p4raw-link: @25949 on //depot/perl: d5fc3e7087d5aeade68cb64da300c8b07e550cc2
p4raw-link: @25922 on //depot/perl: 46f1e5955033fcc63907c341337e8cc34722edf0
p4raw-link: @25920 on //depot/perl: 59abd33597c479b9e5620fa06c6c6a9f2917f858
p4raw-link: @22186 on //depot/perl: f935b2f67f1c88a353de5d1c0f7792d9812d8f31

p4raw-id: //depot/maint-5.8/perl@26697
p4raw-branched: from //depot/perl@26696 'branch in' t/op/threads.t
	(@25953..)
p4raw-integrated: from //depot/perl@26696 'copy in' t/io/argv.t
	(@20175..) lib/ExtUtils/t/Manifest.t (@21652..) t/op/sleep.t
	(@23206..) lib/ExtUtils/t/Command.t (@23653..) t/op/index.t
	(@23782..) t/io/dup.t (@25139..) t/op/chop.t (@25158..)
	t/op/magic.t (@25336..) t/io/crlf_through.t t/io/through.t
	(@25618..) t/test.pl (@26398..) 'edit in' t/op/closure.t
	(@25284..) 'merge in' t/run/runenv.t (@22741..) t/op/array.t
	(@25808..) t/io/print.t (@25973..) t/op/sort.t (@25992..)
p4raw-integrated: from //depot/perl@26323 'edit in' t/op/sprintf.t
	(@26321..)
p4raw-integrated: from //depot/perl@26197 'merge in' t/lib/1_compile.t
	(@22948..)
p4raw-integrated: from //depot/perl@26187 'merge in' t/op/pat.t
	(@25998..)
p4raw-integrated: from //depot/perl@25974 'edit in' t/io/fs.t
	(@25951..)
p4raw-integrated: from //depot/perl@25967 'copy in' t/io/layers.t
	(@24764..)
p4raw-integrated: from //depot/perl@25965 'copy in' t/io/pipe.t
	(@13535..)
p4raw-integrated: from //depot/perl@25920 'ignore' t/op/list.t
	(@23145..)
p4raw-integrated: from //depot/perl@22186 'merge in' MANIFEST
	(@22168..)

22 files changed, 252 insertions, 61 deletions

diff --git a/t/io/argv.t b/t/io/argv.t
index 33c4f1a8e7..8a63c65833 100755
--- a/t/io/argv.t
+++ b/t/io/argv.t
@@ -72,7 +72,10 @@ undef $^I;
 
 ok( eof TRY );
 
-ok( eof NEVEROPENED,    'eof() true on unopened filehandle' );
+{
+    no warnings 'once';
+    ok( eof NEVEROPENED,    'eof() true on unopened filehandle' );
+}
 
 open STDIN, 'Io_argv1.tmp' or die $!;
 @ARGV = ();
diff --git a/t/io/crlf_through.t b/t/io/crlf_through.t
index 3a5522a76e..c08099598e 100644
--- a/t/io/crlf_through.t
+++ b/t/io/crlf_through.t
@@ -5,5 +5,6 @@ BEGIN {
     @INC = '../lib';
 }
 
+no warnings 'once';
 $main::use_crlf = 1;
 do './io/through.t' or die "no kid script";
diff --git a/t/io/dup.t b/t/io/dup.t
index 8247b8e6ef..48497fd232 100755
--- a/t/io/dup.t
+++ b/t/io/dup.t
@@ -7,6 +7,7 @@ BEGIN {
 }
 
 use Config;
+no warnings 'once';
 
 my $test = 1;
 print "1..26\n";
diff --git a/t/io/fs.t b/t/io/fs.t
index f1d5fc453b..f372d97abc 100755
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -47,7 +47,7 @@ $needs_fh_reopen = 1 if (defined &Win32::IsWin95 && Win32::IsWin95());
 my $skip_mode_checks =
     $^O eq 'cygwin' && $ENV{CYGWIN} !~ /ntsec/;
 
-plan tests => 42;
+plan tests => 44;
 
 
 if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) {
@@ -78,10 +78,10 @@ SKIP: {
     is((umask(0)&0777), 022, 'umask'),
 }
 
-open(fh,'>x') || die "Can't create x";
-close(fh);
-open(fh,'>a') || die "Can't create a";
-close(fh);
+open(FH,'>x') || die "Can't create x";
+close(FH);
+open(FH,'>a') || die "Can't create a";
+close(FH);
 
 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks);
@@ -171,10 +171,16 @@ SKIP: {
     ok(open(my $fh, "<", "a"), "open a");
     is(chmod(0, $fh), 1, "fchmod");
     $mode = (stat "a")[2];
-    is($mode & 0777, 0, "perm reset");
+    SKIP: {
+        skip "no mode checks", 1 if $skip_mode_checks;
+        is($mode & 0777, 0, "perm reset");
+    }
     is(chmod($newmode, "a"), 1, "fchmod");
     $mode = (stat $fh)[2];
-    is($mode & 0777, $newmode, "perm restored");
+    SKIP: { 
+        skip "no mode checks", 1 if $skip_mode_checks;
+        is($mode & 0777, $newmode, "perm restored");
+    }
 }
 
 SKIP: {
@@ -380,8 +386,8 @@ SKIP: {
       if $^O eq 'cygwin';
 
     chdir './tmp';
-    open(fh,'>x') || die "Can't create x";
-    close(fh);
+    open(FH,'>x') || die "Can't create x";
+    close(FH);
     rename('x', 'X');
 
     # this works on win32 only, because fs isn't casesensitive
@@ -403,5 +409,16 @@ if ($^O eq 'VMS') {
 
 ok(-d 'tmp1', "rename on directories working");
 
+{
+    # Change 26011: Re: A surprising segfault
+    # to make sure only that these obfuscated sentences will not crash.
+
+    map chmod(+()), ('')x68;
+    ok(1, "extend sp in pp_chmod");
+
+    map chown(+()), ('')x68;
+    ok(1, "extend sp in pp_chown");
+}
+
 # need to remove 'tmp' if rename() in test 28 failed!
 END { rmdir 'tmp1'; rmdir 'tmp'; 1 while unlink "Iofs.tmp"; }
diff --git a/t/io/layers.t b/t/io/layers.t
index 5fcb4f633f..62f77e864a 100644
--- a/t/io/layers.t
+++ b/t/io/layers.t
@@ -40,6 +40,8 @@ if (${^UNICODE} & 1) {
 	# Unconditional
 	$UNICODE_STDIN = 1;
     }
+} else {
+    $UNICODE_STDIN = 0;
 }
 my $NTEST = 44 - (($DOSISH || !$FASTSTDIO) ? 7 : 0) - ($DOSISH ? 5 : 0)
     + $UNICODE_STDIN;
diff --git a/t/io/pipe.t b/t/io/pipe.t
index c32f3b1046..fd355124fe 100755
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -182,7 +182,8 @@ is($?, 42,      'status unaffected by implicit close');
 $? = 0;
 
 # check that child is reaped if the piped program can't be executed
-{
+SKIP: {
+  skip "/no_such_process exists", 1 if -e "/no_such_process";
   open NIL, '/no_such_process |';
   close NIL;
 
diff --git a/t/io/print.t b/t/io/print.t
index 31d559aac9..65c7117404 100755
--- a/t/io/print.t
+++ b/t/io/print.t
@@ -9,7 +9,7 @@ use strict 'vars';
 eval 'use Errno';
 die $@ if $@ and !$ENV{PERL_CORE_MINITEST};
 
-print "1..19\n";
+print "1..21\n";
 
 my $foo = 'STDOUT';
 print $foo "ok 1\n";
@@ -52,3 +52,15 @@ if (!exists &Errno::EBADF) {
     print "not " if ($! != &Errno::EBADF);
     print "ok 19\n";
 }
+
+{
+    # Change 26009: pp_print didn't extend the stack
+    #               before pushing its return value
+    # to make sure only that these obfuscated sentences will not crash.
+
+    map print(reverse), ('')x68;
+    print "ok 20\n";
+
+    map print(+()), ('')x68;
+    print "ok 21\n";
+}
diff --git a/t/io/through.t b/t/io/through.t
index d664b08a18..9c8a627f9d 100644
--- a/t/io/through.t
+++ b/t/io/through.t
@@ -34,7 +34,8 @@ $c += 6;	# Tests with sleep()...
 print "1..$c\n";
 
 my $set_out = '';
-$set_out = "binmode STDOUT, ':crlf'" if $main::use_crlf = 1;
+$set_out = "binmode STDOUT, ':crlf'"
+    if defined  $main::use_crlf && $main::use_crlf == 1;
 
 sub testread ($$$$$$$) {
   my ($fh, $str, $read_c, $how_r, $write_c, $how_w, $why) = @_;
@@ -76,7 +77,8 @@ sub testpipe ($$$$$$) {
   } else {
     die "Unrecognized write: '$how_w'";
   }
-  binmode $fh, ':crlf' if $main::use_crlf = 1;
+  binmode $fh, ':crlf'
+      if defined $main::use_crlf && $main::use_crlf == 1;
   testread($fh, $str, $read_c, $how_r, $write_c, $how_w, "pipe$why");
 }
 
@@ -86,7 +88,8 @@ sub testfile ($$$$$$) {
 
   open my $fh, '>', 'io_io.tmp' or die;
   select $fh;
-  binmode $fh, ':crlf' if $main::use_crlf = 1;
+  binmode $fh, ':crlf' 
+      if defined $main::use_crlf && $main::use_crlf == 1;
   if ($how_w eq 'print') {	# AUTOFLUSH???
     $| = 0;
     print $fh $_ for @data;
@@ -100,7 +103,8 @@ sub testfile ($$$$$$) {
   }
   close $fh or die "close: $!";
   open $fh, '<', 'io_io.tmp' or die;
-  binmode $fh, ':crlf' if $main::use_crlf = 1;
+  binmode $fh, ':crlf'
+      if defined $main::use_crlf && $main::use_crlf == 1;
   testread($fh, $str, $read_c, $how_r, $write_c, $how_w, "file$why");
 }
 
@@ -109,7 +113,8 @@ open my $fh, '-|', qq[$Perl -we "eval qq(\\x24\\x7c = 1) or die; binmode STDOUT;
 ok(1, 'open pipe');
 binmode $fh, q(:crlf);
 ok(1, 'binmode');
-my (@c, $c);
+$c = undef;
+my @c;
 push @c, ord $c while $c = getc $fh;
 ok(1, 'got chars');
 is(scalar @c, 9, 'got 9 chars');
diff --git a/t/lib/1_compile.t b/t/lib/1_compile.t
index 9c37830166..ee65b55810 100644
--- a/t/lib/1_compile.t
+++ b/t/lib/1_compile.t
@@ -40,6 +40,10 @@ if (@Core_Modules) {
 } else {
   print $message;
 }
+print <<'EOREWARD';
+# http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-04/msg01223.html
+# 20010421230349.P2946@blackrider.blackstar.co.uk
+EOREWARD
 
 my $test_num = 2;
 
diff --git a/t/op/array.t b/t/op/array.t
index 956a934290..64c0ad4969 100755
--- a/t/op/array.t
+++ b/t/op/array.t
@@ -61,7 +61,7 @@ is($r, "0,0");
 $bar[2] = '2';
 $r = join(',', $#bar, @bar);
 is($r, "2,0,,2");
-reset 'b';
+reset 'b' if $^O ne 'VMS';
 @bar = ();
 $bar[0] = '0';
 $r = join(',', $#bar, @bar);
diff --git a/t/op/chop.t b/t/op/chop.t
index a77ff30b6c..b0308b0902 100755
--- a/t/op/chop.t
+++ b/t/op/chop.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 137;
+plan tests => 139;
 
 $_ = 'abc';
 $c = do foo();
@@ -232,3 +232,14 @@ foreach my $start (@chars) {
     is($asc, "perl", "chopped ascii NUL");
     is($utf, "perl", "chopped utf8 NUL");
 }
+
+{
+    # Change 26011: Re: A surprising segfault
+    # to make sure only that these obfuscated sentences will not crash.
+
+    map chop(+()), ('')x68;
+    ok(1, "extend sp in pp_chop");
+
+    map chomp(+()), ('')x68;
+    ok(1, "extend sp in pp_chomp");
+}
diff --git a/t/op/closure.t b/t/op/closure.t
index de9e102a7f..340618046c 100755
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -12,6 +12,7 @@ BEGIN {
 }
 
 use Config;
+require './test.pl'; # for runperl()
 
 print "1..187\n";
 
@@ -446,8 +447,8 @@ END
 	      close READ2;
 	      open STDOUT, ">&WRITE"  or die "Can't redirect STDOUT: $!";
 	      open STDERR, ">&WRITE2" or die "Can't redirect STDERR: $!";
-	      exec './perl', '-w', '-'
-		or die "Can't exec ./perl: $!";
+	      exec which_perl(), '-w', '-'
+		or die "Can't exec perl: $!";
 	    } else {
 	      # Parent process here.
 	      close WRITE;
@@ -466,11 +467,7 @@ END
 	    my $errfile = "terr$$";  $errfile++ while -e $errfile;
 	    my @tmpfiles = ($cmdfile, $errfile);
 	    open CMD, ">$cmdfile"; print CMD $code; close CMD;
-	    my $cmd = (($^O eq 'VMS') ? "MCR $^X"
-		       : ($^O eq 'MSWin32') ? '.\perl'
-		       : ($^O eq 'MacOS') ? $^X
-		       : ($^O eq 'NetWare') ? 'perl'
-		       : './perl');
+	    my $cmd = which_perl();
 	    $cmd .= " -w $cmdfile 2>$errfile";
 	    if ($^O eq 'VMS' or $^O eq 'MSWin32' or $^O eq 'NetWare') {
 	      # Use pipe instead of system so we don't inherit STD* from
@@ -614,8 +611,6 @@ SKIP: { skip("tests not in 5.8.", 3) }
 
 $test= 185;
 
-require './test.pl'; # for runperl()
-
 {
    # bugid #23265 - this used to coredump during destruction of PL_maincv
    # and its children
diff --git a/t/op/index.t b/t/op/index.t
index d223265c4f..100439d15e 100755
--- a/t/op/index.t
+++ b/t/op/index.t
@@ -7,7 +7,7 @@ BEGIN {
 
 use strict;
 require './test.pl';
-plan( tests => 46 );
+plan( tests => 58 );
 
 my $foo = 'Now is the time for all good men to come to the aid of their country.';
 
@@ -45,6 +45,20 @@ is(rindex("ababa","a",3), 2);
 is(rindex("ababa","a",4), 4);
 is(rindex("ababa","a",5), 4);
 
+# tests for empty search string
+is(index("abc", "", -1), 0);
+is(index("abc", "", 0), 0);
+is(index("abc", "", 1), 1);
+is(index("abc", "", 2), 2);
+is(index("abc", "", 3), 3);
+is(index("abc", "", 4), 3);
+is(rindex("abc", "", -1), 0);
+is(rindex("abc", "", 0), 0);
+is(rindex("abc", "", 1), 1);
+is(rindex("abc", "", 2), 2);
+is(rindex("abc", "", 3), 3);
+is(rindex("abc", "", 4), 3);
+
 $a = "foo \x{1234}bar";
 
 is(index($a, "\x{1234}"), 4);
diff --git a/t/op/list.t b/t/op/list.t
index 89ccf02c10..cdf8cdd4e7 100755
--- a/t/op/list.t
+++ b/t/op/list.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..30\n";
+print "1..31\n";
 
 @foo = (1, 2, 3, 4);
 if ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";}
@@ -95,4 +95,8 @@ for ($x = 0; $x < 3; $x++) {
     @b = (30, scalar @h{()});
     print "not " if join(':',@b) ne '30:';
     print "ok 30\n";
+
+    my $size = scalar(()[1..1]);
+    print "not " if $size != 0;
+    print "ok 31\n";
 }
diff --git a/t/op/magic.t b/t/op/magic.t
index 54be238c7f..b28a082e79 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -49,10 +49,11 @@ $Is_MPE      = $^O eq 'mpeix';
 $Is_miniperl = $ENV{PERL_CORE_MINITEST};
 $Is_BeOS     = $^O eq 'beos';
 
-$PERL = ($Is_NetWare            ? 'perl'   :
-	 ($Is_MacOS || $Is_VMS) ? $^X      :
-	 $Is_MSWin32            ? '.\perl' :
-	 './perl');
+$PERL = $ENV{PERL}
+    || ($Is_NetWare           ? 'perl'   :
+       ($Is_MacOS || $Is_VMS) ? $^X      :
+       $Is_MSWin32            ? '.\perl' :
+       './perl');
 
 eval '$ENV{"FOO"} = "hi there";';	# check that ENV is inited inside eval
 # cmd.exe will echo 'variable=value' but 4nt will echo just the value
diff --git a/t/op/pat.t b/t/op/pat.t
index b4e3f5ee5c..5ba099fde3 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -81,12 +81,21 @@ $XXX{345} = 345;
 while ($_ = shift(@XXX)) {
     ?(.*)? && (print $1,"\n");
     /not/ && reset;
-    /not ok 26/ && reset 'X';
+    if (/not ok 26/) {
+      if ($^O eq 'VMS') {
+	$_ = shift(@XXX);
+      }
+      else {
+	reset 'X';
+      }
+   }
 }
 
-while (($key,$val) = each(%XXX)) {
+if ($^O ne 'VMS') {
+  while (($key,$val) = each(%XXX)) {
     print "not ok 27\n";
     exit;
+  }
 }
 
 print "ok 27\n";
diff --git a/t/op/sleep.t b/t/op/sleep.t
index c2684ad37c..3f5bbe0d3f 100755
--- a/t/op/sleep.t
+++ b/t/op/sleep.t
@@ -1,8 +1,15 @@
 #!./perl
 
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = qw(. ../lib);
+}
+
+require "test.pl";
+plan( tests => 4 );
+
 use strict;
 use warnings;
-use Test::More tests=>4;
 
 my $start = time;
 my $sleep_says = sleep 3;
diff --git a/t/op/sort.t b/t/op/sort.t
index bdb48856b9..be011b64a9 100755
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -14,6 +14,9 @@ print "1..129\n";
     sort { while(1) {}            } @a;
     sort { while(1) { last; }     } @a;
     sort { while(0) { last; }     } @a;
+
+    # Change 26011: Re: A surprising segfault
+    map scalar(sort(+())), ('')x68;
 }
 
 sub Backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0 }
diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index 4130a5a89c..7e3e6c595b 100755
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -12,28 +12,11 @@ BEGIN {
 }
 use warnings;
 use Config;
+use strict;
 
-# strictness
 my @tests = ();
 my ($i, $template, $data, $result, $comment, $w, $x, $evalData, $n, $p);
 
-while (<DATA>) {
-    s/^\s*>//; s/<\s*$//;
-    push @tests, [split(/<\s*>/, $_, 4)];
-}
-
-print '1..', scalar @tests, "\n";
-
-$SIG{__WARN__} = sub {
-    if ($_[0] =~ /^Invalid conversion/) {
-	$w = ' INVALID';
-    } elsif ($_[0] =~ /^Use of uninitialized value/) {
-	$w = ' UNINIT';
-    } else {
-	warn @_;
-    }
-};
-
 my $Is_VMS_VAX = 0;
 # We use HW_MODEL since ARCH_NAME was not in VMS V5.*
 if ($^O eq 'VMS') {
@@ -45,8 +28,9 @@ if ($^O eq 'VMS') {
 # No %Config.
 my $Is_Ultrix_VAX = $^O eq 'ultrix' && `uname -m` =~ /^VAX$/;
 
-for ($i = 1; @tests; $i++) {
-    ($template, $data, $result, $comment) = @{shift @tests};
+while (<DATA>) {
+    s/^\s*>//; s/<\s*$//;
+    ($template, $data, $result, $comment) = split(/<\s*>/, $_, 4);
     if ($^O eq 'os390' || $^O eq 's390') { # non-IEEE (s390 is UTS)
         $data   =~ s/([eE])96$/${1}63/;      # smaller exponents
         $result =~ s/([eE]\+)102$/${1}69/;   #  "       "
@@ -62,10 +46,28 @@ for ($i = 1; @tests; $i++) {
         $data   =~ s/([eE])\-101$/${1}-24/;  # larger exponents
         $result =~ s/([eE])\-102$/${1}-25/;  #  "       "
     }
+
     $evalData = eval $data;
+    $data = ref $evalData ? $evalData : [$evalData];
+    push @tests, [$template, $data, $result, $comment];
+}
+
+print '1..', scalar @tests, "\n";
+
+$SIG{__WARN__} = sub {
+    if ($_[0] =~ /^Invalid conversion/) {
+	$w = ' INVALID';
+    } elsif ($_[0] =~ /^Use of uninitialized value/) {
+	$w = ' UNINIT';
+    } else {
+	warn @_;
+    }
+};
+
+for ($i = 1; @tests; $i++) {
+    ($template, $data, $result, $comment) = @{shift @tests};
     $w = undef;
-    $x = sprintf(">$template<",
-                 defined @$evalData ? @$evalData : $evalData);
+    $x = sprintf(">$template<", @$data);
     substr($x, -1, 0) = $w if $w;
     # $x may have 3 exponent digits, not 2
     my $y = $x;
diff --git a/t/op/threads.t b/t/op/threads.t
new file mode 100644
index 0000000000..7fecba13a6
--- /dev/null
+++ b/t/op/threads.t
@@ -0,0 +1,98 @@
+#!./perl
+BEGIN {
+     chdir 't' if -d 't';
+     @INC = '../lib';
+     require './test.pl';	# for which_perl() etc
+     $| = 1;
+}
+
+use strict;
+use Config;
+
+BEGIN {
+     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;
+     }
+     plan(4);
+}
+use threads;
+
+# test that we don't get:
+# Attempt to free unreferenced scalar: SV 0x40173f3c
+fresh_perl_is(<<'EOI', 'ok', { }, 'delete() under threads');
+use threads;
+threads->new(sub { my %h=(1,2); delete $h{1}})->join for 1..2;
+print "ok";
+EOI
+
+#PR24660
+# test that we don't get:
+# Attempt to free unreferenced scalar: SV 0x814e0dc.
+fresh_perl_is(<<'EOI', 'ok', { }, 'weaken ref under threads');
+use threads;
+use Scalar::Util;
+my $data = "a";
+my $obj = \$data;
+my $copy = $obj;
+Scalar::Util::weaken($copy);
+threads->new(sub { 1 })->join for (1..1);
+print "ok";
+EOI
+
+#PR24663
+# test that we don't get:
+# panic: magic_killbackrefs.
+# Scalars leaked: 3
+fresh_perl_is(<<'EOI', 'ok', { }, 'weaken ref #2 under threads');
+package Foo;
+sub new { bless {},shift }
+package main;
+use threads;
+use Scalar::Util qw(weaken);
+my $object = Foo->new;
+my $ref = $object;
+weaken $ref;
+threads->new(sub { $ref = $object } )->join; # $ref = $object causes problems
+print "ok";
+EOI
+
+#PR30333 - sort() crash with threads
+sub mycmp { length($b) <=> length($a) }
+
+sub do_sort_one_thread {
+   my $kid = shift;
+   print "# kid $kid before sort\n";
+   my @list = ( 'x', 'yy', 'zzz', 'a', 'bb', 'ccc', 'aaaaa', 'z',
+                'hello', 's', 'thisisalongname', '1', '2', '3',
+                'abc', 'xyz', '1234567890', 'm', 'n', 'p' );
+
+   for my $j (1..99999) {
+      for my $k (sort mycmp @list) {}
+   }
+   print "# kid $kid after sort, sleeping 1\n";
+   sleep(1);
+   print "# kid $kid exit\n";
+}
+
+sub do_sort_threads {
+   my $nthreads = shift;
+   my @kids = ();
+   for my $i (1..$nthreads) {
+      my $t = threads->new(\&do_sort_one_thread, $i);
+      print "# parent $$: continue\n";
+      push(@kids, $t);
+   }
+   for my $t (@kids) {
+      print "# parent $$: waiting for join\n";
+      $t->join();
+      print "# parent $$: thread exited\n";
+   }
+}
+
+do_sort_threads(2);        # crashes
+ok(1);
diff --git a/t/run/runenv.t b/t/run/runenv.t
index df4a778b4d..bbe231f9b4 100644
--- a/t/run/runenv.t
+++ b/t/run/runenv.t
@@ -20,7 +20,7 @@ plan tests => 17;
 
 my $STDOUT = './results-0';
 my $STDERR = './results-1';
-my $PERL = './perl';
+my $PERL = $ENV{PERL} || './perl';
 my $FAILURE_CODE = 119;
 
 delete $ENV{PERLLIB};
diff --git a/t/test.pl b/t/test.pl
index 1e8ed9cf86..95aa87fdba 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -258,6 +258,7 @@ sub like_yn ($$$@) {
 	unshift(@mess, "#      got '$got'\n",
 		"# expected /$expected/\n");
     }
+    local $Level = 2;
     _ok($pass, _where(), $name, @mess);
 }
 
@@ -296,7 +297,7 @@ sub todo_skip {
     my $n   = @_ ? shift : 1;
 
     for (1..$n) {
-        print STDOUT "ok $test # TODO & SKIP: $why\n";
+        print STDOUT "not ok $test # TODO & SKIP: $why\n";
         $test++;
     }
     local $^W = 0;