29 files changed, 942 insertions, 175 deletions

diff --git a/t/TEST b/t/TEST
index a684b2ab65..44e6e409b6 100755
--- a/t/TEST
+++ b/t/TEST
@@ -17,6 +17,7 @@ chdir 't' if -f 't/TEST';
 die "You need to run \"make test\" first to set things up.\n"
   unless -e 'perl' or -e 'perl.exe';
 
+#$ENV{PERL_DESTRUCT_LEVEL} = '2';
 $ENV{EMXSHELL} = 'sh';        # For OS/2
 
 if ($#ARGV == -1) {
@@ -38,12 +39,34 @@ else {
     close(CONFIG);
 }
 
-$bad = 0;
-$good = 0;
-$total = @ARGV;
-$files  = 0;
-$totmax = 0;
-while ($test = shift) {
+%infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 ); 
+
+_testprogs('perl', @ARGV);
+_testprogs('compile', @ARGV) if (-e "../testcompile"); 
+
+sub _testprogs
+{
+	$type = shift @_;
+	@tests = @_;
+
+
+	print "
+--------------------------------------------------------------------------------
+TESTING COMPILER
+--------------------------------------------------------------------------------
+" if ($type eq 'compile');
+
+	$bad = 0;
+	$good = 0;
+	$total = @tests;
+	$files  = 0;
+	$totmax = 0;
+while ($test = shift @tests) {
+
+    if ( $infinite{$test} && $type eq 'compile' ) {
+		print STDERR "$test creates infinite loop! Skipping.\n"; 
+        next;
+	}
     if ($test =~ /^$/) {
 	next;
     }
@@ -52,7 +75,14 @@ while ($test = shift) {
     print "$te" . '.' x (18 - length($te));
     if ($sharpbang) {
 	-x $test || (print "isn't executable.\n");
-	open(RESULTS,"./$test |") || (print "can't run.\n");
+
+	if ($type eq 'perl')
+		{ open(RESULTS, "./$test |") || (print "can't run.\n"); }
+	else
+	{ 
+		open(RESULTS, "./perl -I../lib ../utils/perlcc ./$test -run -verbose dcf -log ../compilelog |") 
+											|| (print "can't compile.\n");
+	}
     } else {
 	open(SCRIPT,"$test") || die "Can't run $test.\n";
 	$_ = <SCRIPT>;
@@ -66,7 +96,16 @@ while ($test = shift) {
 	} else {
 	    $switch = '';
 	}
-	open(RESULTS,"./perl$switch $test |") || (print "can't run.\n");
+
+	if ($type eq 'perl')
+	{
+		open(RESULTS,"./perl$switch $test |") || (print "can't run.\n");
+	}
+	else
+	{
+		open(RESULTS, "./perl -I../lib ../utils/perlcc ./$test -run -verbose dcf -log ../compilelog |") 
+											|| (print "can't compile.\n");
+	}
     }
     $ok = 0;
     $next = 0;
@@ -129,16 +168,21 @@ if ($bad == 0) {
    ### Since not all tests were successful, you may want to run some
    ### of them individually and examine any diagnostic messages they
    ### produce.  See the INSTALL document's section on "make test".
+   ### If you are testing the compiler, then ignore this message 
+   ### and run 
+   ###      ./perl harness
+   ### in the directory ./t.
 SHRDLU
        warn <<'SHRDLU' if $good / $total > 0.8;
    ###
    ### Since most tests were successful, you have a good chance to
    ### get information with better granularity by running
-   ###     ./perl harness
+   ###     ./perl harness 
    ### in directory ./t.
 SHRDLU
 }
 ($user,$sys,$cuser,$csys) = times;
 print sprintf("u=%g  s=%g  cu=%g  cs=%g  scripts=%d  tests=%d\n",
     $user,$sys,$cuser,$csys,$files,$totmax);
+}
 exit ($bad != 0);
diff --git a/t/base/lex.t b/t/base/lex.t
index 31bb056b5b..045cb22eb0 100755
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: lex.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:04 $
 
-print "1..28\n";
+print "1..30\n";
 
 $x = 'x';
 
@@ -104,9 +104,15 @@ print "FOO:" =~ /$foo[:]/ ? "ok 24\n" : "not ok 24\n";
 print "ABC" =~ /^$ary[$A]$/ ? "ok 25\n" : "not ok 25\n";
 print "FOOZ" =~ /^$foo[$A-Z]$/ ? "ok 26\n" : "not ok 26\n";
 
-print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 27\n" : "not ok 27\n");
+# MJD 19980425
+($X, @X) = qw(a b c d); 
+print "d" =~ /^$X[-1]$/ ? "ok 27\n" : "not ok 27\n";
+print "a1" !~ /^$X[-1]$/ ? "ok 28\n" : "not ok 28\n";
 
-$foo = "not ok 28\n";
+print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 29\n" : "not ok 29\n");
+
+
+$foo = "not ok 30\n";
 $foo =~ s/^not /substr(<<EOF, 0, 0)/e;
   Ignored
 EOF
diff --git a/t/harness b/t/harness
index af92a8b6dc..f6d94de90f 100644
--- a/t/harness
+++ b/t/harness
@@ -17,4 +17,17 @@ $Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v';
 
 @tests = @ARGV;
 @tests = <base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t lib/*.t> unless @tests;
+
 Test::Harness::runtests @tests;
+
+%infinite = ('comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 );
+
+@tests = grep (!$infinite{$_}, @tests);
+
+if (-e "../testcompile") 
+{ 
+	print "The tests ", join(' ', keys(%infinite)), 
+							" generate infinite loops! Skipping!\n";
+
+	$ENV{'COMPILE_TEST'} = 1; Test::Harness::runtests @tests; 
+}
diff --git a/t/io/pipe.t b/t/io/pipe.t
index efeda80551..4a7cb7a423 100755
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -13,7 +13,7 @@ BEGIN {
 }
 
 $| = 1;
-print "1..10\n";
+print "1..12\n";
 
 open(PIPE, "|-") || (exec 'tr', 'YX', 'ko');
 print PIPE "Xk 1\n";
@@ -25,6 +25,7 @@ if (open(PIPE, "-|")) {
 	s/^not //;
 	print;
     }
+    close PIPE;        # avoid zombies which disrupt test 12
 }
 else {
     print STDOUT "not ok 3\n";
@@ -40,6 +41,7 @@ if ($pid = fork) {
 	y/A-Z/a-z/;
 	print;
     }
+    close READER;     # avoid zombies which disrupt test 12
 }
 else {
     die "Couldn't fork" unless defined $pid;
@@ -66,18 +68,21 @@ sleep 1;
 print "ok 8\n";
 
 # VMS doesn't like spawning subprocesses that are still connected to
-# STDOUT.  Someone should modify tests #9 and #10 to work with VMS.
+# STDOUT.  Someone should modify tests #9 to #12 to work with VMS.
 
 if ($^O eq 'VMS') {
     print "ok 9\n";
     print "ok 10\n";
+    print "ok 11\n";
+    print "ok 12\n";
     exit;
 }
 
-if ($Config{d_sfio} || $^O eq machten) {
+if ($Config{d_sfio} || $^O eq machten || $^O eq beos) {
     # Sfio doesn't report failure when closing a broken pipe
     # that has pending output.  Go figure.  MachTen doesn't either,
     # but won't write to broken pipes, so nothing's pending at close.
+    # BeOS will not write to broken pipes, either.
     print "ok 9\n";
 }
 else {
@@ -108,3 +113,21 @@ elsif ($? == 0) {
 else {
     print "ok 10\n";
 }
+
+# check that status for the correct process is collected
+my $zombie = fork or exit 37;
+my $pipe = open *FH, "sleep 2;exit 13|" or die "Open: $!\n";
+$SIG{ALRM} = sub { return };
+alarm(1);
+my $close = close FH;
+if ($? == 13*256 && ! length $close && ! $!) {
+    print "ok 11\n";
+} else {
+    print "not ok 11\n# close $close\$?=$?   \$!=", $!+0, ":$!\n";
+};
+my $wait = wait;
+if ($? == 37*256 && $wait == $zombie && ! $!) {
+    print "ok 12\n";
+} else {
+    print "not ok 12\n# pid=$wait   \$?=$?   \$!=", $!+0, ":$!\n";
+}
diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t
index 3ab609cecc..0391b7b490 100755
--- a/t/lib/anydbm.t
+++ b/t/lib/anydbm.t
@@ -12,7 +12,7 @@ use Fcntl;
 
 print "1..12\n";
 
-unlink <Op_dbmx.*>;
+unlink <Op_dbmx*>;
 
 umask(0);
 print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640)
@@ -20,7 +20,7 @@ print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640)
 
 $Dfile = "Op_dbmx.pag";
 if (! -e $Dfile) {
-	($Dfile) = <Op_dbmx.*>;
+	($Dfile) = <Op_dbmx*>;
 }
 if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
     print "ok 2 # Skipped: different file permission semantics\n";
@@ -33,7 +33,7 @@ else {
 while (($key,$value) = each(%h)) {
     $i++;
 }
-print (!$i ? "ok 3\n" : "not ok 3\n");
+print (!$i ? "ok 3\n" : "not ok 3 # i=$i\n\n");
 
 $h{'goner1'} = 'snork';
 
diff --git a/t/lib/filecopy.t b/t/lib/filecopy.t
index 8a23fb6d7d..e4bde30040 100755
--- a/t/lib/filecopy.t
+++ b/t/lib/filecopy.t
@@ -29,6 +29,7 @@ print "ok 1\n";
 print "not " unless $foo eq "ok 3\n";
 print "ok 2\n";
 
+binmode STDOUT;			# Copy::copy works in binary mode
 copy "copy-$$", \*STDOUT;
 unlink "copy-$$" or die "unlink: $!";
 
diff --git a/t/lib/filefind.t b/t/lib/filefind.t
index 21e29a2d7f..cd2e9771c7 100755
--- a/t/lib/filefind.t
+++ b/t/lib/filefind.t
@@ -5,9 +5,10 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..1\n";
+print "1..2\n";
 
 use File::Find;
 
 # hope we will eventually find ourself
 find(sub { print "ok 1\n" if $_ eq 'filefind.t'; }, ".");
+finddepth(sub { print "ok 2\n" if $_ eq 'filefind.t'; }, ".");
diff --git a/t/lib/io_sock.t b/t/lib/io_sock.t
index 0971e7803f..9fab56b237 100755
--- a/t/lib/io_sock.t
+++ b/t/lib/io_sock.t
@@ -55,11 +55,14 @@ if($pid = fork()) {
     # This can fail if localhost is undefined or the
     # special 'loopback' address 127.0.0.1 is not configured
     # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
+    # As a shortcut (not recommended) you could change 'localhost'
+    # here to be the name of this machine eg 'myhost.mycompany.com'.
 
     $sock = IO::Socket::INET->new(PeerPort => $port,
 				  Proto => 'tcp',
 				  PeerAddr => 'localhost'
-				 ) or die "$!";
+				 )
+	    or die "$! (maybe your system does not have the 'localhost' address defined)";
 
     $sock->autoflush(1);
 
diff --git a/t/lib/io_udp.t b/t/lib/io_udp.t
index 3e16714118..014e12dc58 100755
--- a/t/lib/io_udp.t
+++ b/t/lib/io_udp.t
@@ -30,9 +30,13 @@ use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
     # This can fail if localhost is undefined or the
     # special 'loopback' address 127.0.0.1 is not configured
     # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
+    # As a shortcut (not recommended) you could change 'localhost'
+    # here to be the name of this machine eg 'myhost.mycompany.com'.
 
-$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost');
-$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost');
+$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+    or die "$! (maybe your system does not have the 'localhost' address defined)";
+$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+    or die "$! (maybe your system does not have the 'localhost' address defined)";
 
 print "ok 1\n";
 
diff --git a/t/lib/parsewords.t b/t/lib/parsewords.t
index 47a75881dc..21ed0d3eae 100755
--- a/t/lib/parsewords.t
+++ b/t/lib/parsewords.t
@@ -5,24 +5,77 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..4\n";
-
 use Text::ParseWords;
 
-@words = shellwords(qq(foo "bar quiz" zoo));
-#print join(";", @words), "\n";
+print "1..15\n";
 
+@words = shellwords(qq(foo "bar quiz" zoo));
 print "not " if $words[0] ne 'foo';
 print "ok 1\n";
-
 print "not " if $words[1] ne 'bar quiz';
 print "ok 2\n";
-
 print "not " if $words[2] ne 'zoo';
 print "ok 3\n";
 
-# Test quotewords() with other parameters
-@words = quotewords(":+", 1, qq(foo:::"bar:foo":zoo zoo:));
-#print join(";", @words), "\n";
-print "not " unless join(";", @words) eq qq(foo;"bar:foo";zoo zoo);
+# Test quotewords() with other parameters and null last field
+@words = quotewords(':+', 1, 'foo:::"bar:foo":zoo zoo:');
+print "not " unless join(";", @words) eq qq(foo;"bar:foo";zoo zoo;);
 print "ok 4\n";
+
+# Test $keep eq 'delimiters' and last field zero
+@words = quotewords('\s+', 'delimiters', '4 3 2 1 0');
+print "not " unless join(";", @words) eq qq(4; ;3; ;2; ;1; ;0);
+print "ok 5\n";
+
+# Big ol' nasty test (thanks, Joerk!)
+$string = 'aaaa"bbbbb" cc\\ cc \\\\\\"dddd" eee\\\\\\"ffff" "gg"';
+
+# First with $keep == 1
+$result = join('|', parse_line('\s+', 1, $string));
+print "not " unless $result eq 'aaaa"bbbbb"|cc\\ cc|\\\\\\"dddd" eee\\\\\\"ffff"|"gg"';
+print "ok 6\n";
+
+# Now, $keep == 0
+$result = join('|', parse_line('\s+', 0, $string));
+print "not " unless $result eq 'aaaabbbbb|cc cc|\\"dddd eee\\"ffff|gg';
+print "ok 7\n";
+
+# Now test single quote behavior
+$string = 'aaaa"bbbbb" cc\\ cc \\\\\\"dddd\' eee\\\\\\"ffff\' gg';
+$result = join('|', parse_line('\s+', 0, $string));
+print "not " unless $result eq 'aaaabbbbb|cc cc|\\"dddd eee\\\\\\"ffff|gg';
+print "ok 8\n";
+
+# Make sure @nested_quotewords does the right thing
+@lists = nested_quotewords('\s+', 0, 'a b c', '1 2 3', 'x y z');
+print "not " unless (@lists == 3 && @{$lists[0]} == 3 && @{$lists[1]} == 3 && @{$lists[2]} == 3);
+print "ok 9\n";
+
+# Now test error return
+$string = 'foo bar baz"bach blech boop';
+
+@words = shellwords($string);
+print "not " if (@words);
+print "ok 10\n";
+
+@words = parse_line('s+', 0, $string);
+print "not " if (@words);
+print "ok 11\n";
+
+@words = quotewords('s+', 0, $string);
+print "not " if (@words);
+print "ok 12\n";
+
+@words = nested_quotewords('s+', 0, $string);
+print "not " if (@words);
+print "ok 13\n";
+
+# Now test empty fields
+$result = join('|', parse_line(':', 0, 'foo::0:"":::'));
+print "not " unless ($result eq 'foo||0||||');
+print "ok 14\n";
+
+# Test for 0 in quotes without $keep
+$result = join('|', parse_line(':', 0, ':"0":'));
+print "not " unless ($result eq '|0|');
+print "ok 15\n";
diff --git a/t/lib/posix.t b/t/lib/posix.t
index d63e695f02..c071c3b067 100755
--- a/t/lib/posix.t
+++ b/t/lib/posix.t
@@ -16,6 +16,8 @@ use strict subs;
 $| = 1;
 print "1..18\n";
 
+$Is_W32 = $^O eq 'MSWin32';
+
 $testfd = open("TEST", O_RDONLY, 0) and print "ok 1\n";
 read($testfd, $buffer, 9) if $testfd > 2;
 print $buffer eq "#!./perl\n" ? "ok 2\n" : "not ok 2\n";
@@ -31,6 +33,12 @@ close $writer;
 print <$reader>;
 close $reader;
 
+if ($Is_W32) {
+    for (6..11) {
+	print "ok $_ # skipped, no sigaction support on win32\n";
+    }
+}
+else {
 $sigset = new POSIX::SigSet 1,3;
 delset $sigset 1;
 if (!ismember $sigset 1) { print "ok 6\n" }
@@ -53,6 +61,7 @@ sub SigHUP {
 sub SigINT {
     print "ok 10\n";
 }
+}
 
 print &_POSIX_OPEN_MAX > $fds[1] ? "ok 12\n" : "not ok 12\n";
 
diff --git a/t/lib/timelocal.t b/t/lib/timelocal.t
index 938ca695b1..100e0768aa 100755
--- a/t/lib/timelocal.t
+++ b/t/lib/timelocal.t
@@ -11,7 +11,7 @@ use Time::Local;
 @time =
   (
    #year,mon,day,hour,min,sec 
-   [1970,  1,  1, 00, 00, 00],
+   [1970,  1,  2, 00, 00, 00],
    [1980,  2, 28, 12, 00, 00],
    [1980,  2, 29, 12, 00, 00],
    [1999, 12, 31, 23, 59, 59],
diff --git a/t/op/defins.t b/t/op/defins.t
new file mode 100755
index 0000000000..5dd614d4b8
--- /dev/null
+++ b/t/op/defins.t
@@ -0,0 +1,144 @@
+#!./perl -w
+
+#
+# test auto defined() test insertion
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    $SIG{__WARN__} = sub { $warns++; warn $_[0] };
+    print "1..14\n";
+}
+    
+print "not " if $warns;
+print "ok 1\n";
+
+open(FILE,">./0");
+print FILE "1\n";
+print FILE "0";
+close(FILE);
+
+open(FILE,"<./0");
+my $seen = 0;
+my $dummy;
+while (my $name = <FILE>)
+ {
+  $seen++ if $name eq '0';
+ }            
+print "not " unless $seen;
+print "ok 2\n";
+
+seek(FILE,0,0);
+$seen = 0;
+my $line = '';
+do 
+ {
+  $seen++ if $line eq '0';
+ } while ($line = <FILE>);
+
+print "not " unless $seen;
+print "ok 3\n";
+
+
+seek(FILE,0,0);
+$seen = 0;    
+while (($seen ? $dummy : $name) = <FILE>)
+ {
+  $seen++ if $name eq '0';
+ }
+print "not " unless $seen;
+print "ok 4\n";
+
+seek(FILE,0,0);
+$seen = 0;    
+my %where;    
+while ($where{$seen} = <FILE>)
+ {
+  $seen++ if $where{$seen} eq '0';
+ }
+print "not " unless $seen;
+print "ok 5\n";
+
+opendir(DIR,'.');
+$seen = 0;
+while (my $name = readdir(DIR))
+ {
+  $seen++ if $name eq '0';
+ }            
+print "not " unless $seen;
+print "ok 6\n";
+
+rewinddir(DIR);
+$seen = 0;    
+$dummy = '';
+while (($seen ? $dummy : $name) = readdir(DIR))
+ {
+  $seen++ if $name eq '0';
+ }
+print "not " unless $seen;
+print "ok 7\n";
+
+rewinddir(DIR);
+$seen = 0;    
+while ($where{$seen} = readdir(DIR))
+ {
+  $seen++ if $where{$seen} eq '0';
+ }
+print "not " unless $seen;
+print "ok 8\n";
+
+$seen = 0;
+while (my $name = glob('*'))
+ {
+  $seen++ if $name eq '0';
+ }            
+print "not " unless $seen;
+print "ok 9\n";
+
+$seen = 0;    
+$dummy = '';
+while (($seen ? $dummy : $name) = glob('*'))
+ {
+  $seen++ if $name eq '0';
+ }
+print "not " unless $seen;
+print "ok 10\n";
+
+$seen = 0;    
+while ($where{$seen} = glob('*'))
+ {
+  $seen++ if $where{$seen} eq '0';
+ }
+print "not " unless $seen;
+print "ok 11\n";
+
+unlink("./0");
+
+my %hash = (0 => 1, 1 => 2);
+
+$seen = 0;
+while (my $name = each %hash)
+ {
+  $seen++ if $name eq '0';
+ }            
+print "not " unless $seen;
+print "ok 12\n";
+
+$seen = 0;    
+$dummy = '';
+while (($seen ? $dummy : $name) = each %hash)
+ {
+  $seen++ if $name eq '0';
+ }
+print "not " unless $seen;
+print "ok 13\n";
+
+$seen = 0;    
+while ($where{$seen} = each %hash)
+ {
+  $seen++ if $where{$seen} eq '0';
+ }
+print "not " unless $seen;
+print "ok 14\n";
+
diff --git a/t/op/die.t b/t/op/die.t
new file mode 100755
index 0000000000..795d856564
--- /dev/null
+++ b/t/op/die.t
@@ -0,0 +1,26 @@
+#!./perl
+
+print "1..6\n";
+
+$SIG{__DIE__} = sub { print ref($_[0]) ? ("ok ",$_[0]->[0]++,"\n") : @_ } ;
+
+$err = "ok 1\n";
+eval {
+    die $err;
+};
+
+print "not " unless $@ eq $err;
+print "ok 2\n";
+
+$x = [3];
+eval { die $x; };
+
+print "not " unless $x->[0] == 4;
+print "ok 4\n";
+
+eval {
+    eval {
+	die [ 5 ];
+    };
+    die if $@;
+};
diff --git a/t/op/die_exit.t b/t/op/die_exit.t
new file mode 100755
index 0000000000..b5760d6fa0
--- /dev/null
+++ b/t/op/die_exit.t
@@ -0,0 +1,50 @@
+#!./perl
+
+#
+# Verify that C<die> return the return code
+#	-- Robin Barker <rmb@cise.npl.co.uk>
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -e '../lib';
+}
+my $perl = -e '../perl' ? '../perl' : -e './perl' ? './perl' : 'perl';
+
+use strict;
+
+my %tests = (
+	 1 => [   0,   0],
+	 2 => [   0,   1], 
+	 3 => [   0, 127], 
+	 4 => [   0, 128], 
+	 5 => [   0, 255], 
+	 6 => [   0, 256], 
+	 7 => [   0, 512], 
+	 8 => [   1,   0],
+	 9 => [   1,   1],
+	10 => [   1, 256],
+	11 => [ 128,   0],
+	12 => [ 128,   1],
+	13 => [ 128, 256],
+	14 => [ 255,   0],
+	15 => [ 255,   1],
+	16 => [ 255, 256],
+);
+
+my $max = keys %tests;
+
+print "1..$max\n";
+
+foreach my $test (1 .. $max) {
+    my($bang, $query) = @{$tests{$test}};
+    my $exit =
+	($^O eq 'MSWin32'
+	 ? system qq($perl -e "\$! = $bang; \$? = $query; die;" 2> nul)
+	 : system qq($perl -e '\$! = $bang; \$? = $query; die;' 2> /dev/null));
+
+    printf "# 0x%04x  0x%04x  0x%04x\nnot ", $exit, $bang, $query
+	unless $exit == (($bang || ($query >> 8) || 255) << 8);
+    print "ok $test\n";
+}
+    
diff --git a/t/op/exec.t b/t/op/exec.t
index 7dfcd6177f..506fc09fbd 100755
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -6,6 +6,7 @@ $| = 1;				# flush stdout
 
 if ($^O eq 'MSWin32') {
     print "# exec is unsupported on Win32\n";
+    # XXX the system tests could be written to use ./perl and so work on Win32
     print "1..0\n";
     exit(0);
 }
@@ -16,6 +17,7 @@ print "not ok 1\n" if system "echo ok \\1";	# shell interpreted
 print "not ok 2\n" if system "echo ok 2";	# split and directly called
 print "not ok 3\n" if system "echo", "ok", "3"; # directly called
 
+# these should probably be rewritten to match the examples in perlfunc.pod
 if (system "true") {print "not ok 4\n";} else {print "ok 4\n";}
 
 if ((system "/bin/sh -c 'exit 1'") != 256) { print "not "; }
diff --git a/t/op/gv.t b/t/op/gv.t
index 55e7429adc..dc71595610 100755
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -4,7 +4,7 @@
 # various typeglob tests
 #
 
-print "1..13\n";
+print "1..16\n";
 
 # type coersion on assignment
 $foo = 'foo';
@@ -65,3 +65,21 @@ if (defined $baa) {
 { package Foo::Bar }
 print exists $Foo::{'Bar::'} ? "ok 12\n" : "not ok 12\n";
 print $Foo::{'Bar::'} eq '*Foo::Bar::' ? "ok 13\n" : "not ok 13\n";
+
+# test undef operator clearing out entire glob
+$foo = 'stuff';
+@foo = qw(more stuff);
+%foo = qw(even more random stuff);
+undef *foo;
+print +($foo || @foo || %foo) ? "not ok" : "ok", " 14\n";
+
+# test warnings from assignment of undef to glob
+{
+    my $msg;
+    local $SIG{__WARN__} = sub { $msg = $_[0] };
+    local $^W = 1;
+    *foo = 'bar';
+    print $msg ? "not ok" : "ok", " 15\n";
+    *foo = undef;
+    print $msg ? "ok" : "not ok", " 16\n";
+}
diff --git a/t/op/hashwarn.t b/t/op/hashwarn.t
index 741982622b..6343a2a8d5 100755
--- a/t/op/hashwarn.t
+++ b/t/op/hashwarn.t
@@ -1,11 +1,12 @@
 #!./perl
 
-use strict;
-
 BEGIN {
     chdir 't' if -d 't';
+    @INC = '../lib';
 }
 
+use strict;
+
 use vars qw{ @warnings };
 
 BEGIN {
diff --git a/t/op/ipcmsg.t b/t/op/ipcmsg.t
new file mode 100755
index 0000000000..ab2b0737e9
--- /dev/null
+++ b/t/op/ipcmsg.t
@@ -0,0 +1,142 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+my @define;
+
+BEGIN {
+    @define = qw(
+	IPC_PRIVATE
+	IPC_RMID
+	IPC_NOWAIT
+	IPC_STAT
+	S_IRWXU
+	S_IRWXG
+	S_IRWXO
+    );
+}
+
+use Config;
+use vars map { '$' . $_ } @define;
+
+BEGIN {
+    unless($Config{'d_msgget'} eq 'define' &&
+	   $Config{'d_msgctl'} eq 'define' &&
+	   $Config{'d_msgsnd'} eq 'define' &&
+	   $Config{'d_msgrcv'} eq 'define') {
+	print "1..0\n";
+	exit;
+    }
+
+    use strict;
+
+    my @incpath = (split(/\s+/, $Config{usrinc}), split(/\s+/ ,$Config{locincpth}));
+    my %done = ();
+    my %define = ();
+
+    sub process_file {
+	my($file,$level) = @_;
+
+	return unless defined $file;
+
+	my $path = undef;
+	my $dir;
+	foreach $dir (@incpath) {
+	    my $tmp = $dir . "/" . $file;
+	    next unless -r $tmp;
+	    $path = $tmp;
+	    last;
+	}
+
+	return if exists $done{$path};
+	$done{$path} = 1;
+
+	if(not defined $path and $level == 0) {
+	    warn "Cannot find '$file'";
+	    return;
+	}
+
+	local(*F);
+	open(F,$path) or return;
+        $level = 1 unless defined $level;
+	my $indent = " " x $level;
+	print "#$indent open $path\n";
+	while(<F>) {
+	    s#/\*.*(\*/|$)##;
+
+	    if ( /^#\s*include\s*[<"]([^>"]+)[>"]/ ) {
+	        print "#${indent} include $1\n";
+		process_file($1,$level+1);
+	        print "#${indent} done include $1\n";
+	        print "#${indent} back in $path\n";
+	    }
+
+	    s/(?:\([^)]*\)\s*)//;
+
+	    if ( /^#\s*define\s+(\w+)\s+(\w+)/ ) {
+	        print "#${indent} define $1 $2\n";
+		$define{$1} = $2;
+	    }
+       }
+       close(F);
+       print "#$indent close $path\n";
+    }
+
+    process_file("sys/sem.h");
+    process_file("sys/ipc.h");
+    process_file("sys/stat.h");
+
+    foreach my $d (@define) {
+	while(defined($define{$d}) && $define{$d} !~ /^(0x)?\d+$/) {
+	    $define{$d} = exists $define{$define{$d}}
+		    ? $define{$define{$d}} : undef;
+	}
+	unless(defined $define{$d}) {
+	    print "# $d undefined\n";
+	    print "1..0\n";
+	    exit;
+	}
+	{
+	    no strict 'refs';
+	    ${ $d } = eval $define{$d};
+        }
+    }
+}
+
+use strict;
+
+print "1..6\n";
+
+my $msg = msgget($IPC_PRIVATE, $S_IRWXU | $S_IRWXG | $S_IRWXO)
+	|| die "msgget failed: $!\n";
+
+print "ok 1\n";
+
+#Putting a message on the queue
+my $msgtype = 1;
+my $msgtext = "hello";
+
+msgsnd($msg,pack("L a*",$msgtype,$msgtext),0) or print "not ";
+print "ok 2\n";
+
+my $data;
+msgctl($msg,$IPC_STAT,$data) or print "not ";
+print "ok 3\n";
+
+print "not " unless length($data);
+print "ok 4\n";
+
+my $msgbuf;
+msgrcv($msg,$msgbuf,256,0,$IPC_NOWAIT) or print "not ";
+print "ok 5\n";
+
+my($rmsgtype,$rmsgtext) = unpack("L a*",$msgbuf);
+
+print "not " unless($rmsgtype == $msgtype && $rmsgtext eq $msgtext);
+print "ok 6\n";
+
+msgctl($msg,$IPC_RMID,0);
+
diff --git a/t/op/ipcsem.t b/t/op/ipcsem.t
new file mode 100755
index 0000000000..f71f810570
--- /dev/null
+++ b/t/op/ipcsem.t
@@ -0,0 +1,159 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+my @define;
+
+BEGIN {
+    @define = qw(
+	GETALL
+	SETALL
+	IPC_PRIVATE
+	IPC_CREAT
+	IPC_RMID
+	IPC_STAT
+	S_IRWXU
+	S_IRWXG
+	S_IRWXO
+    );
+}
+
+use Config;
+use vars map { '$' . $_ } @define;
+
+BEGIN {
+    unless($Config{'d_semget'} eq 'define' &&
+	   $Config{'d_semctl'} eq 'define') {
+	print "1..0\n";
+	exit;
+    }
+
+    use strict;
+
+    my @incpath = (split(/\s+/, $Config{usrinc}), split(/\s+/ ,$Config{locincpth}));
+    my %done = ();
+    my %define = ();
+
+    sub process_file {
+	my($file,$level) = @_;
+
+	return unless defined $file;
+
+	my $path = undef;
+	my $dir;
+	foreach $dir (@incpath) {
+	    my $tmp = $dir . "/" . $file;
+	    next unless -r $tmp;
+	    $path = $tmp;
+	    last;
+	}
+
+	return if exists $done{$path};
+	$done{$path} = 1;
+
+	if(not defined $path and $level == 0) {
+	    warn "Cannot find '$file'";
+	    return;
+	}
+
+	local(*F);
+	open(F,$path) or return;
+        $level = 1 unless defined $level;
+	my $indent = " " x $level;
+	print "#$indent open $path\n";
+	while(<F>) {
+	    s#/\*.*(\*/|$)##;
+
+	    if ( /^#\s*include\s*[<"]([^>"]+)[>"]/ ) {
+	        print "#${indent} include $1\n";
+		process_file($1,$level+1);
+	        print "#${indent} done include $1\n";
+	        print "#${indent} back in $path\n";
+	    }
+
+	    s/(?:\([^)]*\)\s*)//;
+
+	    if ( /^#\s*define\s+(\w+)\s+(\w+)/ ) {
+	        print "#${indent} define $1 $2\n";
+		$define{$1} = $2;
+	    }
+       }
+       close(F);
+       print "#$indent close $path\n";
+    }
+
+    process_file("sys/sem.h");
+    process_file("sys/ipc.h");
+    process_file("sys/stat.h");
+
+    foreach my $d (@define) {
+	while(defined($define{$d}) && $define{$d} !~ /^(0x)?\d+$/) {
+	    $define{$d} = exists $define{$define{$d}}
+		    ? $define{$define{$d}} : undef;
+	}
+	unless(defined $define{$d}) {
+	    print "# $d undefined\n";
+	    print "1..0\n";
+	    exit;
+	}
+	{
+	    no strict 'refs';
+	    ${ $d } = eval $define{$d};
+        }
+    }
+}
+
+use strict;
+
+# This test doesn't seem to work properly yet so skip it for _65
+print "1..0\n";
+exit;
+
+
+print "1..10\n";
+
+my $sem = semget($IPC_PRIVATE, 10, $S_IRWXU | $S_IRWXG | $S_IRWXO | $IPC_CREAT)
+	|| die "semget: $!\n";
+
+print "ok 1\n";
+
+my $data;
+semctl($sem,0,$IPC_STAT,$data) or print "not ";
+print "ok 2\n";
+
+print "not " unless length($data);
+print "ok 3\n";
+
+semctl($sem,0,$SETALL,pack("s*",(0) x 10)) or print "not ";
+print "ok 4\n";
+
+$data = "";
+semctl($sem,0,$GETALL,$data) or print "not ";
+print "ok 5\n";
+
+print "not " unless length($data);
+print "ok 6\n";
+
+my @data = unpack("s*",$data);
+
+print "not " unless join("",@data) eq "0000000000";
+print "ok 7\n";
+
+$data[2] = 1;
+semctl($sem,0,$SETALL,pack("s*",@data)) or print "not ";
+print "ok 8\n";
+
+$data = "";
+semctl($sem,0,$GETALL,$data) or print "not ";
+print "ok 9\n";
+
+@data = unpack("s*",$data);
+
+print "not " unless join("",@data) eq "0010000000";
+print "ok 10\n";
+
+semctl($sem,0,$IPC_RMID,undef);
+
diff --git a/t/op/misc.t b/t/op/misc.t
index 582ffa7905..9ab6831859 100755
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -368,6 +368,11 @@ EXPECT
 1
 2
 ########
