Integrate mainline

p4raw-id: //depot/perlio@13514

17 files changed, 618 insertions, 546 deletions

diff --git a/t/TEST b/t/TEST
index 5ef012547b..481cc79d82 100755
--- a/t/TEST
+++ b/t/TEST
@@ -312,7 +312,7 @@ SHRDLU_1
    ### in the 't' directory since most (>=80%) of the tests succeeded.
 SHRDLU_2
         if (eval {require Config; import Config; 1}) {
-	    if (my $p = $Config{ldlibpthname}) {
+	    if ($Config{usedl} && (my $p = $Config{ldlibpthname})) {
 		warn <<SHRDLU_3;
    ### You may have to set your dynamic library search path,
    ### $p, to point to the build directory:
diff --git a/t/base/lex.t b/t/base/lex.t
index 54d6c93c5e..4166c18194 100755
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -53,8 +53,8 @@ $foo
 EOF
 EOE
 
-print <<`EOS` . <<\EOF;
-echo ok 12
+print <<'EOS' . <<\EOF;
+ok 12 - make sure single quotes are honored \nnot ok
 EOS
 ok 13
 EOF
diff --git a/t/base/term.t b/t/base/term.t
index 000bff1b15..2d3fe5a5e1 100755
--- a/t/base/term.t
+++ b/t/base/term.t
@@ -19,7 +19,7 @@ else {print "not ok 1\n";}
 
 # check `` processing
 
-$x = `echo hi there`;
+$x = `$^X -le "print 'hi there'"`;
 if ($x eq "hi there\n") {print "ok 2\n";} else {print "not ok 2\n";}
 
 # check $#array
diff --git a/t/comp/script.t b/t/comp/script.t
index 4891f5bae7..d70b767478 100755
--- a/t/comp/script.t
+++ b/t/comp/script.t
@@ -1,13 +1,16 @@
 #!./perl
 
-# $RCSfile: script.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:23 $
+BEGIN {
+    chdir 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+my $Perl = which_perl;
 
 print "1..3\n";
 
-$PERL = ($^O eq 'MSWin32') ? '.\perl'
-        : (($^O eq 'NetWare') ? 'perl'
-           : ($^O eq 'MacOS') ? $^X : './perl');
-$x = `$PERL -le "print 'ok';"`;
+$x = `$Perl -le "print 'ok';"`;
 
 if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";}
 
@@ -15,11 +18,11 @@ open(try,">Comp.script") || (die "Can't open temp file.");
 print try 'print "ok\n";'; print try "\n";
 close try;
 
-$x = `$PERL Comp.script`;
+$x = `$Perl Comp.script`;
 
 if ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";}
 
-$x = `$PERL <Comp.script`;
+$x = `$Perl <Comp.script`;
 
 if ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";}
 
diff --git a/t/io/open.t b/t/io/open.t
index 9b37db390c..cb8aea371f 100755
--- a/t/io/open.t
+++ b/t/io/open.t
@@ -3,304 +3,230 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
-# $RCSfile$
 $|  = 1;
 use warnings;
 $Is_VMS = $^O eq 'VMS';
-$Is_Dos = $^O eq 'dos';
 
-print "1..70\n";
+plan tests => 95;
 
-my $test = 1;
+my $Perl = which_perl();
 
-sub ok { print "ok $test\n"; $test++ }
-
-# my $file tests
-
-# 1..9
 {
     unlink("afile") if -f "afile";
-    print "$!\nnot " unless open(my $f,"+>afile");
-    ok;
+
+    $! = 0;  # the -f above will set $! if 'afile' doesn't exist.
+    ok( open(my $f,"+>afile"),  'open(my $f, "+>...")' );
+
     binmode $f;
-    print "not " unless -f "afile";
-    ok;
-    print "not " unless print $f "SomeData\n";
-    ok;
-    print "not " unless tell($f) == 9;
-    ok;
-    print "not " unless seek($f,0,0);
-    ok;
+    ok( -f "afile",             '       its a file');
+    ok( (print $f "SomeData\n"),  '       we can print to it');
+    is( tell($f), 9,            '       tell()' );
+    ok( seek($f,0,0),           '       seek set' );
+
     $b = <$f>;
-    print "not " unless $b eq "SomeData\n";
-    ok;
-    print "not " unless -f $f;
-    ok;
+    is( $b, "SomeData\n",       '       readline' );
+    ok( -f $f,                  '       still a file' );
+
     eval  { die "Message" };
-    # warn $@;
-    print "not " unless $@ =~ /<\$f> line 1/;
-    ok;
-    print "not " unless close($f);
-    ok;
-    unlink("afile");
+    like( $@, qr/<\$f> line 1/, '       die message correct' );
+    
+    ok( close($f),              '       close()' );
+    ok( unlink("afile"),        '       unlink()' );
 }
 
-# 10..12
 {
-    print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile');
-    ok;
-    print $f "a row\n";
-    print "not " unless close($f);
-    ok;
-    print "not " unless -s 'afile' < 10;
-    ok;
+    ok( open(my $f,'>', 'afile'),       "open(my \$f, '>', 'afile')" );
+    ok( (print $f "a row\n"),           '       print');
+    ok( close($f),                      '       close' );
+    ok( -s 'afile' < 10,                '       -s' );
 }
 
-# 13..15
 {
-    print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile');
-    ok;
-    print $f "a row\n";
-    print "not " unless close($f);
-    ok;
-    print "not " unless -s 'afile' > 10;
-    ok;
+    ok( open(my $f,'>>', 'afile'),      "open(my \$f, '>>', 'afile')" );
+    ok( (print $f "a row\n"),           '       print' );
+    ok( close($f),                      '       close' );
+    ok( -s 'afile' > 10,                '       -s'    );
 }
 
-# 16..18
 {
-    print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile');
-    ok;
-    @rows = <$f>;
-    print "not " unless @rows == 2;
-    ok;
-    print "not " unless close($f);
-    ok;
+    ok( open(my $f, '<', 'afile'),      "open(my \$f, '<', 'afile')" );
+    my @rows = <$f>;
+    is( scalar @rows, 2,                '       readline, list context' );
+    is( $rows[0], "a row\n",            '       first line read' );
+    is( $rows[1], "a row\n",            '       second line' );
+    ok( close($f),                      '       close' );
 }
 
-# 19..23
 {
-    print "not " unless -s 'afile' < 20;
-    ok;
-    print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile');
-    ok;
-    @rows = <$f>;
-    print "not " unless @rows == 2;
-    ok;
-    seek $f, 0, 1;
-    print $f "yet another row\n";
-    print "not " unless close($f);
-    ok;
-    print "not " unless -s 'afile' > 20;
-    ok;
+    ok( -s 'afile' < 20,                '-s' );
+
+    ok( open(my $f, '+<', 'afile'),     'open +<' );
+    my @rows = <$f>;
+    is( scalar @rows, 2,                '       readline, list context' );
+    ok( seek($f, 0, 1),                 '       seek cur' );
+    ok( (print $f "yet another row\n"), '       print' );
+    ok( close($f),                      '       close' );
+    ok( -s 'afile' > 20,                '       -s' );
 
     unlink("afile");
 }
 
-# 24..26
-if ($Is_VMS) {
-    for (24..26) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
-}
-else {
-    print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC');
-    ./perl -e "print qq(a row\n); print qq(another row\n)"
+SKIP: {
+    skip "open -| busted and noisy on VMS", 3 if $Is_VMS;
+
+    ok( open(my $f, '-|', <<EOC),     'open -|' );
+    $Perl -e "print qq(a row\n); print qq(another row\n)"
 EOC
-    ok;
-    @rows = <$f>;
-    print "not " unless @rows == 2;
-    ok;
-    print "not " unless close($f);
-    ok;
-}
 
-# 27..30
-if ($Is_VMS) {
-    for (27..30) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
+    my @rows = <$f>;
+    is( scalar @rows, 2,                '       readline, list context' );
+    ok( close($f),                      '       close' );
 }
-else {
-    print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC');
-    ./perl -pe "s/^not //"
+
+{
+    ok( open(my $f, '|-', <<EOC),     'open |-' );
+    $Perl -pe "s/^not //"
 EOC
-    ok;
-    @rows = <$f>;
-    print $f "not ok $test\n"; $test++;
-    print $f "not ok $test\n"; $test++;
-    print "#\nnot " unless close($f);
+
+    my @rows = <$f>;
+    my $test = curr_test;
+    print $f "not ok $test - piped in\n";
+    next_test;
+
+    $test = curr_test;
+    print $f "not ok $test - piped in\n";
+    next_test;
+    ok( close($f),                      '       close' );
     sleep 1;
-    ok;
+    pass('flushing');
 }
 
-# 31..32
-eval <<'EOE' and print "not ";
-open my $f, '<&', 'afile';
-1;
-EOE
-ok;
-$@ =~ /Bad filehandle:\s+afile/ or print "not ";
-ok;
 
-# local $file tests
+ok( !eval { open my $f, '<&', 'afile'; 1; },    '<& on a non-filehandle' );
+like( $@, qr/Bad filehandle:\s+afile/,          '       right error' );
 
-# 33..41
+
+# local $file tests
 {
     unlink("afile") if -f "afile";
-    print "$!\nnot " unless open(local $f,"+>afile");
-    ok;
+
+    ok( open(local $f,"+>afile"),       'open local $f, "+>", ...' );
     binmode $f;
-    print "not " unless -f "afile";
-    ok;
-    print "not " unless print $f "SomeData\n";
-    ok;
-    print "not " unless tell($f) == 9;
-    ok;
-    print "not " unless seek($f,0,0);
-    ok;
+
+    ok( -f "afile",                     '       -f' );
+    ok( (print $f "SomeData\n"),        '       print' );
+    is( tell($f), 9,                    '       tell' );
+    ok( seek($f,0,0),                   '       seek set' );
+
     $b = <$f>;
-    print "not " unless $b eq "SomeData\n";
-    ok;
-    print "not " unless -f $f;
-    ok;
+    is( $b, "SomeData\n",               '       readline' );
+    ok( -f $f,                          '       still a file' );
+
     eval  { die "Message" };
-    # warn $@;
-    print "not " unless $@ =~ /<\$f> line 1/;
-    ok;
-    print "not " unless close($f);
-    ok;
+    like( $@, qr/<\$f> line 1/,         '       proper die message' );
+    ok( close($f),                      '       close' );
+
     unlink("afile");
 }
 
-# 42..44
 {
-    print "# \$!='$!'\nnot " unless open(local $f,'>', 'afile');
-    ok;
-    print $f "a row\n";
-    print "not " unless close($f);
-    ok;
-    print "not " unless -s 'afile' < 10;
-    ok;
+    ok( open(local $f,'>', 'afile'),    'open local $f, ">", ...' );
+    ok( (print $f "a row\n"),           '       print');
+    ok( close($f),                      '       close');
+    ok( -s 'afile' < 10,                '       -s' );
 }
 
-# 45..47
 {
-    print "# \$!='$!'\nnot " unless open(local $f,'>>', 'afile');
-    ok;
-    print $f "a row\n";
-    print "not " unless close($f);
-    ok;
-    print "not " unless -s 'afile' > 10;
-    ok;
+    ok( open(local $f,'>>', 'afile'),   'open local $f, ">>", ...' );
+    ok( (print $f "a row\n"),           '       print');
+    ok( close($f),                      '       close');
+    ok( -s 'afile' > 10,                '       -s' );
 }
 
-# 48..50
 {
-    print "# \$!='$!'\nnot " unless open(local $f, '<', 'afile');
-    ok;
-    @rows = <$f>;
-    print "not " unless @rows == 2;
-    ok;
-    print "not " unless close($f);
-    ok;
+    ok( open(local $f, '<', 'afile'),   'open local $f, "<", ...' );
+    my @rows = <$f>;
+    is( scalar @rows, 2,                '       readline list context' );
+    ok( close($f),                      '       close' );
 }
 
-# 51..55
+ok( -s 'afile' < 20,                '       -s' );
+
 {
-    print "not " unless -s 'afile' < 20;
-    ok;
-    print "# \$!='$!'\nnot " unless open(local $f, '+<', 'afile');
-    ok;
-    @rows = <$f>;
-    print "not " unless @rows == 2;
-    ok;
-    seek $f, 0, 1;
-    print $f "yet another row\n";
-    print "not " unless close($f);
-    ok;
-    print "not " unless -s 'afile' > 20;
-    ok;
+    ok( open(local $f, '+<', 'afile'),  'open local $f, "+<", ...' );
+    my @rows = <$f>;
+    is( scalar @rows, 2,                '       readline list context' );
+    ok( seek($f, 0, 1),                 '       seek cur' );
+    ok( (print $f "yet another row\n"), '       print' );
+    ok( close($f),                      '       close' );
+    ok( -s 'afile' > 20,                '       -s' );
 
     unlink("afile");
 }
 
-# 56..58
-if ($Is_VMS) {
-    for (56..58) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
-}
-else {
-    print "# \$!='$!'\nnot " unless open(local $f, '-|', <<'EOC');
-    ./perl -e "print qq(a row\n); print qq(another row\n)"
+SKIP: {
+    skip "open -| busted and noisy on VMS", 3 if $Is_VMS;
+
+    ok( open(local $f, '-|', <<EOC),  'open local $f, "-|", ...' );
+    $Perl -e "print qq(a row\n); print qq(another row\n)"
 EOC
-    ok;
-    @rows = <$f>;
-    print "not " unless @rows == 2;
-    ok;
-    print "not " unless close($f);
-    ok;
-}
+    my @rows = <$f>;
 
-# 59..62
-if ($Is_VMS) {
-    for (59..62) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
+    is( scalar @rows, 2,                '       readline list context' );
+    ok( close($f),                      '       close' );
 }
-else {
-    print "# \$!='$!'\nnot " unless open(local $f, '|-', <<'EOC');
-    ./perl -pe "s/^not //"
+
+{
+    ok( open(local $f, '|-', <<EOC),  'open local $f, "|-", ...' );
+    $Perl -pe "s/^not //"
 EOC
-    ok;
-    @rows = <$f>;
-    print $f "not ok $test\n"; $test++;
-    print $f "not ok $test\n"; $test++;
-    print "#\nnot " unless close($f);
+
+    my @rows = <$f>;
+    my $test = curr_test;
+    print $f "not ok $test - piping\n";
+    next_test;
+
+    $test = curr_test;
+    print $f "not ok $test - piping\n";
+    next_test;
+    ok( close($f),                      '       close' );
     sleep 1;
-    ok;
+    pass("Flush");
 }
 
-# 63..64
-eval <<'EOE' and print "not ";
-open local $f, '<&', 'afile';
-1;
-EOE
-ok;
-$@ =~ /Bad filehandle:\s+afile/ or print "not ";
-ok;
 
-# 65..66
+ok( !eval { open local $f, '<&', 'afile'; 1 },  'local <& on non-filehandle');
+like( $@, qr/Bad filehandle:\s+afile/,          '       right error' );
+
+
 {
     local *F;
     for (1..2) {
-        if ($Is_Dos) {
-        open(F, "echo \\#foo|") or print "not ";
-        } else {
-            open(F, "echo #foo|") or print "not ";
-        }
-	print <F>;
-	close F;
+        ok( open(F, qq{$Perl -le "print 'ok'"|}), 'open to pipe' );
+	is(scalar <F>, "ok\n",  '       readline');
+        ok( close F,            '       close' );
     }
-    ok;
+
     for (1..2) {
-        if ($Is_Dos) {
-	open(F, "-|", "echo \\#foo") or print "not ";
-        } else {
-            open(F, "-|", "echo #foo") or print "not ";
-        }
-	print <F>;
-	close F;
+        ok( open(F, "-|", qq{$Perl -le "print 'ok'"}), 'open -|');
+        is( scalar <F>, "ok\n", '       readline');
+	ok( close F,            '       close' );
     }
-    ok;
 }
 
-# 67..70 - magic temporary file via 3 arg open with undef
+# magic temporary file via 3 arg open with undef
 {
-    open(my $x,"+<",undef) or print "not ";
-    ok;
-    print "not " unless defined(fileno($x));
-    ok;
+    ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef');
+    ok( defined fileno($x),     '       fileno' );
+
     select $x;
-    ok;   # goes to $x
+    ok( (print "ok\n"),         '       print' );
+
     select STDOUT;
-    seek($x,0,0);
-    print <$x>;
-    print "not " unless tell($x) > 3;
-    ok;
+    ok( seek($x,0,0),           '       seek' );
+    is( scalar <$x>, "ok\n",    '       readline' );
+    ok( tell($x) >= 3,          '       tell' );
 }
diff --git a/t/lib/Math/BigFloat/Subclass.pm b/t/lib/Math/BigFloat/Subclass.pm
index 7a1c2790cc..209aa1df9d 100644
--- a/t/lib/Math/BigFloat/Subclass.pm
+++ b/t/lib/Math/BigFloat/Subclass.pm
@@ -24,9 +24,10 @@ sub new
         my $proto  = shift;
         my $class  = ref($proto) || $proto;
 
-        my $value       = shift || 0;   # Set to 0 if not provided
-        my $decimal     = shift;
-        my $radix       = 0;
+        my $value       = shift;
+	# Set to 0 if not provided, but don't use || (this would trigger for
+	# a passed objects to see if they are zero)
+	$value 	= 0 if !defined $value;   
 
         # Store the floating point value
         my $self = bless Math::BigFloat->new($value), $class;
diff --git a/t/lib/Math/BigInt/BareCalc.pm b/t/lib/Math/BigInt/BareCalc.pm
new file mode 100644
index 0000000000..9cc7e94430
--- /dev/null
+++ b/t/lib/Math/BigInt/BareCalc.pm
@@ -0,0 +1,35 @@
+package Math::BigInt::BareCalc;
+
+use 5.005;
+use strict;
+# use warnings;	# dont use warnings for older Perls
+
+require Exporter;
+use vars qw/@ISA $VERSION/;
+@ISA = qw(Exporter);
+
+$VERSION = '0.02';
+
+# Package to to test Bigint's simulation of Calc
+
+# uses Calc, but only features the strictly necc. methods.
+
+use Math::BigInt::Calc v0.17;
+
+BEGIN
+  {
+  foreach (qw/	base_len new zero one two copy str num add sub mul div inc dec
+		acmp len digit zeros
+		is_zero is_one is_odd is_even is_one check
+		/)
+    {
+    my $name  = "Math::BigInt::Calc::_$_";
+    no strict 'refs';
+    *{"Math::BigInt::BareCalc::_$_"} = \&$name;
+    }
+  }
+
+# catch and throw away
+sub import { }
+
+1;
diff --git a/t/lib/Math/BigInt/Subclass.pm b/t/lib/Math/BigInt/Subclass.pm
index 79a4957d5b..3656b9ff11 100644
--- a/t/lib/Math/BigInt/Subclass.pm
+++ b/t/lib/Math/BigInt/Subclass.pm
@@ -25,9 +25,8 @@ sub new
         my $proto  = shift;
         my $class  = ref($proto) || $proto;
 
-        my $value       = shift;	# no || 0 here!
-        my $decimal     = shift;
-        my $radix       = 0;
+        my $value       = shift;
+	$value 		= 0 if !defined $value; 	# no || 0 here!
 
         # Store the floating point value
         my $self = bless Math::BigInt->new($value), $class;
diff --git a/t/lib/strict/subs b/t/lib/strict/subs
index ed4fe7a443..1e8b0588d8 100644
--- a/t/lib/strict/subs
+++ b/t/lib/strict/subs
@@ -317,3 +317,11 @@ Foo A 1
 Foo B 2
 Foo C 3
 Foo D 4
+########
+
+# Check that barewords on the RHS of a regex match are caught
+use strict;
+"" =~ foo;
+EXPECT
+Bareword "foo" not allowed while "strict subs" in use at - line 4.
+Execution of - aborted due to compilation errors.
diff --git a/t/op/exec.t b/t/op/exec.t
index 2defb47db4..1be58fe5cc 100755
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -1,54 +1,80 @@
 #!./perl
 
+BEGIN: {
+    chdir 't' if -d 't';
+    @INC = ('../lib');
+    require './test.pl';
+}
+
+# supress VMS whinging about bad execs.
+use vmsish qw(hushed);
+
 $| = 1;				# flush stdout
 
 $ENV{LC_ALL}   = 'C';		# Forge English error messages.
 $ENV{LANGUAGE} = 'C';		# Ditto in GNU.
 
-if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
-    # XXX the system tests could be written to use ./perl and so work on Win32
-    print "1..0 # Skip: shh, win32\n";
-    exit(0);
-}
+plan(tests => 14);
+
+my $Perl = which_perl();
 
-if ($^O eq 'MacOS') {
-    # XXX the system tests could be written to use ./perl and so work on Win32
-    print "1..0 # Mostly useless tests for Mac OS\n";
-    exit(0);
+my $exit;
+SKIP: {
+    skip("bug/feature of pdksh", 2) if $^O eq 'os2';
+
+    $exit = system qq{$Perl -le "print q{ok 1 - interpreted system(EXPR)"}};
+    next_test();
+    is( $exit, 0, '  exited 0' );
 }
 
-print "1..8\n";
+$exit = system qq{$Perl -le "print q{ok 3 - split & direct call system(EXPR)"}};
+next_test();
+is( $exit, 0, '  exited 0' );
+
+# On VMS you need the quotes around the program or it won't work.
+# On Unix its the opposite.
+my $quote = $^O eq 'VMS' ? '"' : '';
+$exit = system $Perl, '-le', 
+               "${quote}print q{ok 5 - system(PROG, LIST)}${quote}";
+next_test();
+is( $exit, 0, '  exited 0' );
+
+
+is( system(qq{$Perl -e "exit 0"}), 0,     'Explicit exit of 0' );
 
-if ($^O ne 'os2') {
-  print "not ok 1\n" if system "echo ok \\1";	# shell interpreted
-} 
-else {
-  print "ok 1 # skipped: bug/feature of pdksh\n"; # shell interpreted
+my $exit_one = $^O eq 'VMS' ? 4 << 8 : 1 << 8;
+is( system(qq{$Perl "-I../lib" -e "use vmsish qw(hushed); exit 1"}), $exit_one,
+    'Explicit exit of 1' );
+
+
+$rc = system "lskdfj";
+unless( ok($rc == 255 << 8 or $rc == -1 or $rc == 256) ) {
+    print "# \$rc == $rc\n";
+}
+
+unless ( ok( $! == 2  or  $! =~ /\bno\b.*\bfile/i or  
+             $! == 13 or  $! =~ /permission denied/i or
+             $! == 22 or  $! =~ /invalid argument/           ) ) {
+    printf "# \$! eq %d, '%s'\n", $!, $!;
 }
-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 ($^O eq 'mpeix') {
-    print "ok 5 # skipped: status broken on MPE/iX\n";
-} else {
-    if ((system "/bin/sh -c 'exit 1'") != 256) { print "not "; }
-    print "ok 5\n";
+is( `$Perl -le "print 'ok'"`,   "ok\n",     'basic ``' );
+is( <<`END`,                    "ok\n",     '<<`HEREDOC`' );
+$Perl -le "print 'ok'"
+END
+
+
+TODO: {
+    if( $^O =~ /Win32/ ) {
+        print "not ok 11 - exec failure doesn't terminate process # TODO Win32 exec failure waits for user input\n";
+        last TODO;
+    }
+
+    ok( !exec("lskdjfalksdjfdjfkls"), 
+        "exec failure doesn't terminate process");
 }
 
-$rc = system "lskdfj";
-if ($rc == 255 << 8 or $rc == -1 and
-     (
-      $! == 2 or
-      $! =~ /\bno\b.*\bfile/i or
-      $! == 13 or
-      $! =~ /permission denied/i
-     )
-   )
- {print "ok 6\n";} else {print "not ok 6\n";}
-
-unless (exec "lskdjfalksdjfdjfkls") {print "ok 7\n";} else {print "not ok 7\n";}
-
-exec "echo","ok","8";
+my $test = curr_test();
+exec $Perl, '-le', qq{${quote}print 'ok $test - exec PROG, LIST'${quote}};
+fail("This should never be reached if the exec() worked");
diff --git a/t/op/inc.t b/t/op/inc.t
index f59115e760..f360c031fe 100755
--- a/t/op/inc.t
+++ b/t/op/inc.t
@@ -1,97 +1,153 @@
-#!./perl
+#!./perl -w
 
-print "1..12\n";
+# use strict;
+
+print "1..24\n";
+
+my $test = 1;
+
+sub ok {
+  my ($pass, $wrong, $err) = @_;
+  if ($pass) {
+    print "ok $test\n";
+    $test = $test + 1; # Would be doubleplusbad to use ++ in the ++ test.
+    return 1;
+  } else {
+    if ($err) {
+      chomp $err;
+      print "not ok $test # $err\n";
+    } else {
+      if (defined $wrong) {
+        $wrong = ", got $wrong";
+      } else {
+        $wrong = '';
+      }
+      printf "not ok $test # line %d$wrong\n", (caller)[2];
+    }
+  }
+  $test = $test + 1;
+  return;
+}
 
 # Verify that addition/subtraction properly upgrade to doubles.
 # These tests are only significant on machines with 32 bit longs,
 # and two's complement negation, but shouldn't fail anywhere.
 
-$a = 2147483647;
-$c=$a++;
-if ($a == 2147483648) 
-	{print "ok 1\n"}
-else
-	{print "not ok 1\n";}
+my $a = 2147483647;
+my $c=$a++;
+ok ($a == 2147483648, $a);
 
 $a = 2147483647;
 $c=++$a;
-if ($a == 2147483648) 
-	{print "ok 2\n"}
-else
-	{print "not ok 2\n";}
+ok ($a == 2147483648, $a);
 
 $a = 2147483647;
 $a=$a+1;
-if ($a == 2147483648) 
-	{print "ok 3\n"}
-else
-	{print "not ok 3\n";}
+ok ($a == 2147483648, $a);
 
 $a = -2147483648;
 $c=$a--;
-if ($a == -2147483649) 
-	{print "ok 4\n"}
-else
-	{print "not ok 4\n";}
+ok ($a == -2147483649, $a);
 
 $a = -2147483648;
 $c=--$a;
-if ($a == -2147483649) 
-	{print "ok 5\n"}
-else
-	{print "not ok 5\n";}
+ok ($a == -2147483649, $a);
 
 $a = -2147483648;
 $a=$a-1;
-if ($a == -2147483649) 
-	{print "ok 6\n"}
-else
-	{print "not ok 6\n";}
+ok ($a == -2147483649, $a);
 
 $a = 2147483648;
 $a = -$a;
 $c=$a--;
-if ($a == -2147483649) 
-	{print "ok 7\n"}
-else
-	{print "not ok 7\n";}
+ok ($a == -2147483649, $a);
 
 $a = 2147483648;
 $a = -$a;
 $c=--$a;
-if ($a == -2147483649) 
-	{print "ok 8\n"}
-else
-	{print "not ok 8\n";}
+ok ($a == -2147483649, $a);
 
 $a = 2147483648;
 $a = -$a;
 $a=$a-1;
-if ($a == -2147483649) 
-	{print "ok 9\n"}
-else
-	{print "not ok 9\n";}
+ok ($a == -2147483649, $a);
 
 $a = 2147483648;
 $b = -$a;
 $c=$b--;
-if ($b == -$a-1) 
-	{print "ok 10\n"}
-else
-	{print "not ok 10\n";}
+ok ($b == -$a-1, $a);
 
 $a = 2147483648;
 $b = -$a;
 $c=--$b;
-if ($b == -$a-1) 
-	{print "ok 11\n"}
-else
-	{print "not ok 11\n";}
+ok ($b == -$a-1, $a);
 
 $a = 2147483648;
 $b = -$a;
 $b=$b-1;
-if ($b == -(++$a)) 
-	{print "ok 12\n"}
-else
-	{print "not ok 12\n";}
+ok ($b == -(++$a), $a);
+
+# Verify that shared hash keys become unshared.
+
+sub check_same {
+  my ($orig, $suspect) = @_;
+  my $fail;
+  while (my ($key, $value) = each %$suspect) {
+    if (exists $orig->{$key}) {
+      if ($orig->{$key} ne $value) {
+        print "# key '$key' was '$orig->{$key}' now '$value'\n";
+        $fail = 1;
+      }
+    } else {
+      print "# key '$key' is '$orig->{$key}', unexpect.\n";
+      $fail = 1;
+    }
+  }
+  foreach (keys %$orig) {
+    next if (exists $suspect->{$_});
+    print "# key '$_' was '$orig->{$_}' now missing\n";
+    $fail = 1;
+  }
+  ok (!$fail);
+}
+
+my (%orig) = my (%inc) = my (%dec) = my (%postinc) = my (%postdec)
+  = (1 => 1, ab => "ab");
+my %up = (1=>2, ab => 'ac');
+my %down = (1=>0, ab => -1);
+
+foreach (keys %inc) {
+  my $ans = $up{$_};
+  my $up;
+  eval {$up = ++$_};
+  ok ((defined $up and $up eq $ans), $up, $@);
+}
+
+check_same (\%orig, \%inc);
+
+foreach (keys %dec) {
+  my $ans = $down{$_};
+  my $down;
+  eval {$down = --$_};
+  ok ((defined $down and $down eq $ans), $down, $@);
+}
+
+check_same (\%orig, \%dec);
+
+foreach (keys %postinc) {
+  my $ans = $postinc{$_};
+  my $up;
+  eval {$up = $_++};
+  ok ((defined $up and $up eq $ans), $up, $@);
+}
+
+check_same (\%orig, \%postinc);
+
+foreach (keys %postdec) {
+  my $ans = $postdec{$_};
+  my $down;
+  eval {$down = $_--};
+  ok ((defined $down and $down eq $ans), $down, $@);
+}
+
+check_same (\%orig, \%postdec);
diff --git a/t/op/magic.t b/t/op/magic.t
index 4f386231fc..f9df5bdfe0 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -250,10 +250,7 @@ else {
 			    : (`echo \$__NoNeSuCh` eq "foo\n") );
 }
 
-if ($Is_VMS) {
-    ok(1,0,"'\$!=undef' does throw a warning");
-}
-else {
+{
     local $SIG{'__WARN__'} = sub { print "# @_\nnot " };
     $! = undef;
     ok 1;
diff --git a/t/op/re_tests b/t/op/re_tests
index c7ab5ad814..3d939a6635 100644
--- a/t/op/re_tests
+++ b/t/op/re_tests
@@ -796,3 +796,4 @@ ab(?i)cd	abCd	y	-	-
 (A|B)*(?(1)(CD)|(CD))	ABCD	y	$2-$3	CD-
 (A|B)*?(?(1)(CD)|(CD))	CD	y	$2-$3	-CD	# [ID 20010803.016]
 (A|B)*?(?(1)(CD)|(CD))	ABCD	y	$2-$3	CD-
+'^(o)(?!.*\1)'i	Oo	n	-	-
diff --git a/t/op/ref.t b/t/op/ref.t
index 613c4504e0..4b1d6e37a7 100755
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -2,7 +2,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(.);
+    @INC = qw(. ../lib);
 }
 
 print "1..62\n";
diff --git a/t/op/tr.t b/t/op/tr.t
index 124c08a94e..b37eb7f186 100755
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@ -3,26 +3,26 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
-print "1..70\n";
+plan tests => 97;
+
+my $Is_EBCDIC = (ord('i') == 0x89 & ord('J') == 0xd1);
 
 $_ = "abcdefghijklmnopqrstuvwxyz";
 
 tr/a-z/A-Z/;
 
-print "not " unless $_ eq "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
-print "ok 1\n";
+is($_, "ABCDEFGHIJKLMNOPQRSTUVWXYZ",    'uc');
 
 tr/A-Z/a-z/;
 
-print "not " unless $_ eq "abcdefghijklmnopqrstuvwxyz";
-print "ok 2\n";
+is($_, "abcdefghijklmnopqrstuvwxyz",    'lc');
 
 tr/b-y/B-Y/;
+is($_, "aBCDEFGHIJKLMNOPQRSTUVWXYz",    'partial uc');
 
-print "not " unless $_ eq "aBCDEFGHIJKLMNOPQRSTUVWXYz";
-print "ok 3\n";
 
 # In EBCDIC 'I' is \xc9 and 'J' is \0xd1, 'i' is \x89 and 'j' is \x91.
 # Yes, discontinuities.  Regardless, the \xca in the below should stay
@@ -33,150 +33,154 @@ print "ok 3\n";
 
     tr/I-J/i-j/;
 
-    print "not " unless $_ eq "i\xcaj";
-    print "ok 4\n";
+    is($_, "i\xcaj",    'EBCDIC discontinuity');
 }
 #
 
-# make sure that tr cancels IOK and NOK
+
 ($x = 12) =~ tr/1/3/;
 (my $y = 12) =~ tr/1/3/;
 ($f = 1.5) =~ tr/1/3/;
 (my $g = 1.5) =~ tr/1/3/;
-print "not " unless $x + $y + $f + $g == 71;
-print "ok 5\n";
+is($x + $y + $f + $g, 71,   'tr cancels IOK and NOK');
+
 
-# make sure tr is harmless if not updating  -  see [ID 20000511.005]
+# perlbug [ID 20000511.005]
 $_ = 'fred';
 /([a-z]{2})/;
 $1 =~ tr/A-Z//;
 s/^(\s*)f/$1F/;
-print "not " if $_ ne 'Fred';
-print "ok 6\n";
+is($_, 'Fred',  'harmless if explicitly not updating');
+
+
+# A variant of the above, added in 5.7.2
+$_ = 'fred';
+/([a-z]{2})/;
+eval '$1 =~ tr/A-Z/A-Z/;';
+s/^(\s*)f/$1F/;
+is($_, 'Fred',  'harmless if implicitly not updating');
+is($@, '',      '    no error');
+
 
 # check tr handles UTF8 correctly
 ($x = 256.65.258) =~ tr/a/b/;
-print "not " if $x ne 256.65.258 or length $x != 3;
-print "ok 7\n";
+is($x, 256.65.258,  'handles UTF8');
+is(length $x, 3);
+
 $x =~ tr/A/B/;
+is(length $x, 3);
 if (ord("\t") == 9) { # ASCII
-    print "not " if $x ne 256.66.258 or length $x != 3;
+    is($x, 256.66.258);
 }
 else {
-    print "not " if $x ne 256.65.258 or length $x != 3;
+    is($x, 256.65.258);
 }
-print "ok 8\n";
+
 # EBCDIC variants of the above tests
 ($x = 256.193.258) =~ tr/a/b/;
-print "not " if $x ne 256.193.258 or length $x != 3;
-print "ok 9\n";
+is(length $x, 3);
+is($x, 256.193.258);
+
 $x =~ tr/A/B/;
+is(length $x, 3);
 if (ord("\t") == 9) { # ASCII
-    print "not " if $x ne 256.193.258 or length $x != 3;
+    is($x, 256.193.258);
 }
 else {
-    print "not " if $x ne 256.194.258 or length $x != 3;
+    is($x, 256.194.258);
 }
-print "ok 10\n";
+
 
 {
-# 11 - changing UTF8 characters in a UTF8 string, same length.
-my $l = chr(300); my $r = chr(400);
-$x = 200.300.400;
-$x =~ tr/\x{12c}/\x{190}/;
-printf "not (%vd) ", $x if $x ne 200.400.400 or length $x != 3;
-print "ok 11\n";
-
-# 12 - changing UTF8 characters in UTF8 string, more bytes.
-$x = 200.300.400;
-$x =~ tr/\x{12c}/\x{be8}/;
-printf "not (%vd) ", $x if $x ne 200.3048.400 or length $x != 3;
-print "ok 12\n";
-
-# 13 - introducing UTF8 characters to non-UTF8 string.
-$x = 100.125.60;
-$x =~ tr/\x{64}/\x{190}/;
-printf "not (%vd) ", $x if $x ne 400.125.60 or length $x != 3;
-print "ok 13\n";
-
-# 14 - removing UTF8 characters from UTF8 string
-$x = 400.125.60;
-$x =~ tr/\x{190}/\x{64}/;
-printf "not (%vd) ", $x if $x ne 100.125.60 or length $x != 3;
-print "ok 14\n";
-
-# 15 - counting UTF8 chars in UTF8 string
-$x = 400.125.60.400;
-$y = $x =~ tr/\x{190}/\x{190}/;
-print "not " if $y != 2;
-print "ok 15\n";
-
-# 16 - counting non-UTF8 chars in UTF8 string
-$x = 60.400.125.60.400;
-$y = $x =~ tr/\x{3c}/\x{3c}/;
-print "not " if $y != 2;
-print "ok 16\n";
-
-# 17 - counting UTF8 chars in non-UTF8 string
-$x = 200.125.60;
-$y = $x =~ tr/\x{190}/\x{190}/;
-print "not " if $y != 0;
-print "ok 17\n";
+    my $l = chr(300); my $r = chr(400);
+    $x = 200.300.400;
+    $x =~ tr/\x{12c}/\x{190}/;
+    is($x, 200.400.400,     
+                        'changing UTF8 chars in a UTF8 string, same length');
+    is(length $x, 3);
+
+    $x = 200.300.400;
+    $x =~ tr/\x{12c}/\x{be8}/;
+    is($x, 200.3048.400,    '    more bytes');
+    is(length $x, 3);
+
+    $x = 100.125.60;
+    $x =~ tr/\x{64}/\x{190}/;
+    is($x, 400.125.60,      'Putting UT8 chars into a non-UTF8 string');
+    is(length $x, 3);
+
+    $x = 400.125.60;
+    $x =~ tr/\x{190}/\x{64}/;
+    is($x, 100.125.60,      'Removing UTF8 chars from UTF8 string');
+    is(length $x, 3);
+
+    $x = 400.125.60.400;
+    $y = $x =~ tr/\x{190}/\x{190}/;
+    is($y, 2,               'Counting UTF8 chars in UTF8 string');
+
+    $x = 60.400.125.60.400;
+    $y = $x =~ tr/\x{3c}/\x{3c}/;
+    is($y, 2,               '         non-UTF8 chars in UTF8 string');
+
+    # 17 - counting UTF8 chars in non-UTF8 string
+    $x = 200.125.60;
+    $y = $x =~ tr/\x{190}/\x{190}/;
+    is($y, 0,               '         UTF8 chars in non-UTFs string');
 }
 
-# 18: test brokenness with tr/a-z-9//;
 $_ = "abcdefghijklmnopqrstuvwxyz";
-eval "tr/a-z-9/ /";
-print (($@ =~ /^Ambiguous range in transliteration operator/) 
-       ? '' : 'not ', "ok 18\n");
+eval 'tr/a-z-9/ /';
+like($@, qr/^Ambiguous range in transliteration operator/,  'tr/a-z-9//');
 
 # 19-21: Make sure leading and trailing hyphens still work
 $_ = "car-rot9";
 tr/-a-m/./;
-print (($_ eq '..r.rot9') ? '' : 'not ', "ok 19\n");
+is($_, '..r.rot9',  'hyphens, leading');
 
 $_ = "car-rot9";
 tr/a-m-/./;
-print (($_ eq '..r.rot9') ? '' : 'not ', "ok 20\n");
+is($_, '..r.rot9',  '   trailing');
 
 $_ = "car-rot9";
 tr/-a-m-/./;
-print (($_ eq '..r.rot9') ? '' : 'not ', "ok 21\n");
+is($_, '..r.rot9',  '   both');
 
 $_ = "abcdefghijklmnop";
 tr/ae-hn/./;
-print (($_ eq '.bcd....ijklm.op') ? '' : 'not ', "ok 22\n");
+is($_, '.bcd....ijklm.op');
 
 $_ = "abcdefghijklmnop";
 tr/a-cf-kn-p/./;
-print (($_ eq '...de......lm...') ? '' : 'not ', "ok 23\n");
+is($_, '...de......lm...');
 
 $_ = "abcdefghijklmnop";
 tr/a-ceg-ikm-o/./;
-print (($_ eq '...d.f...j.l...p') ? '' : 'not ', "ok 24\n");
+is($_, '...d.f...j.l...p');
+
 
-# 25: Test reversed range check
 # 20000705 MJD
 eval "tr/m-d/ /";
-print (($@ =~ /^Invalid \[\] range "m-d" in transliteration operator/) 
-       ? '' : 'not ', "ok 25\n");
+like($@, qr/^Invalid \[\] range "m-d" in transliteration operator/,
+              'reversed range check');
 
-# 26: test cannot update if read-only
 eval '$1 =~ tr/x/y/';
-print (($@ =~ /^Modification of a read-only value attempted/) ? '' : 'not ',
-       "ok 26\n");
+like($@, qr/^Modification of a read-only value attempted/,
+              'cannot update read-only var');
 
-# 27: test can count read-only
 'abcdef' =~ /(bcd)/;
-print (( eval '$1 =~ tr/abcd//' == 3) ? '' : 'not ', "ok 27\n");
+is(eval '$1 =~ tr/abcd//', 3,  'explicit read-only count');
+is($@, '',                      '    no error');
 
-# 28: test lhs OK if not updating
-print ((eval '"123" =~ tr/12//' == 2) ? '' : 'not ', "ok 28\n");
+'abcdef' =~ /(bcd)/;
+is(eval '$1 =~ tr/abcd/abcd/', 3,  'implicit read-only count');
+is($@, '',                      '    no error');
+
+is(eval '"123" =~ tr/12//', 2,     'LHS of non-updating tr');
+
+eval '"123" =~ tr/1/2/';
+like($@, qr|^Can't modify constant item in transliteration \(tr///\)|,
+         'LHS bad on updating tr');
 
-# 29: test lhs bad if updating
-eval '"123" =~ tr/1/1/';
-print (($@ =~ m|^Can't modify constant item in transliteration \(tr///\)|)
-       ? '' : 'not ', "ok 29\n");
 
 # v300 (0x12c) is UTF-8-encoded as 196 172 (0xc4 0xac)
 # v400 (0x190) is UTF-8-encoded as 198 144 (0xc6 0x90)
@@ -184,144 +188,108 @@ print (($@ =~ m|^Can't modify constant item in transliteration \(tr///\)|)
 # Transliterate a byte to a byte, all four ways.
 
 ($a = v300.196.172.300.196.172) =~ tr/\xc4/\xc5/;
-print "not " unless $a eq v300.197.172.300.197.172;
-print "ok 30\n";
+is($a, v300.197.172.300.197.172,    'byte2byte transliteration');
 
 ($a = v300.196.172.300.196.172) =~ tr/\xc4/\x{c5}/;
-print "not " unless $a eq v300.197.172.300.197.172;
-print "ok 31\n";
+is($a, v300.197.172.300.197.172);
 
 ($a = v300.196.172.300.196.172) =~ tr/\x{c4}/\xc5/;
-print "not " unless $a eq v300.197.172.300.197.172;
-print "ok 32\n";
+is($a, v300.197.172.300.197.172);
 
 ($a = v300.196.172.300.196.172) =~ tr/\x{c4}/\x{c5}/;
-print "not " unless $a eq v300.197.172.300.197.172;
-print "ok 33\n";
+is($a, v300.197.172.300.197.172);
 
-# Transliterate a byte to a wide character.
 
 ($a = v300.196.172.300.196.172) =~ tr/\xc4/\x{12d}/;
-print "not " unless $a eq v300.301.172.300.301.172;
-print "ok 34\n";
-
-# Transliterate a wide character to a byte.
+is($a, v300.301.172.300.301.172,    'byte2wide transliteration');
 
 ($a = v300.196.172.300.196.172) =~ tr/\x{12c}/\xc3/;
-print "not " unless $a eq v195.196.172.195.196.172;
-print "ok 35\n";
-
-# Transliterate a wide character to a wide character.
+is($a, v195.196.172.195.196.172,    '   wide2byte');
 
 ($a = v300.196.172.300.196.172) =~ tr/\x{12c}/\x{12d}/;
-print "not " unless $a eq v301.196.172.301.196.172;
-print "ok 36\n";
+is($a, v301.196.172.301.196.172,    '   wide2wide');
 
-# Transliterate both ways.
 
 ($a = v300.196.172.300.196.172) =~ tr/\xc4\x{12c}/\x{12d}\xc3/;
-print "not " unless $a eq v195.301.172.195.301.172;
-print "ok 37\n";
+is($a, v195.301.172.195.301.172,    'byte2wide & wide2byte');
 
-# Transliterate all (four) ways.
 
 ($a = v300.196.172.300.196.172.400.198.144) =~
 	tr/\xac\xc4\x{12c}\x{190}/\xad\x{12d}\xc5\x{191}/;
-print "not " unless $a eq v197.301.173.197.301.173.401.198.144;
-print "ok 38\n";
+is($a, v197.301.173.197.301.173.401.198.144,    'all together now!');
 
-# Transliterate and count.
 
-print "not "
-    unless (($a = v300.196.172.300.196.172) =~ tr/\xc4/\xc5/)       == 2;
-print "ok 39\n";
+is((($a = v300.196.172.300.196.172) =~ tr/\xc4/\xc5/), 2,
+                                     'transliterate and count');
 
-print "not "
-    unless (($a = v300.196.172.300.196.172) =~ tr/\x{12c}/\x{12d}/) == 2;
-print "ok 40\n";
+is((($a = v300.196.172.300.196.172) =~ tr/\x{12c}/\x{12d}/), 2);
 
-# Transliterate with complement.
 
 ($a = v300.196.172.300.196.172) =~ tr/\xc4/\x{12d}/c;
-print "not " unless $a eq v301.196.301.301.196.301;
-print "ok 41\n";
+is($a, v301.196.301.301.196.301,    'translit w/complement');
 
 ($a = v300.196.172.300.196.172) =~ tr/\x{12c}/\xc5/c;
-print "not " unless $a eq v300.197.197.300.197.197;
-print "ok 42\n";
+is($a, v300.197.197.300.197.197);
 
-# Transliterate with deletion.
 
 ($a = v300.196.172.300.196.172) =~ tr/\xc4//d;
-print "not " unless $a eq v300.172.300.172;
-print "ok 43\n";
+is($a, v300.172.300.172,            'translit w/deletion');
 
 ($a = v300.196.172.300.196.172) =~ tr/\x{12c}//d;
-print "not " unless $a eq v196.172.196.172;
-print "ok 44\n";
+is($a, v196.172.196.172);
 
-# Transliterate with squeeze.
 
 ($a = v196.196.172.300.300.196.172) =~ tr/\xc4/\xc5/s;
-print "not " unless $a eq v197.172.300.300.197.172;
-print "ok 45\n";
+is($a, v197.172.300.300.197.172,    'translit w/squeeze');
 
 ($a = v196.172.300.300.196.172.172) =~ tr/\x{12c}/\x{12d}/s;
-print "not " unless $a eq v196.172.301.196.172.172;
-print "ok 46\n";
+is($a, v196.172.301.196.172.172);
 
-# Tricky cases by Simon Cozens.
 
+# Tricky cases (When Simon Cozens Attacks)
 ($a = v196.172.200) =~ tr/\x{12c}/a/;
-print "not " unless sprintf("%vd", $a) eq '196.172.200';
-print "ok 47\n";
+is(sprintf("%vd", $a), '196.172.200');
 
 ($a = v196.172.200) =~ tr/\x{12c}/\x{12c}/;
-print "not " unless sprintf("%vd", $a) eq '196.172.200';
-print "ok 48\n";
+is(sprintf("%vd", $a), '196.172.200');
 
 ($a = v196.172.200) =~ tr/\x{12c}//d;
-print "not " unless sprintf("%vd", $a) eq '196.172.200';
-print "ok 49\n";
+is(sprintf("%vd", $a), '196.172.200');
+
 
 # UTF8 range tests from Inaba Hiroto
 
 # Not working in EBCDIC as of 12674.
 ($a = v300.196.172.302.197.172) =~ tr/\x{12c}-\x{130}/\xc0-\xc4/;
-print "not " unless $a eq v192.196.172.194.197.172;
-print "ok 50\n";
+is($a, v192.196.172.194.197.172,    'UTF range');
 
 ($a = v300.196.172.302.197.172) =~ tr/\xc4-\xc8/\x{12c}-\x{130}/;
-print "not " unless $a eq v300.300.172.302.301.172;
-print "ok 51\n";
+is($a, v300.300.172.302.301.172);
+
 
 # UTF8 range tests from Karsten Sperling (patch #9008 required)
 
 ($a = "\x{0100}") =~ tr/\x00-\x{100}/X/;
-print "not " unless $a eq "X";
-print "ok 52\n";
+is($a, "X");
 
 ($a = "\x{0100}") =~ tr/\x{0000}-\x{00ff}/X/c;
-print "not " unless $a eq "X";
-print "ok 53\n";
+is($a, "X");
 
 ($a = "\x{0100}") =~ tr/\x{0000}-\x{00ff}\x{0101}/X/c;
-print "not " unless $a eq "X";
-print "ok 54\n";
+is($a, "X");
  
 ($a = v256) =~ tr/\x{0000}-\x{00ff}\x{0101}/X/c;
-print "not " unless $a eq "X";
-print "ok 55\n"; 
+is($a, "X");
+
 
 # UTF8 range tests from Inaba Hiroto
 
 ($a = "\x{200}") =~ tr/\x00-\x{100}/X/c;
-print "not " unless $a eq "X";
-print "ok 56\n";
+is($a, "X");
 
 ($a = "\x{200}") =~ tr/\x00-\x{100}/X/cs;
-print "not " unless $a eq "X";
-print "ok 57\n";
+is($a, "X");
+
 
 # Tricky on EBCDIC: while [a-z] [A-Z] must not match the gap characters,
 # (i-j, r-s, I-J, R-S), [\x89-\x91] [\xc9-\xd1] has to match them,
@@ -329,65 +297,85 @@ print "ok 57\n";
 
 # Not working in EBCDIC as of 12674.
 $c = ($a = "\x89\x8a\x8b\x8c\x8d\x8f\x90\x91") =~ tr/\x89-\x91/X/;
-print "not " unless $c == 8 and $a eq "XXXXXXXX";
-print "ok 58\n";
+is($c, 8);
+is($a, "XXXXXXXX");
    
 # Not working in EBCDIC as of 12674.
 $c = ($a = "\xc9\xca\xcb\xcc\xcd\xcf\xd0\xd1") =~ tr/\xc9-\xd1/X/;
-print "not " unless $c == 8 and $a eq "XXXXXXXX";
-print "ok 59\n";
-   
-if (ord('i') == 0x89 & ord('J') == 0xd1) {
+is($c, 8);
+is($a, "XXXXXXXX");
 
-$c = ($a = "\x89\x8a\x8b\x8c\x8d\x8f\x90\x91") =~ tr/i-j/X/;
-print "not " unless $c == 2 and $a eq "X\x8a\x8b\x8c\x8d\x8f\x90X";
-print "ok 60\n";
-   
-$c = ($a = "\xc9\xca\xcb\xcc\xcd\xcf\xd0\xd1") =~ tr/I-J/X/;
-print "not " unless $c == 2 and $a eq "X\xca\xcb\xcc\xcd\xcf\xd0X";
-print "ok 61\n";
 
-} else {
-  for (60..61) { print "ok $_ # Skip: not EBCDIC\n" }
+SKIP: {   
+    skip "not EBCDIC", 4 unless $Is_EBCDIC;
+
+    $c = ($a = "\x89\x8a\x8b\x8c\x8d\x8f\x90\x91") =~ tr/i-j/X/;
+    is($c, 2);
+    is($a, "X\x8a\x8b\x8c\x8d\x8f\x90X");
+   
+    $c = ($a = "\xc9\xca\xcb\xcc\xcd\xcf\xd0\xd1") =~ tr/I-J/X/;
+    is($c, 2);
+    is($a, "X\xca\xcb\xcc\xcd\xcf\xd0X");
 }
 
 ($a = "\x{100}") =~ tr/\x00-\xff/X/c;
-print "not " unless ord($a) == ord("X");
-print "ok 62\n";
+is(ord($a), ord("X"));
 
 ($a = "\x{100}") =~ tr/\x00-\xff/X/cs;
-print "not " unless ord($a) == ord("X");
-print "ok 63\n";
+is(ord($a), ord("X"));
 
 ($a = "\x{100}\x{100}") =~ tr/\x{101}-\x{200}//c;
-print "not " unless $a eq "\x{100}\x{100}";
-print "ok 64\n";
+is($a, "\x{100}\x{100}");
 
 ($a = "\x{100}\x{100}") =~ tr/\x{101}-\x{200}//cs;
-print "not " unless $a eq "\x{100}";
-print "ok 65\n";
+is($a, "\x{100}");
 
 $a = "\xfe\xff"; $a =~ tr/\xfe\xff/\x{1ff}\x{1fe}/;
-print "not " unless $a eq "\x{1ff}\x{1fe}";
-print "ok 66\n";
+is($a, "\x{1ff}\x{1fe}");
+
 
 # From David Dyck
 ($a = "R0_001") =~ tr/R_//d;
-print "not " if hex($a) != 1;
-print "ok 67\n";
+is(hex($a), 1);
 
 # From Inaba Hiroto
 @a = (1,2); map { y/1/./ for $_ } @a;
-print "not " if "@a" ne ". 2";
-print "ok 68\n";
+is("@a", ". 2");
 
 @a = (1,2); map { y/1/./ for $_.'' } @a;
-print "not " if "@a" ne "1 2";
-print "ok 69\n";
+is("@a", "1 2");
+
 
 # Additional test for Inaba Hiroto patch (robin@kitsite.com)
 ($a = "\x{100}\x{102}\x{101}") =~ tr/\x00-\377/XYZ/c;
-print "not " unless $a eq "XZY";
-print "ok 70\n";
+is($a, "XZY");
+
+
+# Used to fail with "Modification of a read-only value attempted"
+%a = (N=>1);
+foreach (keys %a) {
+  eval 'tr/N/n/';
+  is($_, 'n',   'pp_trans needs to unshare shared hash keys');
+  is($@, '',    '   no error');
+}
+
+
+$x = eval '"1213" =~ tr/1/1/';
+is($x, 2,   'implicit count on constant');
+is($@, '',  '   no error');
+
+
+my @foo = ();
+eval '$foo[-1] =~ tr/N/N/';
+is( $@, '',         'implicit count outside array bounds, index negative' );
+is( scalar @foo, 0, "    doesn't extend the array");
+
+eval '$foo[1] =~ tr/N/N/';
+is( $@, '',         'implicit count outside array bounds, index positive' );
+is( scalar @foo, 0, "    doesn't extend the array");
 
 
+my %foo = ();
+eval '$foo{bar} =~ tr/N/N/';
+is( $@, '',         'implicit count outside hash bounds' );
+is( scalar keys %foo, 0,   "    doesn't extend the hash");
diff --git a/t/run/kill_perl.t b/t/run/kill_perl.t
index 6345a793a4..e568afe1ed 100644
--- a/t/run/kill_perl.t
+++ b/t/run/kill_perl.t
@@ -22,10 +22,13 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
 use strict;
 
+my $Perl = which_perl;
+
 $|=1;
 
 my @prgs = ();
@@ -69,17 +72,11 @@ foreach my $prog (@prgs) {
     close TEST or die "Cannot close $tmpfile: $!";
 
     my $results;
-    if ($^O eq 'MSWin32') {
-        $results = `.\\perl -I../lib $switch $tmpfile 2>&1`;
-    }
-    elsif ($^O eq 'NetWare') {
-        $results = `perl -I../lib $switch $tmpfile 2>&1`;
-    }
-    elsif ($^O eq 'MacOS') {
-	$results = `$^X -I::lib -MMac::err=unix $switch $tmpfile`;
+    if ($^O eq 'MacOS') {
+        $results = `$Perl -I::lib -MMac::err=unix $switch $tmpfile`;
     }
     else {
-      $results = `./perl "-I../lib" $switch $tmpfile 2>&1`;
+        $results = `$Perl "-I../lib" $switch $tmpfile 2>&1`;
     }
     my $status = $?;
 
diff --git a/t/test.pl b/t/test.pl
index e4411af078..ca4af688dc 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -15,22 +15,22 @@ sub plan {
 	my %plan = @_;
 	$n = $plan{tests}; 
     }
-    print "1..$n\n";
+    print STDOUT "1..$n\n";
     $planned = $n;
 }
 
 END {
     my $ran = $test - 1;
     if (defined $planned && $planned != $ran) {
-	print "# Looks like you planned $planned tests but ran $ran.\n";
+	print STDOUT "# Looks like you planned $planned tests but ran $ran.\n";
     }
 }
 
 sub skip_all {
     if (@_) {
-	print "1..0 - @_\n";
+	print STDOUT "1..0 - @_\n";
     } else {
-	print "1..0\n";
+	print STDOUT "1..0\n";
     }
     exit(0);
 }
@@ -47,15 +47,15 @@ sub _ok {
     }
 
     $out .= " # TODO $TODO" if $TODO;
-    print "$out\n";
+    print STDOUT "$out\n";
 
     unless ($pass) {
-	print "# Failed $where\n";
+	print STDOUT "# Failed $where\n";
     }
 
     # Ensure that the message is properly escaped.
-    print map { /^#/ ? "$_\n" : "# $_\n" } 
-          map { split /\n/ } @mess if @mess;
+    print STDOUT map { /^#/ ? "$_\n" : "# $_\n" } 
+                 map { split /\n/ } @mess if @mess;
 
     $test++;
 
@@ -127,6 +127,10 @@ sub fail {
     _ok(0, _where(), @_);
 }
 
+sub curr_test {
+    return $test;
+}
+
 sub next_test {
     $test++
 }
@@ -137,7 +141,7 @@ sub skip {
     my $why = shift;
     my $n    = @_ ? shift : 1;
     for (1..$n) {
-	print "ok $test # skip: $why\n";
+        print STDOUT "ok $test # skip: $why\n";
         $test++;
     }
     local $^W = 0;
@@ -245,11 +249,42 @@ sub runperl {
     if ($args{verbose}) {
 	my $runperldisplay = $runperl;
 	$runperldisplay =~ s/\n/\n\#/g;
-	print "# $runperldisplay\n";
+	print STDOUT "# $runperldisplay\n";
     }
     my $result = `$runperl`;
     $result =~ s/\n\n/\n/ if $is_vms; # XXX pipes sometimes double these
     return $result;
 }
 
+
+sub BAILOUT {
+    print STDOUT "Bail out! @_\n";
+    exit;
+}
+
+
+# A somewhat safer version of the sometimes wrong $^X.
+BEGIN: {
+    eval {
+        require File::Spec;
+        require Config;
+        Config->import;
+    };
+    warn "test.pl had problems loading other modules: $@" if $@;
+}
+
+# We do this at compile time before the test might have chdir'd around
+# and make sure its absolute in case they do later.
+my $Perl = $^X;
+$Perl = File::Spec->rel2abs(File::Spec->catfile(File::Spec->curdir(), $Perl))
+               if $^X eq "perl$Config{_exe}";
+warn "Can't generate which_perl from $^X" unless -f $Perl;
+
+# For subcommands to use.
+$ENV{PERLEXE} = $Perl;
+
+sub which_perl {
+    return $Perl;
+}
+
 1;