+-w
+sub testme { my $a = "test"; { local $a = "new test"; print $a }}
+EXPECT
+Can't localize lexical variable $a at - line 2.
+########
 package X;
 sub ascalar { my $r; bless \$r }
 sub DESTROY { print "destroyed\n" };
diff --git a/t/op/pack.t b/t/op/pack.t
index f9a89a3ec0..de5fcff218 100755
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: pack.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:11 $
 
-print "1..29\n";
+print "1..30\n";
 
 $format = "c2 x5 C C x s d i l a6";
 # Need the expression in here to force ary[5] to be numeric.  This avoids
@@ -100,3 +100,9 @@ sub foo { my $a = "a"; return $a . $a++ . $a++ }
 # undef should give null pointer
 print((pack("p", undef) =~ /^\0+/ ? "ok " : "not ok "),$test++,"\n");
 
+# Check for optimizer bug (e.g.  Digital Unix GEM cc with -O4 on DU V4.0B gives
+#                                4294967295 instead of -1)
+#				 see #ifdef __osf__ in pp.c pp_unpack
+# Test 30:
+print( ((unpack("i",pack("i",-1))) == -1 ? "ok " : "not ok "),$test++,"\n");
+
diff --git a/t/op/pos.t b/t/op/pos.t
new file mode 100755
index 0000000000..46811b7bbc
--- /dev/null
+++ b/t/op/pos.t
@@ -0,0 +1,16 @@
+#!./perl
+
+print "1..3\n";
+
+$x='banana';
+$x=~/.a/g;
+if (pos($x)==2) {print "ok 1\n"} else {print "not ok 1\n";}
+
+$x=~/.z/gc;
+if (pos($x)==2) {print "ok 2\n"} else {print "not ok 2\n";}
+
+sub f { my $p=$_[0]; return $p }
+
+$x=~/.a/g;
+if (f(pos($x))==4) {print "ok 3\n"} else {print "not ok 3\n";}
+
diff --git a/t/op/runlevel.t b/t/op/runlevel.t
index b5e5dbb08c..bff26e4b71 100755
--- a/t/op/runlevel.t
+++ b/t/op/runlevel.t
@@ -188,6 +188,8 @@ sub sortfn {
 print "---- ".join(', ', @x)."\n";
 EXPECT
 sortfn 4, 5, 6
+sortfn 4, 5, 6
+sortfn 4, 5, 6
 ---- 1, 2, 3
 ########
 @a = (3, 2, 1);
diff --git a/t/op/stat.t b/t/op/stat.t
index 9d4b3a6787..c7cd0961f3 100755
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -45,7 +45,12 @@ else {
 if ($Is_MSWin32 || $Is_Dos || $Config{dont_use_nlink} || $nlink == 2)
     {print "ok 3\n";} else {print "# \$nlink is |$nlink|\nnot ok 3\n";}
 
-if ($Is_MSWin32 || $Is_Dos || ($mtime && $mtime != $ctime) || $cwd =~ m#/afs/# || $^O eq 'amigaos') {
+if (   ($mtime && $mtime != $ctime)
+	|| $Is_MSWin32
+	|| $Is_Dos
+	|| ($cwd eq '/tmp' and $mtime && $mtime==$ctime) # Solaris tmpfs bug
+	|| $cwd =~ m#/afs/#
+	|| $^O eq 'amigaos') {
     print "ok 4\n";
 }
 else {
@@ -53,7 +58,7 @@ else {
     print "#4 If test op/stat.t fails test 4, check if you are on a tmpfs\n";
     print "#4 of some sort.  Building in /tmp sometimes has this problem.\n";
 }
-print "#4	:$mtime: != :$ctime:\n";
+print "#4	:$mtime: should != :$ctime:\n";
 
 unlink "Op.stat.tmp";
 if ($Is_MSWin32) {  open F, '>Op.stat.tmp' and close F }
diff --git a/t/op/subst.t b/t/op/subst.t
index 4fd00d5067..248aa71b9d 100755
--- a/t/op/subst.t
+++ b/t/op/subst.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: s.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:22 $
 
-print "1..68\n";
+print "1..69\n";
 
 $x = 'foo';
 $_ = "x";
@@ -267,3 +267,6 @@ $_="baacbaa";
 tr/a/b/s;
 print $_ eq "bbcbb" ? "ok 68\n" : "not ok 68 # `$_' ne `bbcbb'\n";
 
+# XXX TODO: Most tests above don't test return values of the ops. They should.
+$_ = "ab";
+print (s/a/b/ == 1 ? "ok 69\n" : "not ok 69\n");
diff --git a/t/op/substr.t b/t/op/substr.t
index bb655f5209..967016a8d0 100755
--- a/t/op/substr.t
+++ b/t/op/substr.t
@@ -1,8 +1,6 @@
 #!./perl
 
-# $RCSfile: substr.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:31 $
-
-print "1..97\n";
+print "1..100\n";
 
 #P = start of string  Q = start of substr  R = end of substr  S = end of string
 
@@ -178,3 +176,13 @@ for (0,1) {
 
 # check no spurious warnings
 print $w ? "not ok 97\n" : "ok 97\n";
+
+# check new replacement syntax
+$a = "abcxyz";
+print "not " unless substr($a, 0, 3, "") eq "abc" && $a eq "xyz";
+print "ok 98\n";
+print "not " unless substr($a, 0, 0, "abc") eq "" && $a eq "abcxyz";
+print "ok 99\n";
+print "not " unless substr($a, 3, undef, "") eq "xyz" && $a eq "abc";
+print "ok 100\n";
+
diff --git a/t/op/taint.t b/t/op/taint.t
index e18f123e9d..2b9da86b3f 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -83,7 +83,7 @@ print PROG 'print "@ARGV\n"', "\n";
 close PROG;
 my $echo = "$Invoke_Perl $ECHO";
 
-print "1..140\n";
+print "1..145\n";
 
 # First, let's make sure that Perl is checking the dangerous
 # environment variables. Maybe they aren't set yet, so we'll
@@ -121,7 +121,10 @@ print "1..140\n";
     }
 
     my $tmp;
-    unless ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32 || $Is_Dos) {
+    if ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32 || $Is_Dos) {
+	print "# all directories are writeable\n";
+    }
+    else {
 	$tmp = (grep { defined and -d and (stat _)[2] & 2 }
 		     qw(/tmp /var/tmp /usr/tmp /sys$scratch),
 		     @ENV{qw(TMP TEMP)})[0]
@@ -184,12 +187,16 @@ print "1..140\n";
     test 20, not tainted $foo;
     test 21, $foo eq 'bar';
 
+    $foo = $1 if ('bar' . $TAINT) =~ /(.+)/t;
+    test 22, tainted $foo;
+    test 23, $foo eq 'bar';
+
     my $pi = 4 * atan2(1,1) + $TAINT0;
-    test 22, tainted $pi;
+    test 24, tainted $pi;
 
     ($pi) = $pi =~ /(\d+\.\d+)/;
-    test 23, not tainted $pi;
-    test 24, sprintf("%.5f", $pi) eq '3.14159';
+    test 25, not tainted $pi;
+    test 26, sprintf("%.5f", $pi) eq '3.14159';
 }
 
 # How about command-line arguments? The problem is that we don't
@@ -205,21 +212,21 @@ print "1..140\n";
     };
     close PROG;
     print `$Invoke_Perl "-T" $arg and some suspect arguments`;
-    test 25, !$?, "Exited with status $?";
+    test 27, !$?, "Exited with status $?";
     unlink $arg;
 }
 
 # Reading from a file should be tainted
 {
     my $file = './TEST';
-    test 26, open(FILE, $file), "Couldn't open '$file': $!";
+    test 28, open(FILE, $file), "Couldn't open '$file': $!";
 
     my $block;
     sysread(FILE, $block, 100);
     my $line = <FILE>;
     close FILE;
-    test 27, tainted $block;
-    test 28, tainted $line;
+    test 29, tainted $block;
+    test 30, tainted $line;
 }
 
 # Globs should be forbidden, except under VMS,
@@ -229,122 +236,122 @@ if ($Is_VMS) {
 }
 else {
     my @globs = eval { <*> };
-    test 29, @globs == 0 && $@ =~ /^Insecure dependency/;
+    test 31, @globs == 0 && $@ =~ /^Insecure dependency/;
 
     @globs = eval { glob '*' };
-    test 30, @globs == 0 && $@ =~ /^Insecure dependency/;
+    test 32, @globs == 0 && $@ =~ /^Insecure dependency/;
 }
 
 # Output of commands should be tainted
 {
     my $foo = `$echo abc`;
-    test 31, tainted $foo;
+    test 33, tainted $foo;
 }
 
 # Certain system variables should be tainted
 {
-    test 32, all_tainted $^X, $0;
+    test 34, all_tainted $^X, $0;
 }
 
 # Results of matching should all be untainted
 {
     my $foo = "abcdefghi" . $TAINT;
-    test 33, tainted $foo;
+    test 35, tainted $foo;
 
     $foo =~ /def/;
-    test 34, not any_tainted $`, $&, $';
+    test 36, not any_tainted $`, $&, $';
 
     $foo =~ /(...)(...)(...)/;
-    test 35, not any_tainted $1, $2, $3, $+;
+    test 37, not any_tainted $1, $2, $3, $+;
 
     my @bar = $foo =~ /(...)(...)(...)/;
-    test 36, not any_tainted @bar;
+    test 38, not any_tainted @bar;
 
-    test 37, tainted $foo;	# $foo should still be tainted!
-    test 38, $foo eq "abcdefghi";
+    test 39, tainted $foo;	# $foo should still be tainted!
+    test 40, $foo eq "abcdefghi";
 }
 
 # Operations which affect files can't use tainted data.
 {
-    test 39, eval { chmod 0, $TAINT } eq '', 'chmod';
-    test 40, $@ =~ /^Insecure dependency/, $@;
+    test 41, eval { chmod 0, $TAINT } eq '', 'chmod';
+    test 42, $@ =~ /^Insecure dependency/, $@;
 
     # There is no feature test in $Config{} for truncate,
     #   so we allow for the possibility that it's missing.
-    test 41, eval { truncate 'NoSuChFiLe', $TAINT0 } eq '', 'truncate';
-    test 42, $@ =~ /^(?:Insecure dependency|truncate not implemented)/, $@;
-
-    test 43, eval { rename '', $TAINT } eq '', 'rename';
-    test 44, $@ =~ /^Insecure dependency/, $@;
+    test 43, eval { truncate 'NoSuChFiLe', $TAINT0 } eq '', 'truncate';
+    test 44, $@ =~ /^(?:Insecure dependency|truncate not implemented)/, $@;
 
-    test 45, eval { unlink $TAINT } eq '', 'unlink';
+    test 45, eval { rename '', $TAINT } eq '', 'rename';
     test 46, $@ =~ /^Insecure dependency/, $@;
 
-    test 47, eval { utime $TAINT } eq '', 'utime';
+    test 47, eval { unlink $TAINT } eq '', 'unlink';
     test 48, $@ =~ /^Insecure dependency/, $@;
 
+    test 49, eval { utime $TAINT } eq '', 'utime';
+    test 50, $@ =~ /^Insecure dependency/, $@;
+
     if ($Config{d_chown}) {
-	test 49, eval { chown -1, -1, $TAINT } eq '', 'chown';
-	test 50, $@ =~ /^Insecure dependency/, $@;
+	test 51, eval { chown -1, -1, $TAINT } eq '', 'chown';
+	test 52, $@ =~ /^Insecure dependency/, $@;
     }
     else {
-	for (49..50) { print "ok $_ # Skipped: chown() is not available\n" }
+	for (51..52) { print "ok $_ # Skipped: chown() is not available\n" }
     }
 
     if ($Config{d_link}) {
-	test 51, eval { link $TAINT, '' } eq '', 'link';
-	test 52, $@ =~ /^Insecure dependency/, $@;
+	test 53, eval { link $TAINT, '' } eq '', 'link';
+	test 54, $@ =~ /^Insecure dependency/, $@;
     }
     else {
-	for (51..52) { print "ok $_ # Skipped: link() is not available\n" }
+	for (53..54) { print "ok $_ # Skipped: link() is not available\n" }
     }
 
     if ($Config{d_symlink}) {
-	test 53, eval { symlink $TAINT, '' } eq '', 'symlink';
-	test 54, $@ =~ /^Insecure dependency/, $@;
+	test 55, eval { symlink $TAINT, '' } eq '', 'symlink';
+	test 56, $@ =~ /^Insecure dependency/, $@;
     }
     else {
-	for (53..54) { print "ok $_ # Skipped: symlink() is not available\n" }
+	for (55..56) { print "ok $_ # Skipped: symlink() is not available\n" }
     }
 }
 
 # Operations which affect directories can't use tainted data.
 {
-    test 55, eval { mkdir $TAINT0, $TAINT } eq '', 'mkdir';
-    test 56, $@ =~ /^Insecure dependency/, $@;
-
-    test 57, eval { rmdir $TAINT } eq '', 'rmdir';
+    test 57, eval { mkdir $TAINT0, $TAINT } eq '', 'mkdir';
     test 58, $@ =~ /^Insecure dependency/, $@;
 
-    test 59, eval { chdir $TAINT } eq '', 'chdir';
+    test 59, eval { rmdir $TAINT } eq '', 'rmdir';
     test 60, $@ =~ /^Insecure dependency/, $@;
 
+    test 61, eval { chdir $TAINT } eq '', 'chdir';
+    test 62, $@ =~ /^Insecure dependency/, $@;
+
     if ($Config{d_chroot}) {
-	test 61, eval { chroot $TAINT } eq '', 'chroot';
-	test 62, $@ =~ /^Insecure dependency/, $@;
+	test 63, eval { chroot $TAINT } eq '', 'chroot';
+	test 64, $@ =~ /^Insecure dependency/, $@;
     }
     else {
-	for (61..62) { print "ok $_ # Skipped: chroot() is not available\n" }
+	for (63..64) { print "ok $_ # Skipped: chroot() is not available\n" }
     }
 }
 
 # Some operations using files can't use tainted data.
 {
     my $foo = "imaginary library" . $TAINT;
-    test 63, eval { require $foo } eq '', 'require';
-    test 64, $@ =~ /^Insecure dependency/, $@;
+    test 65, eval { require $foo } eq '', 'require';
+    test 66, $@ =~ /^Insecure dependency/, $@;
 
     my $filename = "./taintB$$";	# NB: $filename isn't tainted!
     END { unlink $filename if defined $filename }
     $foo = $filename . $TAINT;
     unlink $filename;	# in any case
 
-    test 65, eval { open FOO, $foo } eq '', 'open for read';
-    test 66, $@ eq '', $@;		# NB: This should be allowed
-    test 67, $! == ($Config{"archname"} !~ "djgpp" ? 2 : 22); # File not found
+    test 67, eval { open FOO, $foo } eq '', 'open for read';
+    test 68, $@ eq '', $@;		# NB: This should be allowed
+    test 69, $! == 2;			# File not found
 
-    test 68, eval { open FOO, "> $foo" } eq '', 'open for write';
-    test 69, $@ =~ /^Insecure dependency/, $@;
+    test 70, eval { open FOO, "> $foo" } eq '', 'open for write';
+    test 71, $@ =~ /^Insecure dependency/, $@;
 }
 
 # Commands to the system can't use tainted data
@@ -352,67 +359,67 @@ else {
     my $foo = $TAINT;
 
     if ($^O eq 'amigaos') {
-	for (70..73) { print "ok $_ # Skipped: open('|') is not available\n" }
+	for (72..75) { print "ok $_ # Skipped: open('|') is not available\n" }
     }
     else {
-	test 70, eval { open FOO, "| $foo" } eq '', 'popen to';
-	test 71, $@ =~ /^Insecure dependency/, $@;
-
-	test 72, eval { open FOO, "$foo |" } eq '', 'popen from';
+	test 72, eval { open FOO, "| $foo" } eq '', 'popen to';
 	test 73, $@ =~ /^Insecure dependency/, $@;
-    }
 
-    test 74, eval { exec $TAINT } eq '', 'exec';
-    test 75, $@ =~ /^Insecure dependency/, $@;
+	test 74, eval { open FOO, "$foo |" } eq '', 'popen from';
+	test 75, $@ =~ /^Insecure dependency/, $@;
+    }
 
-    test 76, eval { system $TAINT } eq '', 'system';
+    test 76, eval { exec $TAINT } eq '', 'exec';
     test 77, $@ =~ /^Insecure dependency/, $@;
 
+    test 78, eval { system $TAINT } eq '', 'system';
+    test 79, $@ =~ /^Insecure dependency/, $@;
+
     $foo = "*";
     taint_these $foo;
 
-    test 78, eval { `$echo 1$foo` } eq '', 'backticks';
-    test 79, $@ =~ /^Insecure dependency/, $@;
+    test 80, eval { `$echo 1$foo` } eq '', 'backticks';
+    test 81, $@ =~ /^Insecure dependency/, $@;
 
     if ($Is_VMS) { # wildcard expansion doesn't invoke shell, so is safe
-	test 80, join('', eval { glob $foo } ) ne '', 'globbing';
-	test 81, $@ eq '', $@;
+	test 82, join('', eval { glob $foo } ) ne '', 'globbing';
+	test 83, $@ eq '', $@;
     }
     else {
-	for (80..81) { print "ok $_ # Skipped: this is not VMS\n"; }
+	for (82..83) { print "ok $_ # Skipped: this is not VMS\n"; }
     }
 }
 
 # Operations which affect processes can't use tainted data.
 {
-    test 82, eval { kill 0, $TAINT } eq '', 'kill';
-    test 83, $@ =~ /^Insecure dependency/, $@;
+    test 84, eval { kill 0, $TAINT } eq '', 'kill';
+    test 85, $@ =~ /^Insecure dependency/, $@;
 
     if ($Config{d_setpgrp}) {
-	test 84, eval { setpgrp 0, $TAINT } eq '', 'setpgrp';
-	test 85, $@ =~ /^Insecure dependency/, $@;
+	test 86, eval { setpgrp 0, $TAINT } eq '', 'setpgrp';
+	test 87, $@ =~ /^Insecure dependency/, $@;
     }
     else {
-	for (84..85) { print "ok $_ # Skipped: setpgrp() is not available\n" }
+	for (86..87) { print "ok $_ # Skipped: setpgrp() is not available\n" }
     }
 
     if ($Config{d_setprior}) {
-	test 86, eval { setpriority 0, $TAINT, $TAINT } eq '', 'setpriority';
-	test 87, $@ =~ /^Insecure dependency/, $@;
+	test 88, eval { setpriority 0, $TAINT, $TAINT } eq '', 'setpriority';
+	test 89, $@ =~ /^Insecure dependency/, $@;
     }
     else {
-	for (86..87) { print "ok $_ # Skipped: setpriority() is not available\n" }
+	for (88..89) { print "ok $_ # Skipped: setpriority() is not available\n" }
     }
 }
 
 # Some miscellaneous operations can't use tainted data.
 {
     if ($Config{d_syscall}) {
-	test 88, eval { syscall $TAINT } eq '', 'syscall';
-	test 89, $@ =~ /^Insecure dependency/, $@;
+	test 90, eval { syscall $TAINT } eq '', 'syscall';
+	test 91, $@ =~ /^Insecure dependency/, $@;
     }
     else {
-	for (88..89) { print "ok $_ # Skipped: syscall() is not available\n" }
+	for (90..91) { print "ok $_ # Skipped: syscall() is not available\n" }
     }
 
     {
@@ -421,17 +428,17 @@ else {
 	local *FOO;
 	my $temp = "./taintC$$";
 	END { unlink $temp }
-	test 90, open(FOO, "> $temp"), "Couldn't open $temp for write: $!";
+	test 92, open(FOO, "> $temp"), "Couldn't open $temp for write: $!";
 
-	test 91, eval { ioctl FOO, $TAINT, $foo } eq '', 'ioctl';
-	test 92, $@ =~ /^Insecure dependency/, $@;
+	test 93, eval { ioctl FOO, $TAINT, $foo } eq '', 'ioctl';
+	test 94, $@ =~ /^Insecure dependency/, $@;
 
 	if ($Config{d_fcntl}) {
-	    test 93, eval { fcntl FOO, $TAINT, $foo } eq '', 'fcntl';
-	    test 94, $@ =~ /^Insecure dependency/, $@;
+	    test 95, eval { fcntl FOO, $TAINT, $foo } eq '', 'fcntl';
+	    test 96, $@ =~ /^Insecure dependency/, $@;
 	}
 	else {
-	    for (93..94) { print "ok $_ # Skipped: fcntl() is not available\n" }
+	    for (95..96) { print "ok $_ # Skipped: fcntl() is not available\n" }
 	}
 
 	close FOO;
@@ -442,65 +449,65 @@ else {
 {
     my $foo = 'abc' . $TAINT;
     my $fooref = \$foo;
-    test 95, not tainted $fooref;
-    test 96, tainted $$fooref;
-    test 97, tainted $foo;
+    test 97, not tainted $fooref;
+    test 98, tainted $$fooref;
+    test 99, tainted $foo;
 }
 
 # Some tests involving assignment
 {
     my $foo = $TAINT0;
     my $bar = $foo;
-    test 98, all_tainted $foo, $bar;
-    test 99, tainted($foo = $bar);
-    test 100, tainted($bar = $bar);
-    test 101, tainted($bar += $bar);
-    test 102, tainted($bar -= $bar);
-    test 103, tainted($bar *= $bar);
-    test 104, tainted($bar++);
-    test 105, tainted($bar /= $bar);
-    test 106, tainted($bar += 0);
-    test 107, tainted($bar -= 2);
-    test 108, tainted($bar *= -1);
-    test 109, tainted($bar /= 1);
-    test 110, tainted($bar--);
-    test 111, $bar == 0;
+    test 100, all_tainted $foo, $bar;
+    test 101, tainted($foo = $bar);
+    test 102, tainted($bar = $bar);
+    test 103, tainted($bar += $bar);
+    test 104, tainted($bar -= $bar);
+    test 105, tainted($bar *= $bar);
+    test 106, tainted($bar++);
+    test 107, tainted($bar /= $bar);
+    test 108, tainted($bar += 0);
+    test 109, tainted($bar -= 2);
+    test 110, tainted($bar *= -1);
+    test 111, tainted($bar /= 1);
+    test 112, tainted($bar--);
+    test 113, $bar == 0;
 }
 
 # Test assignment and return of lists
 {
     my @foo = ("A", "tainted" . $TAINT, "B");
-    test 112, not tainted $foo[0];
-    test 113,     tainted $foo[1];
-    test 114, not tainted $foo[2];
+    test 114, not tainted $foo[0];
+    test 115,     tainted $foo[1];
+    test 116, not tainted $foo[2];
     my @bar = @foo;
-    test 115, not tainted $bar[0];
-    test 116,     tainted $bar[1];
-    test 117, not tainted $bar[2];
+    test 117, not tainted $bar[0];
+    test 118,     tainted $bar[1];
+    test 119, not tainted $bar[2];
     my @baz = eval { "A", "tainted" . $TAINT, "B" };
-    test 118, not tainted $baz[0];
-    test 119,     tainted $baz[1];
-    test 120, not tainted $baz[2];
+    test 120, not tainted $baz[0];
+    test 121,     tainted $baz[1];
+    test 122, not tainted $baz[2];
     my @plugh = eval q[ "A", "tainted" . $TAINT, "B" ];
-    test 121, not tainted $plugh[0];
-    test 122,     tainted $plugh[1];
-    test 123, not tainted $plugh[2];
+    test 123, not tainted $plugh[0];
+    test 124,     tainted $plugh[1];
+    test 125, not tainted $plugh[2];
     my $nautilus = sub { "A", "tainted" . $TAINT, "B" };
-    test 124, not tainted ((&$nautilus)[0]);
-    test 125,     tainted ((&$nautilus)[1]);
-    test 126, not tainted ((&$nautilus)[2]);
+    test 126, not tainted ((&$nautilus)[0]);
+    test 127,     tainted ((&$nautilus)[1]);
+    test 128, not tainted ((&$nautilus)[2]);
     my @xyzzy = &$nautilus;
-    test 127, not tainted $xyzzy[0];
-    test 128,     tainted $xyzzy[1];
-    test 129, not tainted $xyzzy[2];
+    test 129, not tainted $xyzzy[0];
+    test 130,     tainted $xyzzy[1];
+    test 131, not tainted $xyzzy[2];
     my $red_october = sub { return "A", "tainted" . $TAINT, "B" };
-    test 130, not tainted ((&$red_october)[0]);
-    test 131,     tainted ((&$red_october)[1]);
-    test 132, not tainted ((&$red_october)[2]);
+    test 132, not tainted ((&$red_october)[0]);
+    test 133,     tainted ((&$red_october)[1]);
+    test 134, not tainted ((&$red_october)[2]);
     my @corge = &$red_october;
-    test 133, not tainted $corge[0];
-    test 134,     tainted $corge[1];
-    test 135, not tainted $corge[2];
+    test 135, not tainted $corge[0];
+    test 136,     tainted $corge[1];
+    test 137, not tainted $corge[2];
 }
 
 # Test for system/library calls returning string data of dubious origin.
@@ -510,7 +517,7 @@ else {
 	setpwent();
 	my @getpwent = getpwent();
 	die "getpwent: $!\n" unless (@getpwent);
-	test 136,(    not tainted $getpwent[0]
+	test 138,(    not tainted $getpwent[0]
 	          and not tainted $getpwent[1]
 	          and not tainted $getpwent[2]
 	          and not tainted $getpwent[3]
@@ -521,17 +528,17 @@ else {
 		  and not tainted $getpwent[8]);
 	endpwent();
     } else {
-	print "ok 136 # Skipped: getpwent() is not available\n";
+	print "ok 138 # Skipped: getpwent() is not available\n";
     }
 
     if ($Config{d_readdir}) { # pretty hard to imagine not
 	local(*D);
 	opendir(D, "op") or die "opendir: $!\n";
 	my $readdir = readdir(D);
-	test 137, tainted $readdir;
+	test 139, tainted $readdir;
 	closedir(OP);
     } else {
-	print "ok 137 # Skipped: readdir() is not available\n";
+	print "ok 139 # Skipped: readdir() is not available\n";
     }
 
     if ($Config{d_readlink} && $Config{d_symlink}) {
@@ -539,10 +546,10 @@ else {
 	unlink($symlink);
 	symlink("/something/naughty", $symlink) or die "symlink: $!\n";
 	my $readlink = readlink($symlink);
-	test 138, tainted $readlink;
+	test 140, tainted $readlink;
 	unlink($symlink);
     } else {
-	print "ok 138 # Skipped: readlink() or symlink() is not available\n";
+	print "ok 140 # Skipped: readlink() or symlink() is not available\n";
     }
 }
 
@@ -550,9 +557,22 @@ else {
 {
     my $why = "y";
     my $j = "x" | $why;
-    test 139, not tainted $j;
+    test 141, not tainted $j;
     $why = $TAINT."y";
     $j = "x" | $why;
-    test 140,     tainted $j;
+    test 142,     tainted $j;
 }
 
+# test target of substitution (regression bug)
+{
+    my $why = $TAINT."y";
+    $why =~ s/y/z/;
+    test 143,     tainted $why;
+
+    my $z = "[z]";
+    $why =~ s/$z/zee/;
+    test 144,     tainted $why;
+
+    $why =~ s/e/'-'.$$/ge;
+    test 145,     tainted $why;
+}
diff --git a/t/pragma/locale.t b/t/pragma/locale.t
index 8875f7caa6..bd5267d720 100755
--- a/t/pragma/locale.t
+++ b/t/pragma/locale.t
@@ -19,6 +19,9 @@ eval {
     $have_setlocale++;
 };
 
+# Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1"
+$have_setlocale = 0 if $^O eq 'MSWin32' && $Config{cc} =~ /^cl/i;
+
 print "1..", ($have_setlocale ? 102 : 98), "\n";
 
 use vars qw($a