merge 5.8.5 into HEAD

remove now-unused files
crank libperl shared library major number
update Makefile.bsd-wrapper
tweak openbsd hints file for arm and m68k

29 files changed, 862 insertions, 212 deletions

diff --git a/gnu/usr.bin/perl/t/TEST b/gnu/usr.bin/perl/t/TEST
index 08787e2f5bf..12985b77220 100644
--- a/gnu/usr.bin/perl/t/TEST
+++ b/gnu/usr.bin/perl/t/TEST
@@ -24,6 +24,7 @@ if ($#ARGV >= 0) {
 	$bytecompile = 1 if $1 eq 'bytecompile';
 	$compile = 1 if $1 eq 'compile';
 	$taintwarn = 1 if $1 eq 'taintwarn';
+	$ENV{PERL_CORE_MINITEST} = 1 if $1 eq 'minitest';
 	if ($1 =~ /^deparse(,.+)?$/) {
 	    $deparse = 1;
 	    $deparse_opts = $1;
@@ -67,7 +68,8 @@ sub _find_tests {
     my($dir) = @_;
     opendir DIR, $dir or die "Trouble opening $dir: $!";
     foreach my $f (sort { $a cmp $b } readdir DIR) {
-        next if $f eq $curdir or $f eq $updir;
+        next if $f eq $curdir or $f eq $updir or
+	    $f =~ /^(?:CVS|RCS|SCCS|\.svn)$/;
 
         my $fullpath = File::Spec->catfile($dir, $f);
 
@@ -446,7 +448,12 @@ EOT
 	}
 	else {
 	    $next += 1;
-	    print "${te}FAILED at test $next\n";
+	    if ($next > $max) {
+	        print "${te}FAILED at test $next\tpossibly due to extra output\n";
+	    }
+	    else {
+		print "${te}FAILED at test $next\n";
+	    }
 	    $bad = $bad + 1;
 	    $_ = $test;
 	    if (/^base/) {
diff --git a/gnu/usr.bin/perl/t/cmd/for.t b/gnu/usr.bin/perl/t/cmd/for.t
index 3a4bc9b0dae..27fb5a25178 100644
--- a/gnu/usr.bin/perl/t/cmd/for.t
+++ b/gnu/usr.bin/perl/t/cmd/for.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..13\n";
+print "1..14\n";
 
 for ($i = 0; $i <= 10; $i++) {
     $x[$i] = $i;
@@ -76,3 +76,22 @@ print $loop_count == 4 ? "ok" : "not ok", " 12\n";
 @a = (3,4);
 eval { @a = () for (1,2,@a) };
 print $@ =~ /Use of freed value in iteration/ ? "ok" : "not ok", " 13\n";
+
+# [perl #30061] double destory when same iterator variable (eg $_) used in
+# DESTROY as used in for loop that triggered the destroy
+
+{
+
+    my $x = 0;
+    sub X::DESTROY {
+	my $o = shift;
+	$x++;
+	1 for (1);
+    }
+
+    my %h;
+    $h{foo} = bless [], 'X';
+    delete $h{foo} for $h{foo}, 1;
+    print $x == 1 ? "ok" : "not ok", " 14 - double destroy, x=$x\n";
+}
+
diff --git a/gnu/usr.bin/perl/t/comp/redef.t b/gnu/usr.bin/perl/t/comp/redef.t
index 328b44d3c89..63be16c2ff8 100644
--- a/gnu/usr.bin/perl/t/comp/redef.t
+++ b/gnu/usr.bin/perl/t/comp/redef.t
@@ -23,13 +23,13 @@ ok 1, $warn =~ s/Subroutine sub0 redefined[^\n]+\n//s;
 sub sub1    { 1 }
 sub sub1 () { 2 }
 
-ok 2, $warn =~ s/$NEWPROTO \Qsub main::sub1 vs ()\E[^\n]+\n//s;
+ok 2, $warn =~ s/$NEWPROTO \Qsub main::sub1: none vs ()\E[^\n]+\n//s;
 ok 3, $warn =~ s/Subroutine sub1 redefined[^\n]+\n//s;
 
 sub sub2     { 1 }
 sub sub2 ($) { 2 }
 
-ok 4, $warn =~ s/$NEWPROTO \Qsub main::sub2 vs ($)\E[^\n]+\n//s;
+ok 4, $warn =~ s/$NEWPROTO \Qsub main::sub2: none vs ($)\E[^\n]+\n//s;
 ok 5, $warn =~ s/Subroutine sub2 redefined[^\n]+\n//s;
 
 sub sub3 () { 1 }
diff --git a/gnu/usr.bin/perl/t/io/open.t b/gnu/usr.bin/perl/t/io/open.t
index e71d2ec3c58..5e1b5ec80d4 100644
--- a/gnu/usr.bin/perl/t/io/open.t
+++ b/gnu/usr.bin/perl/t/io/open.t
@@ -12,7 +12,7 @@ use Config;
 $Is_VMS = $^O eq 'VMS';
 $Is_MacOS = $^O eq 'MacOS';
 
-plan tests => 105;
+plan tests => 107;
 
 my $Perl = which_perl();
 
@@ -239,10 +239,14 @@ like( $@, qr/Bad filehandle:\s+afile/,          '       right error' );
 
 SKIP: {
     skip "This perl uses perlio", 1 if $Config{useperlio};
-    skip "This system doesn't understand EINVAL", 1 unless exists $!{EINVAL};
+    skip "miniperl cannot be relied on to load %Errno"
+	if $ENV{PERL_CORE_MINITEST};
+    # Force the reference to %! to be run time by writing ! as {"!"}
+    skip "This system doesn't understand EINVAL", 1
+	unless exists ${"!"}{EINVAL};
 
     no warnings 'io';
-    ok( !open(F,'>',\my $s) && $!{EINVAL}, 'open(reference) raises EINVAL' );
+    ok(!open(F,'>',\my $s) && ${"!"}{EINVAL}, 'open(reference) raises EINVAL');
 }
 
 {
@@ -302,3 +306,12 @@ SKIP: {
 	 'bad layer ":c" failure');
 }
 
+# [perl #28986] "open m" crashes Perl
+
+fresh_perl_like('open m', qr/^Search pattern not terminated at/,
+	{ stderr => 1 }, 'open m test');
+
+fresh_perl_is(
+    'sub f { open(my $fh, "xxx"); $fh = "f"; } f; f;print "ok"',
+    'ok', { stderr => 1 },
+    '#29102: Crash on assignment to lexical filehandle');
diff --git a/gnu/usr.bin/perl/t/io/print.t b/gnu/usr.bin/perl/t/io/print.t
index f33aa666a32..31d559aac9c 100644
--- a/gnu/usr.bin/perl/t/io/print.t
+++ b/gnu/usr.bin/perl/t/io/print.t
@@ -6,7 +6,8 @@ BEGIN {
 }
 
 use strict 'vars';
-use Errno;
+eval 'use Errno';
+die $@ if $@ and !$ENV{PERL_CORE_MINITEST};
 
 print "1..19\n";
 
@@ -41,6 +42,8 @@ print @x,"14\nok",@y;
     print "";
 }
 
+$\ = '';
+
 if (!exists &Errno::EBADF) {
     print "ok 19 # skipped: no EBADF\n";
 } else {
diff --git a/gnu/usr.bin/perl/t/io/read.t b/gnu/usr.bin/perl/t/io/read.t
index ea2672dedba..e0f936653f3 100644
--- a/gnu/usr.bin/perl/t/io/read.t
+++ b/gnu/usr.bin/perl/t/io/read.t
@@ -1,6 +1,6 @@
 #!./perl
 
-# $RCSfile$
+# $RCSfile: read.t,v $
 
 BEGIN {
     chdir 't' if -d 't';
@@ -9,7 +9,8 @@ BEGIN {
 }
 
 use strict;
-use Errno;
+eval 'use Errno';
+die $@ if $@ and !$ENV{PERL_CORE_MINITEST};
 
 plan tests => 2;
 
diff --git a/gnu/usr.bin/perl/t/op/array.t b/gnu/usr.bin/perl/t/op/array.t
index 8f2f1a9510c..77ea646a93b 100644
--- a/gnu/usr.bin/perl/t/op/array.t
+++ b/gnu/usr.bin/perl/t/op/array.t
@@ -1,12 +1,11 @@
 #!./perl
 
-
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
 }
 
-print "1..73\n";
+print "1..82\n";
 
 #
 # @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
@@ -272,3 +271,29 @@ my $got = runperl (
 $got =~ s/\n/ /g;
 print "# $got\nnot " unless $got eq '';
 print "ok 73\n";
+
+# Test negative and funky indices.
+
+{
+    my @a = 0..4;
+    print $a[-1] == 4 ? "ok 74\n" : "not ok 74\n";
+    print $a[-2] == 3 ? "ok 75\n" : "not ok 75\n";
+    print $a[-5] == 0 ? "ok 76\n" : "not ok 76\n";
+    print defined $a[-6] ? "not ok 77\n" : "ok 77\n";
+
+    print $a[2.1]   == 2 ? "ok 78\n" : "not ok 78\n";
+    print $a[2.9]   == 2 ? "ok 79\n" : "not ok 79\n";
+    print $a[undef] == 0 ? "ok 80\n" : "not ok 80\n";
+    print $a["3rd"] == 3 ? "ok 81\n" : "not ok 81\n";
+}
+
+sub kindalike { # TODO: test.pl-ize the array.t.
+    my ($s, $r, $m, $n) = @_;
+    print $s =~ /$r/ ? "ok $n - $m\n" : "not ok $n - $m ($s)\n";
+}
+
+{
+    my @a;
+    eval '$a[-1] = 0';
+    kindalike($@, qr/Modification of non-creatable array value attempted, subscript -1/, "\$a[-1] = 0", 82);
+}
diff --git a/gnu/usr.bin/perl/t/op/bop.t b/gnu/usr.bin/perl/t/op/bop.t
index c433875aa84..d32f47cbb28 100644
--- a/gnu/usr.bin/perl/t/op/bop.t
+++ b/gnu/usr.bin/perl/t/op/bop.t
@@ -7,93 +7,93 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require "./test.pl";
 }
 
-print "1..44\n";
+# Tests don't have names yet.
+# If you find tests are failing, please try adding names to tests to track
+# down where the failure is, and supply your new names as a patch.
+# (Just-in-time test naming)
+plan tests => 46;
 
 # numerics
-print ((0xdead & 0xbeef) == 0x9ead ? "ok 1\n" : "not ok 1\n");
-print ((0xdead | 0xbeef) == 0xfeef ? "ok 2\n" : "not ok 2\n");
-print ((0xdead ^ 0xbeef) == 0x6042 ? "ok 3\n" : "not ok 3\n");
-print ((~0xdead & 0xbeef) == 0x2042 ? "ok 4\n" : "not ok 4\n");
+ok ((0xdead & 0xbeef) == 0x9ead);
+ok ((0xdead | 0xbeef) == 0xfeef);
+ok ((0xdead ^ 0xbeef) == 0x6042);
+ok ((~0xdead & 0xbeef) == 0x2042);
 
 # shifts
-print ((257 << 7) == 32896 ? "ok 5\n" : "not ok 5\n");
-print ((33023 >> 7) == 257 ? "ok 6\n" : "not ok 6\n");
+ok ((257 << 7) == 32896);
+ok ((33023 >> 7) == 257);
 
 # signed vs. unsigned
-print ((~0 > 0 && do { use integer; ~0 } == -1)
-       ? "ok 7\n" : "not ok 7\n");
+ok ((~0 > 0 && do { use integer; ~0 } == -1));
 
 my $bits = 0;
 for (my $i = ~0; $i; $i >>= 1) { ++$bits; }
 my $cusp = 1 << ($bits - 1);
 
-print ((($cusp & -1) > 0 && do { use integer; $cusp & -1 } < 0)
-       ? "ok 8\n" : "not ok 8\n");
-print ((($cusp | 1) > 0 && do { use integer; $cusp | 1 } < 0)
-       ? "ok 9\n" : "not ok 9\n");
-print ((($cusp ^ 1) > 0 && do { use integer; $cusp ^ 1 } < 0)
-       ? "ok 10\n" : "not ok 10\n");
-print (((1 << ($bits - 1)) == $cusp &&
-	do { use integer; 1 << ($bits - 1) } == -$cusp)
-       ? "ok 11\n" : "not ok 11\n");
-print ((($cusp >> 1) == ($cusp / 2) &&
-       do { use integer; abs($cusp >> 1) } == ($cusp / 2))
-       ? "ok 12\n" : "not ok 12\n");
+
+ok (($cusp & -1) > 0 && do { use integer; $cusp & -1 } < 0);
+ok (($cusp | 1) > 0 && do { use integer; $cusp | 1 } < 0);
+ok (($cusp ^ 1) > 0 && do { use integer; $cusp ^ 1 } < 0);
+ok ((1 << ($bits - 1)) == $cusp &&
+    do { use integer; 1 << ($bits - 1) } == -$cusp);
+ok (($cusp >> 1) == ($cusp / 2) &&
+    do { use integer; abs($cusp >> 1) } == ($cusp / 2));
 
 $Aaz = chr(ord("A") & ord("z"));
 $Aoz = chr(ord("A") | ord("z"));
 $Axz = chr(ord("A") ^ ord("z"));
 
 # short strings
-print (("AAAAA" & "zzzzz") eq ($Aaz x 5) ? "ok 13\n" : "not ok 13\n");
-print (("AAAAA" | "zzzzz") eq ($Aoz x 5) ? "ok 14\n" : "not ok 14\n");
-print (("AAAAA" ^ "zzzzz") eq ($Axz x 5) ? "ok 15\n" : "not ok 15\n");
+is (("AAAAA" & "zzzzz"), ($Aaz x 5));
+is (("AAAAA" | "zzzzz"), ($Aoz x 5));
+is (("AAAAA" ^ "zzzzz"), ($Axz x 5));
 
 # long strings
 $foo = "A" x 150;
 $bar = "z" x 75;
 $zap = "A" x 75;
 # & truncates
-print (($foo & $bar) eq ($Aaz x 75 ) ? "ok 16\n" : "not ok 16\n");
+is (($foo & $bar), ($Aaz x 75 ));
 # | does not truncate
-print (($foo | $bar) eq ($Aoz x 75 . $zap) ? "ok 17\n" : "not ok 17\n");
+is (($foo | $bar), ($Aoz x 75 . $zap));
 # ^ does not truncate
-print (($foo ^ $bar) eq ($Axz x 75 . $zap) ? "ok 18\n" : "not ok 18\n");
+is (($foo ^ $bar), ($Axz x 75 . $zap));
 
 #
-print "ok \xFF\xFF\n" & "ok 19\n";
-print "ok 20\n" | "ok \0\0\n";
-print "o\000 \0001\000" ^ "\000k\0002\000\n";
+is ("ok \xFF\xFF\n" & "ok 19\n", "ok 19\n");
+is ("ok 20\n" | "ok \0\0\n", "ok 20\n");
+is ("o\000 \0001\000" ^ "\000k\0002\000\n", "ok 21\n");
 
 #
-print "ok \x{FF}\x{FF}\n" & "ok 22\n";
-print "ok 23\n" | "ok \x{0}\x{0}\n";
-print "o\x{0} \x{0}4\x{0}" ^ "\x{0}k\x{0}2\x{0}\n";
+is ("ok \x{FF}\x{FF}\n" & "ok 22\n", "ok 22\n");
+is ("ok 23\n" | "ok \x{0}\x{0}\n", "ok 23\n");
+is ("o\x{0} \x{0}4\x{0}" ^ "\x{0}k\x{0}2\x{0}\n", "ok 24\n");
 
 #
-print "ok 25\n" if sprintf("%vd", v4095 & v801) eq 801;
-print "ok 26\n" if sprintf("%vd", v4095 | v801) eq 4095;
-print "ok 27\n" if sprintf("%vd", v4095 ^ v801) eq 3294;
+is (sprintf("%vd", v4095 & v801), 801);
+is (sprintf("%vd", v4095 | v801), 4095);
+is (sprintf("%vd", v4095 ^ v801), 3294);
 
 #
-print "ok 28\n" if sprintf("%vd", v4095.801.4095 & v801.4095) eq '801.801';
-print "ok 29\n" if sprintf("%vd", v4095.801.4095 | v801.4095) eq '4095.4095.4095';
-print "ok 30\n" if sprintf("%vd", v801.4095 ^ v4095.801.4095) eq '3294.3294.4095';
+is (sprintf("%vd", v4095.801.4095 & v801.4095), '801.801');
+is (sprintf("%vd", v4095.801.4095 | v801.4095), '4095.4095.4095');
+is (sprintf("%vd", v801.4095 ^ v4095.801.4095), '3294.3294.4095');
 #
-print "ok 31\n" if sprintf("%vd", v120.300 & v200.400) eq '72.256';
-print "ok 32\n" if sprintf("%vd", v120.300 | v200.400) eq '248.444';
-print "ok 33\n" if sprintf("%vd", v120.300 ^ v200.400) eq '176.188';
+is (sprintf("%vd", v120.300 & v200.400), '72.256');
+is (sprintf("%vd", v120.300 | v200.400), '248.444');
+is (sprintf("%vd", v120.300 ^ v200.400), '176.188');
 #
 my $a = v120.300;
 my $b = v200.400;
 $a ^= $b;
-print "ok 34\n" if sprintf("%vd", $a) eq '176.188';
+is (sprintf("%vd", $a), '176.188');
 my $a = v120.300;
 my $b = v200.400;
 $a |= $b;
-print "ok 35\n" if sprintf("%vd", $a) eq '248.444';
+is (sprintf("%vd", $a), '248.444');
 
 #
 # UTF8 ~ behaviour
@@ -114,11 +114,7 @@ for (0x100...0xFFF) {
           if $a ne chr(~$_) or length($a) != 1 or ~$a ne chr($_);
   }
 }
-if (@not36) {
-    print "# test 36 failed\n";
-    print "not ";
-}
-print "ok 36\n";
+is (join (', ', @not36), '');
 
 my @not37;
 
@@ -138,14 +134,13 @@ for my $i (0xEEE...0xF00) {
     }
   }
 }
-if (@not37) {
-    print "# test 37 failed\n";
-    print "not ";
+is (join (', ', @not37), '');
+
+SKIP: {
+  skip "EBCDIC" if $Is_EBCDIC;
+  is (~chr(~0), "\0");
 }
-print "ok 37\n";
 
-print "not " unless ~chr(~0) eq "\0" or $Is_EBCDIC;
-print "ok 38\n";
 
 my @not39;
 
@@ -155,11 +150,7 @@ for my $i (0x100..0x120) {
 	    if ~(chr($i)|chr($j)) ne (~chr($i)&~chr($j));
     }
 }
-if (@not39) {
-    print "# test 39 failed\n";
-    print "not ";
-}
-print "ok 39\n";
+is (join (', ', @not39), '');
 
 my @not40;
 
@@ -169,18 +160,21 @@ for my $i (0x100..0x120) {
 	    if ~(chr($i)&chr($j)) ne (~chr($i)|~chr($j));
     }
 }
-if (@not40) {
-    print "# test 40 failed\n";
-    print "not ";
-}
-print "ok 40\n";
+is (join (', ', @not40), '');
+
 
 # More variations on 19 and 22.
-print "ok \xFF\x{FF}\n" & "ok 41\n";
-print "ok \x{FF}\xFF\n" & "ok 42\n";
+is ("ok \xFF\x{FF}\n" & "ok 41\n", "ok 41\n");
+is ("ok \x{FF}\xFF\n" & "ok 42\n", "ok 42\n");
 
 # Tests to see if you really can do casts negative floats to unsigned properly
 $neg1 = -1.0;
-print ((~ $neg1 == 0) ? "ok 43\n" : "not ok 43\n");
+ok (~ $neg1 == 0);
 $neg7 = -7.0;
-print ((~ $neg7 == 6) ? "ok 44\n" : "not ok 44\n");
+ok (~ $neg7 == 6);
+
+
+$a = "\0\x{100}"; chop($a);
+ok(utf8::is_utf8($a)); # make sure UTF8 flag is still there
+$a = ~$a;
+is($a, "\xFF", "~ works with utf-8");
diff --git a/gnu/usr.bin/perl/t/op/chop.t b/gnu/usr.bin/perl/t/op/chop.t
index 87700de9291..bacc439676a 100644
--- a/gnu/usr.bin/perl/t/op/chop.t
+++ b/gnu/usr.bin/perl/t/op/chop.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 51;
+plan tests => 133;
 
 $_ = 'abc';
 $c = do foo();
@@ -183,3 +183,42 @@ ok($@ =~ /Can\'t modify.*chop.*in.*assignment/);
 eval 'chomp($x, $y) = (1, 2);';
 ok($@ =~ /Can\'t modify.*chom?p.*in.*assignment/);
 
+my @chars = ("N", "\xd3", substr ("\xd4\x{100}", 0, 1), chr 1296);
+foreach my $start (@chars) {
+  foreach my $end (@chars) {
+    local $/ = $end;
+    my $message = "start=" . ord ($start) . " end=" . ord $end;
+    my $string = $start . $end;
+    is (chomp ($string), 1, "$message [returns 1]");
+    is ($string, $start, $message);
+
+    my $end_utf8 = $end;
+    utf8::encode ($end_utf8);
+    next if $end_utf8 eq $end;
+
+    # $end ne $end_utf8, so these should not chomp.
+    $string = $start . $end_utf8;
+    my $chomped = $string;
+    is (chomp ($chomped), 0, "$message (end as bytes) [returns 0]");
+    is ($chomped, $string, "$message (end as bytes)");
+
+    $/ = $end_utf8;
+    $string = $start . $end;
+    $chomped = $string;
+    is (chomp ($chomped), 0, "$message (\$/ as bytes) [returns 0]");
+    is ($chomped, $string, "$message (\$/ as bytes)");
+  }
+}
+
+{
+    # returns length in characters, but not in bytes.
+    $/ = "\x{100}";
+    $a = "A$/";
+    $b = chomp $a;
+    is ($b, 1);
+
+    $/ = "\x{100}\x{101}";
+    $a = "A$/";
+    $b = chomp $a;
+    is ($b, 2);
+}
diff --git a/gnu/usr.bin/perl/t/op/closure.t b/gnu/usr.bin/perl/t/op/closure.t
index 866922d2ac6..de9e102a7f5 100644
--- a/gnu/usr.bin/perl/t/op/closure.t
+++ b/gnu/usr.bin/perl/t/op/closure.t
@@ -13,7 +13,7 @@ BEGIN {
 
 use Config;
 
-print "1..185\n";
+print "1..187\n";
 
 my $test = 1;
 sub test (&) {
@@ -641,4 +641,27 @@ __EOF__
     END { 1 while unlink $progfile }
 }
 
+{
+    # bugid #24914 = used to coredump restoring PL_comppad in the
+    # savestack, due to the early freeing of the anon closure
+
+    my $got = runperl(stderr => 1, prog => 
+'sub d {die} my $f; $f = sub {my $x=1; $f = 0; d}; eval{$f->()}; print qq(ok\n)'
+    );
+    test { $got eq "ok\n" };
+}
 
+# After newsub is redefined outside the BEGIN, it's CvOUTSIDE should point
+# to main rather than BEGIN, and BEGIN should be freed.
+
+{
+    my $flag = 0;
+    sub  X::DESTROY { $flag = 1 }
+    {
+	my $x;
+	BEGIN {$x = \&newsub }
+	sub newsub {};
+	$x = bless {}, 'X';
+    }
+    test { $flag == 1 };
+}
diff --git a/gnu/usr.bin/perl/t/op/delete.t b/gnu/usr.bin/perl/t/op/delete.t
index 10a218b1b61..53212a11407 100644
--- a/gnu/usr.bin/perl/t/op/delete.t
+++ b/gnu/usr.bin/perl/t/op/delete.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..36\n";
+print "1..37\n";
 
 # delete() on hash elements
 
@@ -121,3 +121,11 @@ print @{$refary[0]} == 1 ? "ok 35\n" : "not ok 35 @list\n";
     print "not " unless $a == $b && $b == $c;
     print "ok 36\n";
 }
+
+{
+    # [perl #29127] scalar delete of empty slice returned garbage
+    my %h;
+    my ($x,$y) = (1, scalar delete @h{()});
+    print "not " if defined $y;
+    print "ok 37\n";
+}
diff --git a/gnu/usr.bin/perl/t/op/goto.t b/gnu/usr.bin/perl/t/op/goto.t
index 67d24c0473d..859d5a66ee3 100644
--- a/gnu/usr.bin/perl/t/op/goto.t
+++ b/gnu/usr.bin/perl/t/op/goto.t
@@ -7,7 +7,7 @@ BEGIN {
     @INC = qw(. ../lib);
 }
 
-print "1..32\n";
+print "1..33\n";
 
 require "test.pl";
 
@@ -229,6 +229,19 @@ eval { goto +i_return_a_label; };
 print "not ";
 returned_label : print "ok 32 - done to returned_label\n";
 
+# [perl #29708] - goto &foo could leave foo() at depth two with
+# @_ == PL_sv_undef, causing a coredump
+
+
+my $r = runperl(
+    prog =>
+	'sub f { return if $d; $d=1; my $a=sub {goto &f}; &$a; f() } f(); print qq(ok\n)',
+    stderr => 1
+    );
+print "not " if $r ne "ok\n";
+print "ok 33 - avoid pad without an \@_\n";
+
+
 exit;
 
 bypass:
diff --git a/gnu/usr.bin/perl/t/op/magic.t b/gnu/usr.bin/perl/t/op/magic.t
index 04ef75dcf45..1c02b5bbad0 100644
--- a/gnu/usr.bin/perl/t/op/magic.t
+++ b/gnu/usr.bin/perl/t/op/magic.t
@@ -36,16 +36,17 @@ sub skip {
     return 1;
 }
 
-print "1..53\n";
-
-$Is_MSWin32 = $^O eq 'MSWin32';
-$Is_NetWare = $^O eq 'NetWare';
-$Is_VMS     = $^O eq 'VMS';
-$Is_Dos     = $^O eq 'dos';
-$Is_os2     = $^O eq 'os2';
-$Is_Cygwin  = $^O eq 'cygwin';
-$Is_MacOS   = $^O eq 'MacOS';
-$Is_MPE     = $^O eq 'mpeix';		
+print "1..54\n";
+
+$Is_MSWin32  = $^O eq 'MSWin32';
+$Is_NetWare  = $^O eq 'NetWare';
+$Is_VMS      = $^O eq 'VMS';
+$Is_Dos      = $^O eq 'dos';
+$Is_os2      = $^O eq 'os2';
+$Is_Cygwin   = $^O eq 'cygwin';
+$Is_MacOS    = $^O eq 'MacOS';
+$Is_MPE      = $^O eq 'mpeix';		
+$Is_miniperl = $ENV{PERL_CORE_MINITEST};
 
 $PERL = ($Is_NetWare            ? 'perl'   :
 	 ($Is_MacOS || $Is_VMS) ? $^X      :
@@ -347,26 +348,35 @@ else {
     skip('no caseless %ENV support') for 1..4;
 }
 
+if ($Is_miniperl) {
+    skip ("miniperl can't rely on loading %Errno") for 1..2;
+} else {
+   no warnings 'void';
+
 # Make sure Errno hasn't been prematurely autoloaded
 
-ok !defined %Errno::;
+   ok !defined %Errno::;
 
 # Test auto-loading of Errno when %! is used
 
-ok scalar eval q{
-   my $errs = %!;
-   defined %Errno::;
-}, $@;
-
+   ok scalar eval q{
+      %!;
+      defined %Errno::;
+   }, $@;
+}
 
-# Make sure that Errno loading doesn't clobber $!
+if ($Is_miniperl) {
+    skip ("miniperl can't rely on loading %Errno");
+} else {
+    # Make sure that Errno loading doesn't clobber $!
 
-undef %Errno::;
-delete $INC{"Errno.pm"};
+    undef %Errno::;
+    delete $INC{"Errno.pm"};
 
-open(FOO, "nonesuch"); # Generate ENOENT
-my %errs = %{"!"}; # Cause Errno.pm to be loaded at run-time
-ok ${"!"}{ENOENT};
+    open(FOO, "nonesuch"); # Generate ENOENT
+    my %errs = %{"!"}; # Cause Errno.pm to be loaded at run-time
+    ok ${"!"}{ENOENT};
+}
 
 ok $^S == 0 && defined $^S;
 eval { ok $^S == 1 };
@@ -401,3 +411,15 @@ ok "@+" eq "10 1 6 10";
     }
     ok $ok;
 }
+
+# Test for bug [perl #27839]
+{
+    my $x;
+    sub f {
+	"abc" =~ /(.)./;
+	$x = "@+";
+	return @+;
+    };
+    my @y = f();
+    ok( $x eq "@y", "return a magic array ($x) vs (@y)" );
+}
diff --git a/gnu/usr.bin/perl/t/op/my.t b/gnu/usr.bin/perl/t/op/my.t
index 601e1d6ae8d..bf5b6db3d3a 100644
--- a/gnu/usr.bin/perl/t/op/my.t
+++ b/gnu/usr.bin/perl/t/op/my.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: my.t,v $
 
-print "1..31\n";
+print "1..33\n";
 
 sub foo {
     my($a, $b) = @_;
@@ -99,3 +99,15 @@ for my $full (keys %fonts) {
     # Supposed to be copy-on-write via force_normal after a THINKFIRST check.
     print "$full $fonts{nok}\n";
 }
+
+#  [perl #29340] optimising away the = () left the padav returning the
+# array rather than the contents, leading to 'Bizarre copy of array' error
+
+sub opta { my @a=() }
+sub opth { my %h=() }
+eval { my $x = opta };
+print "not " if $@;
+print "ok 32\n";
+eval { my $x = opth };
+print "not " if $@;
+print "ok 33\n";
diff --git a/gnu/usr.bin/perl/t/op/pat.t b/gnu/usr.bin/perl/t/op/pat.t
index 54e648da82f..b79515e33a4 100644
--- a/gnu/usr.bin/perl/t/op/pat.t
+++ b/gnu/usr.bin/perl/t/op/pat.t
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..1055\n";
+print "1..1065\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -1910,9 +1910,10 @@ print "ok 663\n";
 print "not " unless chr(0xfb4f) =~ /\p{IsHebrew}/; # outside InHebrew
 print "ok 664\n";
 
-# singleton (not in a range, this test must be ignored on EBCDIC)
-print "not " unless chr(0xb5) =~ /\p{IsGreek}/ or ord("A") == 193;
-print "ok 665\n";
+# # singleton (not in a range, this test must be ignored on EBCDIC)
+# print "not " unless chr(0xb5) =~ /\p{IsGreek}/ or ord("A") == 193;
+# print "ok 665\n";
+print "ok 665 # 0xb5 moved from Greek to Common with Unicode 4.0.1\n";
 
 print "not " unless chr(0x37a) =~ /\p{IsGreek}/; # singleton
 print "ok 666\n";
@@ -2237,10 +2238,11 @@ print "# some Unicode properties\n";
 }
 
 {
-    print "not " unless "a" =~ /\p{L&}/;
+    # L& and LC are the same
+    print "not " unless "a" =~ /\p{LC}/ and "a" =~ /\p{L&}/;
     print "ok 743\n";
 
-    print "not " if     "1" =~ /\p{L&}/;
+    print "not " if     "1" =~ /\p{LC}/ or "1" =~ /\p{L&}/;
     print "ok 744\n";
 }
 
@@ -3255,5 +3257,25 @@ for (120 .. 130) {
     }
 }
 
-# last test 1055
-
+# perl #25269: panic: pp_match start/end pointers
+ok("a-bc" eq eval {
+	my($x, $y) = "bca" =~ /^(?=.*(a)).*(bc)/;
+	"$x-$y";
+}, 'captures can move backwards in string');
+
+# perl #27940: \cA not recognized in character classes
+ok("a\cAb" =~ /\cA/, '\cA in pattern');
+ok("a\cAb" =~ /[\cA]/, '\cA in character class');
+ok("a\cAb" =~ /[\cA-\cB]/, '\cA in character class range');
+ok("abc" =~ /[^\cA-\cB]/, '\cA in negated character class range');
+ok("a\cBb" =~ /[\cA-\cC]/, '\cB in character class range');
+ok("a\cCbc" =~ /[^\cA-\cB]/, '\cC in negated character class range');
+ok("a\cAb" =~ /(??{"\cA"})/, '\cA in ??{} pattern');
+
+# perl #28532: optional zero-width match at end of string is ignored
+ok(("abc" =~ /^abc(\z)?/) && defined($1),
+    'optional zero-width match at end of string');
+ok(("abc" =~ /^abc(\z)??/) && !defined($1),
+    'optional zero-width match at end of string');
+
+# last test 1065
diff --git a/gnu/usr.bin/perl/t/op/range.t b/gnu/usr.bin/perl/t/op/range.t
index d54c96d11fd..310f4805d76 100644
--- a/gnu/usr.bin/perl/t/op/range.t
+++ b/gnu/usr.bin/perl/t/op/range.t
@@ -1,6 +1,13 @@
 #!./perl
 
-print "1..25\n";
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}   
+
+use Config;
+
+print "1..37\n";
 
 print join(':',1..5) eq '1:2:3:4:5' ? "ok 1\n" : "not ok 1\n";
 
@@ -47,12 +54,23 @@ print "not " unless join(",", @y) eq join(",", @x);
 print "ok 10\n";
 
 # check bounds
-@a = 0x7ffffffe..0x7fffffff;
-print "not " unless "@a" eq "2147483646 2147483647";
+if ($Config{ivsize} == 8) {
+  @a = eval "0x7ffffffffffffffe..0x7fffffffffffffff";
+  $a = "9223372036854775806 9223372036854775807";
+  @b = eval "-0x7fffffffffffffff..-0x7ffffffffffffffe";
+  $b = "-9223372036854775807 -9223372036854775806";
+}
+else {
+  @a = eval "0x7ffffffe..0x7fffffff";
+  $a = "2147483646 2147483647";
+  @b = eval "-0x7fffffff..-0x7ffffffe";
+  $b = "-2147483647 -2147483646";
+}
+
+print "not " unless "@a" eq $a;
 print "ok 11\n";
 
-@a = -0x7fffffff..-0x7ffffffe;
-print "not " unless "@a" eq "-2147483647 -2147483646";
+print "not " unless "@b" eq $b;
 print "ok 12\n";
 
 # check magic
@@ -83,9 +101,42 @@ print join(":","-4\n".."-0\n") eq "-4:-3:-2:-1:0" ? "ok 19\n" : "not ok 19\n";
 # undef should be treated as 0 for numerical range
 print join(":",undef..2) eq '0:1:2' ? "ok 20\n" : "not ok 20\n";
 print join(":",-2..undef) eq '-2:-1:0' ? "ok 21\n" : "not ok 21\n";
+print join(":",undef..'2') eq '0:1:2' ? "ok 22\n" : "not ok 22\n";
+print join(":",'-2'..undef) eq '-2:-1:0' ? "ok 23\n" : "not ok 23\n";
 
 # undef should be treated as "" for magical range
-print join(":","".."B") eq '' ? "ok 22\n" : "not ok 22\n";
-print join(":",undef.."B") eq '' ? "ok 23\n" : "not ok 23\n";
-print join(":","B".."") eq '' ? "ok 24\n" : "not ok 24\n";
-print join(":","B"..undef) eq '' ? "ok 25\n" : "not ok 25\n";
+print join(":", map "[$_]", "".."B") eq '[]' ? "ok 24\n" : "not ok 24\n";
+print join(":", map "[$_]", undef.."B") eq '[]' ? "ok 25\n" : "not ok 25\n";
+print join(":", map "[$_]", "B".."") eq '' ? "ok 26\n" : "not ok 26\n";
+print join(":", map "[$_]", "B"..undef) eq '' ? "ok 27\n" : "not ok 27\n";
+
+# undef..undef used to segfault
+print join(":", map "[$_]", undef..undef) eq '[]' ? "ok 28\n" : "not ok 28\n";
+
+# also test undef in foreach loops
+@foo=(); push @foo, $_ for undef..2;
+print join(":", @foo) eq '0:1:2' ? "ok 29\n" : "not ok 29\n";
+
+@foo=(); push @foo, $_ for -2..undef;
+print join(":", @foo) eq '-2:-1:0' ? "ok 30\n" : "not ok 30\n";
+
+@foo=(); push @foo, $_ for undef..'2';
+print join(":", @foo) eq '0:1:2' ? "ok 31\n" : "not ok 31\n";
+
+@foo=(); push @foo, $_ for '-2'..undef;
+print join(":", @foo) eq '-2:-1:0' ? "ok 32\n" : "not ok 32\n";
+
+@foo=(); push @foo, $_ for undef.."B";
+print join(":", map "[$_]", @foo) eq '[]' ? "ok 33\n" : "not ok 33\n";
+
+@foo=(); push @foo, $_ for "".."B";
+print join(":", map "[$_]", @foo) eq '[]' ? "ok 34\n" : "not ok 34\n";
+
+@foo=(); push @foo, $_ for "B"..undef;
+print join(":", map "[$_]", @foo) eq '' ? "ok 35\n" : "not ok 35\n";
+
+@foo=(); push @foo, $_ for "B".."";
+print join(":", map "[$_]", @foo) eq '' ? "ok 36\n" : "not ok 36\n";
+
+@foo=(); push @foo, $_ for undef..undef;
+print join(":", map "[$_]", @foo) eq '[]' ? "ok 37\n" : "not ok 37\n";
diff --git a/gnu/usr.bin/perl/t/op/ref.t b/gnu/usr.bin/perl/t/op/ref.t
index 3bb280c1ea2..597e03698c9 100644
--- a/gnu/usr.bin/perl/t/op/ref.t
+++ b/gnu/usr.bin/perl/t/op/ref.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = qw(. ../lib);
 }
 
-print "1..68\n";
+print "1..69\n";
 
 require 'test.pl';
 
@@ -357,6 +357,16 @@ runperl(prog => 'sub f { my $x = shift; *z = $x; } f({}); f();');
 if ($? != 0) { print "not " };
 print "ok ",++$test," - coredump on typeglob = (SvRV && !SvROK)\n";
 
+# bug #27268: freeing self-referential typeglobs could trigger
+# "Attempt to free unreferenced scalar" warnings
+
+$result = runperl(
+    prog => 'use Symbol;my $x=bless \gensym,"t"; print;*$$x=$x',
+    stderr => 1
+);
+print "not " if length $result;
+print "ok ",++$test," - freeing self-referential typeglob\n";
+print "# got: $result\n" if length $result;
 
 # test global destruction
 
diff --git a/gnu/usr.bin/perl/t/op/repeat.t b/gnu/usr.bin/perl/t/op/repeat.t
index 82fcf75bd2f..e728413e9b8 100644
--- a/gnu/usr.bin/perl/t/op/repeat.t
+++ b/gnu/usr.bin/perl/t/op/repeat.t
@@ -6,13 +6,19 @@ BEGIN {
 }
 
 require './test.pl';
-plan(tests => 25);
+plan(tests => 41);
 
 # compile time
 
 is('-' x 5, '-----',    'compile time x');
+is('-' x 3.1, '---',    'compile time 3.1');
+is('-' x 3.9, '---',    'compile time 3.9');
 is('-' x 1, '-',        '  x 1');
 is('-' x 0, '',         '  x 0');
+is('-' x -1, '',        '  x -1');
+is('-' x undef, '',     '  x undef');
+is('-' x "foo", '',     '  x "foo"');
+is('-' x "3rd", '---',  '  x "3rd"');
 
 is('ab' x 3, 'ababab',  '  more than one char');
 
@@ -20,11 +26,21 @@ is('ab' x 3, 'ababab',  '  more than one char');
 
 $a = '-';
 is($a x 5, '-----',     'run time x');
+is($a x 3.1, '---',     '  x 3.1');
+is($a x 3.9, '---',     '  x 3.9');
 is($a x 1, '-',         '  x 1');
 is($a x 0, '',          '  x 0');
+is($a x -3, '',         '  x -3');
+is($a x undef, '',      '  x undef');
+is($a x "foo", '',      '  x "foo"');
+is($a x "3rd", '---',   '  x "3rd"');
 
 $a = 'ab';
 is($a x 3, 'ababab',    '  more than one char');
+$a = 'ab';
+is($a x 0, '',          '  more than one char');
+$a = 'ab';
+is($a x -12, '',        '  more than one char');
 
 $a = 'xyz';
 $a x= 2;
@@ -45,6 +61,9 @@ is(join(':', (9) x 4),      '9:9:9:9',              '(X) x Y');
 is(join(':', (9,9) x 4),    '9:9:9:9:9:9:9:9',      '(X,X) x Y');
 is(join('', (split(//,"123")) x 2), '123123',       'split and x');
 
+is(join('', @x x -12),      '',                     '@x x -12');
+is(join('', (@x) x -14),    '',                     '(@x) x -14');
+
 
 # This test is actually testing for Digital C compiler optimizer bug,
 # present in Dec C versions 5.* and 6.0 (used in Digital UNIX and VMS),
@@ -132,4 +151,3 @@ is(77, scalar ((1,7)x2),    'stack truncation');
     }
     is($y, 'abcdabcd');
 }
-
diff --git a/gnu/usr.bin/perl/t/op/sort.t b/gnu/usr.bin/perl/t/op/sort.t
index 2a86b38c71f..c1129c2422f 100644
--- a/gnu/usr.bin/perl/t/op/sort.t
+++ b/gnu/usr.bin/perl/t/op/sort.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = '../lib';
 }
 use warnings;
-print "1..58\n";
+print "1..75\n";
 
 # these shouldn't hang
 {
@@ -322,3 +322,75 @@ sub cxt_six { sort test_if_scalar 1,2 }
     @a = sort(routine(1));
     print "@a" eq "one two" ? "ok 58\n" : "not ok 58\n";
 }
+
+
+my $test = 59;
+sub ok {
+    print "not " unless $_[0] eq $_[1];
+    print "ok $test - $_[2]\n";
+    print "#[$_[0]] ne [$_[1]]\n" unless $_[0] eq $_[1];
+    $test++;
+}
+
+# check for in-place optimisation of @a = sort @a
+{
+    my ($r1,$r2,@a);
+    our @g;
+    @g = (3,2,1); $r1 = \$g[2]; @g = sort @g; $r2 = \$g[0];
+    ok "$r1-@g", "$r2-1 2 3", "inplace sort of global";
+
+    @a = qw(b a c); $r1 = \$a[1]; @a = sort @a; $r2 = \$a[0];
+    ok "$r1-@a", "$r2-a b c", "inplace sort of lexical";
+
+    @g = (2,3,1); $r1 = \$g[1]; @g = sort { $b <=> $a } @g; $r2 = \$g[0];
+    ok "$r1-@g", "$r2-3 2 1", "inplace reversed sort of global";
+
+    @g = (2,3,1);
+    $r1 = \$g[1]; @g = sort { $a<$b?1:$a>$b?-1:0 } @g; $r2 = \$g[0];
+    ok "$r1-@g", "$r2-3 2 1", "inplace custom sort of global";
+
+    sub mysort { $b cmp $a };
+    @a = qw(b c a); $r1 = \$a[1]; @a = sort mysort @a; $r2 = \$a[0];
+    ok "$r1-@a", "$r2-c b a", "inplace sort with function of lexical";
+
+    use Tie::Array;
+    my @t;
+    tie @t, 'Tie::StdArray';
+
+    @t = qw(b c a); @t = sort @t;
+    ok "@t", "a b c", "inplace sort of tied array";
+
+    @t = qw(b c a); @t = sort mysort @t;
+    ok "@t", "c b a", "inplace sort of tied array with function";
+
+    #  [perl #29790] don't optimise @a = ('a', sort @a) !
+
+    @g = (3,2,1); @g = ('0', sort @g);
+    ok "@g", "0 1 2 3", "un-inplace sort of global";
+    @g = (3,2,1); @g = (sort(@g),'4');
+    ok "@g", "1 2 3 4", "un-inplace sort of global 2";
+
+    @a = qw(b a c); @a = ('x', sort @a);
+    ok "@a", "x a b c", "un-inplace sort of lexical";
+    @a = qw(b a c); @a = ((sort @a), 'x');
+    ok "@a", "a b c x", "un-inplace sort of lexical 2";
+
+    @g = (2,3,1); @g = ('0', sort { $b <=> $a } @g);
+    ok "@g", "0 3 2 1", "un-inplace reversed sort of global";
+    @g = (2,3,1); @g = ((sort { $b <=> $a } @g),'4');
+    ok "@g", "3 2 1 4", "un-inplace reversed sort of global 2";
+
+    @g = (2,3,1); @g = ('0', sort { $a<$b?1:$a>$b?-1:0 } @g);
+    ok "@g", "0 3 2 1", "un-inplace custom sort of global";
+    @g = (2,3,1); @g = ((sort { $a<$b?1:$a>$b?-1:0 } @g),'4');
+    ok "@g", "3 2 1 4", "un-inplace custom sort of global 2";
+
+    @a = qw(b c a); @a = ('x', sort mysort @a);
+    ok "@a", "x c b a", "un-inplace sort with function of lexical";
+    @a = qw(b c a); @a = ((sort mysort @a),'x');
+    ok "@a", "c b a x", "un-inplace sort with function of lexical 2";
+}
+
+
+
+
diff --git a/gnu/usr.bin/perl/t/op/split.t b/gnu/usr.bin/perl/t/op/split.t
index 17ab1e6a375..31a2f51bf93 100644
--- a/gnu/usr.bin/perl/t/op/split.t
+++ b/gnu/usr.bin/perl/t/op/split.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 54;
+plan tests => 55;
 
 $FS = ':';
 
@@ -50,12 +50,12 @@ $_ = join(':', split(/:/,'1:2:3:4:5:6:::', 999));
 is($_ , '1:2:3:4:5:6:::');
 
 # Does assignment to a list imply split to one more field than that?
-if ($^O eq 'MSWin32') { $foo = `.\\perl -D1024 -e "(\$a,\$b) = split;" 2>&1` }
-elsif ($^O eq 'NetWare') { $foo = `perl -D1024 -e "(\$a,\$b) = split;" 2>&1` }
-elsif ($^O eq 'VMS')  { $foo = `./perl "-D1024" -e "(\$a,\$b) = split;" 2>&1` }
-elsif ($^O eq 'MacOS'){ $foo = `$^X "-D1024" -e "(\$a,\$b) = split;"` }
-else                  { $foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1` }
-ok($foo =~ /DEBUGGING/ || $foo =~ /SV = (VOID|IV\(3\))/);
+if ($^O eq 'MSWin32') { $foo = `.\\perl -Dt -e "(\$a,\$b) = split;" 2>&1` }
+elsif ($^O eq 'NetWare') { $foo = `perl -Dt -e "(\$a,\$b) = split;" 2>&1` }
+elsif ($^O eq 'VMS')  { $foo = `./perl "-Dt" -e "(\$a,\$b) = split;" 2>&1` }
+elsif ($^O eq 'MacOS'){ $foo = `$^X "-Dt" -e "(\$a,\$b) = split;"` }
+else                  { $foo = `./perl -Dt -e '(\$a,\$b) = split;' 2>&1` }
+ok($foo =~ /DEBUGGING/ || $foo =~ /\Qconst(IV(3))\E/);
 
 # Can we say how many fields to split to when assigning to a list?
 ($a,$b) = split(' ','1 2 3 4 5 6', 2);
@@ -289,3 +289,16 @@ ok(@ary == 3 &&
     $n = @a = split /,/,$p;
     is ($n, 0, '#21765 - pmreplroot hack used to return undef for 0 iters');
 }
+
+{
+    # [perl #28938]
+    # assigning off the end of the array after a split could leave garbage
+    # in the inner elements
+
+    my $x;
+    @a = split /,/, ',,,,,';
+    $a[3]=1;
+    $x = \$a[2];
+    is (ref $x, 'SCALAR', '#28938 - garbage after extend');
+}
+
diff --git a/gnu/usr.bin/perl/t/op/stat.t b/gnu/usr.bin/perl/t/op/stat.t
index 3cc3f0a1faf..23445c217f2 100644
--- a/gnu/usr.bin/perl/t/op/stat.t
+++ b/gnu/usr.bin/perl/t/op/stat.t
@@ -26,6 +26,7 @@ $Is_Solaris = $^O eq 'solaris';
 $Is_VMS     = $^O eq 'VMS';
 $Is_DGUX    = $^O eq 'dgux';
 $Is_MPRAS   = $^O =~ /svr4/ && -f '/etc/.relid';
+$Is_Rhapsody= $^O eq 'rhapsody';
 
 $Is_Dosish  = $Is_Dos || $Is_OS2 || $Is_MSWin32 || $Is_NetWare || $Is_Cygwin;
 
@@ -112,10 +113,11 @@ SKIP: {
             !isnt($mtime, $ctime, 'hard link ctime != mtime') ) {
             print STDERR <<DIAG;
 # Check if you are on a tmpfs of some sort.  Building in /tmp sometimes
-# has this problem.  Also building on the ClearCase VOBS filesystem may
+# has this problem.  Building on the ClearCase VOBS filesystem may also
 # cause this failure.
-# Darwins UFS doesn't have a ctime concept, and thus is
-# expected to fail this test.
+#
+# Darwin's UFS doesn't have a ctime concept, and thus is expected to fail
+# this test.
 DIAG
         }
     }
@@ -176,7 +178,7 @@ ok(-r $tmpfile,     '   -r');
 ok(-w $tmpfile,     '   -w');
 
 SKIP: {
-    skip "-x simply determins if a file ends in an executable suffix", 1
+    skip "-x simply determines if a file ends in an executable suffix", 1
       if $Is_Dosish || $Is_MacOS;
 
     ok(-x $tmpfile,     '   -x');
@@ -212,7 +214,7 @@ SKIP: {
       if $Is_MSWin32 || $Is_NetWare || $Is_Dos;
     skip "/dev isn't available to test against", 6
       unless -d '/dev' && -r '/dev' && -x '/dev';
-    skip "Skipping; unexpected ls output in MP-RAS", 6
+    skip "Skipping: unexpected ls output in MP-RAS", 6
       if $Is_MPRAS;
 
     my $LS  = $Config{d_readlink} ? "ls -lL" : "ls -l";
@@ -307,7 +309,7 @@ SKIP: {
 SKIP: {
     skip "These tests require a TTY", 4 if $ENV{PERL_SKIP_TTY_TEST};
 
-    my $TTY = $^O eq 'rhapsody' ? "/dev/ttyp0" : "/dev/tty";
+    my $TTY = $Is_Rhapsody ? "/dev/ttyp0" : "/dev/tty";
 
     SKIP: {
         skip "Test uses unixisms", 2 if $Is_MSWin32 || $Is_NetWare;
diff --git a/gnu/usr.bin/perl/t/op/substr.t b/gnu/usr.bin/perl/t/op/substr.t
index dfb483aee58..5a99531205a 100644
--- a/gnu/usr.bin/perl/t/op/substr.t
+++ b/gnu/usr.bin/perl/t/op/substr.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..177\n";
+print "1..181\n";
 
 #P = start of string  Q = start of substr  R = end of substr  S = end of string
 
@@ -609,3 +609,32 @@ ok 174, $x eq "\x{100}\x{200}\xFFb";
     my $y = substr $x, 4;
     ok 177, substr($x, 7, 1) eq "7";
 }
+
+# [perl #24200] string corruption with lvalue sub
+
+{
+    my $foo = "a";
+    sub bar: lvalue { substr $foo, 0 }
+    bar = "XXX";
+    ok 178, bar eq 'XXX';
+    $foo = '123456789';
+    ok 179, bar eq '123456789';
+}
+
+# [perl #29149]
+{
+    my $text  = "0123456789\xED ";
+    utf8::upgrade($text);
+    my $pos = 5;
+    pos($text) = $pos;
+    my $a = substr($text, $pos, $pos);
+    ok 180, substr($text,$pos,1) eq $pos;
+
+}
+
+# [perl #23765]
+{
+    my $a = pack("C", 0xbf);
+    substr($a, -1) &= chr(0xfeff);
+    ok 181, $a eq "\xbf";
+}
diff --git a/gnu/usr.bin/perl/t/op/sysio.t b/gnu/usr.bin/perl/t/op/sysio.t
index 473a3f0883c..435be12efbf 100644
--- a/gnu/usr.bin/perl/t/op/sysio.t
+++ b/gnu/usr.bin/perl/t/op/sysio.t
@@ -1,8 +1,9 @@
 #!./perl
 
-print "1..39\n";
+print "1..42\n";
 
 chdir('op') || chdir('t/op') || die "sysio.t: cannot look for myself: $!";
+@INC = '../../lib';
 
 open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!";
 
@@ -213,6 +214,29 @@ close(I);
 
 unlink $outfile;
 
+# Check that utf8 IO doesn't upgrade the scalar
+open(I, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
+# Will skip harmlessly on stdioperl
+eval {binmode STDOUT, ":utf8"};
+die $@ if $@ and $@ !~ /^IO layers \(like ':utf8'\) unavailable/;
+
+# y diaresis is \w when UTF8
+$a = chr 255;
+
+print $a =~ /\w/ ? "not ok 40\n" : "ok 40\n";
+
+syswrite I, $a;
+
+# Should not be upgraded as a side effect of syswrite.
+print $a =~ /\w/ ? "not ok 41\n" : "ok 41\n";
+
+# This should work
+eval {syswrite I, 2;};
+print $@ eq "" ? "ok 42\n" : "not ok 42 # $@";
+
+close(I);
+unlink $outfile;
+
 chdir('..');
 
 1;
diff --git a/gnu/usr.bin/perl/t/op/taint.t b/gnu/usr.bin/perl/t/op/taint.t
index 9751eecb269..f37f3aaae3a 100644
--- a/gnu/usr.bin/perl/t/op/taint.t
+++ b/gnu/usr.bin/perl/t/op/taint.t
@@ -124,7 +124,7 @@ my $echo = "$Invoke_Perl $ECHO";
 
 my $TEST = catfile(curdir(), 'TEST');
 
-print "1..220\n";
+print "1..223\n";
 
 # First, let's make sure that Perl is checking the dangerous
 # environment variables. Maybe they aren't set yet, so we'll
@@ -1030,4 +1030,14 @@ else
     test 219, !tainted($1);
     ($r = $TAINT) =~ /($TAINT)/;
     test 220, tainted($1);
+
+    #  [perl #24674]
+    # accessing $^O  shoudn't taint it as a side-effect;
+    # assigning tainted data to it is now an error
+
+    test 221, !tainted($^O);
+    if (!$^X) { } elsif ($^O eq 'bar') { }
+    test 222, !tainted($^O);
+    eval '$^O = $^X';
+    test 223, $@ =~ /Insecure dependency in/;
 }
diff --git a/gnu/usr.bin/perl/t/op/write.t b/gnu/usr.bin/perl/t/op/write.t
index 561d49e0e40..7bde0038d51 100644
--- a/gnu/usr.bin/perl/t/op/write.t
+++ b/gnu/usr.bin/perl/t/op/write.t
@@ -5,11 +5,66 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..50\n";
+# read in a file
+sub cat {
+    my $file = shift;
+    local $/;
+    open my $fh, $file or die "can't open '$file': $!";
+    my $data = <$fh>;
+    close $fh;
+    $data;
+}
+
+#-- testing numeric fields in all variants (WL)
+
+sub swrite {
+    my $format = shift;
+    local $^A = ""; # don't litter, use a local bin
+    formline( $format, @_ );
+    return $^A;
+}
+
+my @NumTests = (
+    # [ format, value1, expected1, value2, expected2, .... ]
+    [ '@###',           0,   '   0',         1, '   1',     9999.6, '####',
+		9999.4999,   '9999',    -999.6, '####',     1e+100, '####' ],
+
+    [ '@0##',           0,   '0000',         1, '0001',     9999.6, '####',
+		-999.4999,   '-999',    -999.6, '####',     1e+100, '####' ],
+
+    [ '^###',           0,   '   0',     undef, '    ' ],
+
+    [ '^0##',           0,   '0000',     undef, '    ' ],
+
+    [ '@###.',          0,  '   0.',         1, '   1.',    9999.6, '#####',
+                9999.4999,  '9999.',    -999.6, '#####' ],
+
+    [ '@##.##',         0, '  0.00',         1, '  1.00',  999.996, '######',
+                999.99499, '999.99',      -100, '######' ],
+
+    [ '@0#.##',         0, '000.00',         1, '001.00',       10, '010.00',
+                  -0.0001, qr/^[\-0]00\.00$/ ],
+
+);
+
+
+my $num_tests = 0;
+for my $tref ( @NumTests ){
+    $num_tests += (@$tref - 1)/2;
+}
+#---------------------------------------------------------
+
+# number of tests in section 1
+my $bas_tests = 20;
+
+# number of tests in section 3
+my $hmb_tests = 37;
+
+printf "1..%d\n", $bas_tests + $num_tests + $hmb_tests;
 
-my $CAT = ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') ? 'type'
-	: ($^O eq 'MacOS') ? 'catenate'
-        : 'cat';
+############
+## Section 1
+############
 
 format OUT =
 the quick brown @<<
@@ -50,7 +105,7 @@ the course
 of huma...
 now is the time for all good men to come to\n";
 
-if (`$CAT Op_write.tmp` eq $right)
+if (cat('Op_write.tmp') eq $right)
     { print "ok 1\n"; 1 while unlink 'Op_write.tmp'; }
 else
     { print "not ok 1\n"; }
@@ -92,7 +147,7 @@ becomes
 necessary
 now is the time for all good men to come to\n";
 
-if (`$CAT Op_write.tmp` eq $right)
+if (cat('Op_write.tmp') eq $right)
     { print "ok 2\n"; 1 while unlink 'Op_write.tmp'; }
 else
     { print "not ok 2\n"; }
@@ -136,7 +191,7 @@ becomes
 necessary
 now is the time for all good men to come to\n";
 
-if (`$CAT Op_write.tmp` eq $right)
+if (cat('Op_write.tmp') eq $right)
     { print "ok 3\n"; 1 while unlink 'Op_write.tmp'; }
 else
     { print "not ok 3\n"; }
@@ -191,7 +246,7 @@ close OUT3 or die "Could not close: $!";
 $right =
 "fit\n";
 
-if (`$CAT Op_write.tmp` eq $right)
+if (cat('Op_write.tmp') eq $right)
     { print "ok 6\n"; 1 while unlink 'Op_write.tmp'; }
 else
     { print "not ok 6\n"; }
@@ -219,7 +274,7 @@ format OUT4 =
 open   OUT4, ">Op_write.tmp" or die "Can't create Op_write.tmp";
 write (OUT4);
 close  OUT4 or die "Could not close: $!";
-if (`$CAT Op_write.tmp` eq "1\n") {
+if (cat('Op_write.tmp') eq "1\n") {
     print "ok 9\n";
     1 while unlink "Op_write.tmp";
     }
@@ -241,7 +296,7 @@ write(OUT10);
 close OUT10 or die "Could not close: $!";
 
 $right = "   12.95 00012.95\n";
-if (`$CAT Op_write.tmp` eq $right)
+if (cat('Op_write.tmp') eq $right)
     { print "ok 10\n"; 1 while unlink 'Op_write.tmp'; }
 else
     { print "not ok 10\n"; }
@@ -267,21 +322,26 @@ $right =
 "00012.95
 1 0#
 10 #\n";
-if (`$CAT Op_write.tmp` eq $right)
+if (cat('Op_write.tmp') eq $right)
     { print "ok 11\n"; 1 while unlink 'Op_write.tmp'; }
 else
     { print "not ok 11\n"; }
 
 {
     our $el;
-    format STDOUT =
+    format OUT12 =
 ok ^<<<<<<<<<<<<<<~~ # sv_chop() naze
 $el
 .
     my %hash = (12 => 3);
+    open(OUT12, '>Op_write.tmp') || die "Can't create Op_write.tmp";
+
     for $el (keys %hash) {
-	write;
+	write(OUT12);
     }
+    close OUT12 or die "Could not close: $!";
+    print cat('Op_write.tmp');
+
 }
 
 {
@@ -297,27 +357,163 @@ $v
     open(OUT13, '>Op_write.tmp') || die "Can't create Op_write.tmp";
     write(OUT13);
     close OUT13 or die "Could not close: $!";
-    print `$CAT Op_write.tmp`;
+    print cat('Op_write.tmp');
 }
 
-{
-    # Bug #24774 format without trailing \n failed assertion
+{   # test 14
+    # Bug #24774 format without trailing \n failed assertion, but this
+    # must fail since we have a trailing ; in the eval'ed string (WL)
     my @v = ('k');
     eval "format OUT14 = \n@\n\@v";
-    open(OUT14, '>Op_write.tmp') || die "Can't create Op_write.tmp";
-    write(OUT14);
-    close OUT14 or die "Could not close: $!";
-    print "ok 14\n";
+    print +($@ && $@ =~ /Format not terminated/)
+      ? "ok 14\n" : "not ok 14 $@\n";
+
 }
 
-#######################################
-# Easiest to add new tests above here #
+{   # test 15
+    # text lost in ^<<< field with \r in value (WL)
+    my $txt = "line 1\rline 2";
+    format OUT15 =
+^<<<<<<<<<<<<<<<<<<
+$txt
+^<<<<<<<<<<<<<<<<<<
+$txt
+.
+    open(OUT15, '>Op_write.tmp') || die "Can't create Op_write.tmp";
+    write(OUT15);
+    close OUT15 or die "Could not close: $!";
+    my $res = cat('Op_write.tmp');
+    print $res eq "line 1\nline 2\n" ? "ok 15\n" : "not ok 15\n";
+}
+
+{   # test 16: multiple use of a variable in same line with ^<
+    my $txt = "this_is_block_1 this_is_block_2 this_is_block_3 this_is_block_4";
+    format OUT16 =
+^<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<
+$txt,             $txt
+^<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<
+$txt,             $txt
+.
+    open(OUT16, '>Op_write.tmp') || die "Can't create Op_write.tmp";
+    write(OUT16);
+    close OUT16 or die "Could not close: $!";
+    my $res = cat('Op_write.tmp');
+    print $res eq <<EOD ? "ok 16\n" : "not ok 16\n";
+this_is_block_1   this_is_block_2
+this_is_block_3   this_is_block_4
+EOD
+}
+
+{   # test 17: @* "should be on a line of its own", but it should work
+    # cleanly with literals before and after. (WL)
+
+    my $txt = "This is line 1.\nThis is the second line.\nThird and last.\n";
+    format OUT17 =
+Here we go: @* That's all, folks!
+            $txt
+.
+    open(OUT17, '>Op_write.tmp') || die "Can't create Op_write.tmp";
+    write(OUT17);
+    close OUT17 or die "Could not close: $!";
+    my $res = cat('Op_write.tmp');
+    chomp( $txt );
+    my $exp = <<EOD;
+Here we go: $txt That's all, folks!
+EOD
+    print $res eq $exp ? "ok 17\n" : "not ok 17\n";
+}
+
+{   # test 18: @# and ~~ would cause runaway format, but we now
+    # catch this while compiling (WL)
+
+    format OUT18 =
+@######## ~~
+10
+.
+    open(OUT18, '>Op_write.tmp') || die "Can't create Op_write.tmp";
+    eval { write(OUT18); };
+    print +($@ && $@ =~ /Repeated format line will never terminate/)
+      ? "ok 18\n" : "not ok 18: $@\n";
+    close OUT18 or die "Could not close: $!";
+}
+
+{   # test 19: \0 in an evel'ed format, doesn't cause empty lines (WL)
+    my $v = 'gaga';
+    eval "format OUT19 = \n" .
+         '@<<<' . "\0\n" .
+         '$v' .   "\n" .
+         '@<<<' . "\0\n" .
+         '$v' . "\n.\n";
+    open(OUT19, '>Op_write.tmp') || die "Can't create Op_write.tmp";
+    write(OUT19);
+    close OUT19 or die "Could not close: $!";
+    my $res = cat('Op_write.tmp');
+    print $res eq <<EOD ? "ok 19\n" : "not ok 19\n";
+gaga\0
+gaga\0
+EOD
+}
+
+{   # test 20: hash accesses; single '}' must not terminate format '}' (WL)
+    my %h = ( xkey => 'xval', ykey => 'yval' );
+    format OUT20 =
+@>>>> @<<<< ~~
+each %h
+@>>>> @<<<<
+$h{xkey}, $h{ykey}
+@>>>> @<<<<
+{ $h{xkey}, $h{ykey}
+}
+}
+.
+    my $exp = '';
+    while( my( $k, $v ) = each( %h ) ){
+	$exp .= sprintf( "%5s %s\n", $k, $v );
+    }
+    $exp .= sprintf( "%5s %s\n", $h{xkey}, $h{ykey} );
+    $exp .= sprintf( "%5s %s\n", $h{xkey}, $h{ykey} );
+    $exp .= "}\n";
+    open(OUT20, '>Op_write.tmp') || die "Can't create Op_write.tmp";
+    write(OUT20);
+    close OUT20 or die "Could not close: $!";
+    my $res = cat('Op_write.tmp');
+    print $res eq $exp ? "ok 20\n" : "not ok 20 res=[$res]exp=[$exp]\n";
+}
+
+
+#####################
+## Section 2
+## numeric formatting
+#####################
+
+my $nt = $bas_tests;
+for my $tref ( @NumTests ){
+    my $writefmt = shift( @$tref );
+    while (@$tref) {
+	my $val      = shift @$tref;
+	my $expected = shift @$tref;
+        my $writeres = swrite( $writefmt, $val );
+        $nt++;
+	my $ok = ref($expected)
+		 ? $writeres =~ $expected
+		 : $writeres eq $expected;
+	
+        print $ok
+	    ? "ok $nt - $writefmt\n"
+	    : "not ok $nt\n# f=[$writefmt] exp=[$expected] got=[$writeres]\n";
+    }
+}
+
+
+#####################################
+## Section 3
+## Easiest to add new tests above here
 #######################################
 
-# 15..50: scary format testing from Merijn H. Brand
+# scary format testing from H.Merijn Brand
 
-my $test = 15;
-my $tests = 50;
+my $test = $bas_tests + $num_tests + 1;
+my $tests = $bas_tests + $num_tests + $hmb_tests;
 
 if ($^O eq 'VMS' || $^O eq 'MSWin32' || $^O eq 'dos' || $^O eq 'MacOS' ||
     ($^O eq 'os2' and not eval '$OS2::can_fork')) {
@@ -341,41 +537,73 @@ ok @<<<<<
 $test
 .
 
-$= = 10;
 
 # [ID 20020227.005] format bug with undefined _TOP
+
+open STDOUT_DUP, ">&STDOUT";
+my $oldfh = select STDOUT_DUP;
+$= = 10;
 {   local $~ = "Comment";
     write;
     $test++;
     print $- == 9
-	? "ok $test\n" : "not ok $test # TODO \$- = $- instead of 9\n";
+	? "ok $test # TODO\n" : "not ok $test # TODO \$- = $- instead of 9\n";
     $test++;
-    print $^ ne "Comment_TOP"
-	? "ok $test\n" : "not ok $test # TODO \$^ = $^ instead of 'STDOUT_TOP'\n";
+    print $^ eq "STDOUT_DUP_TOP"
+	? "ok $test\n" : "not ok $test\n# \$^ = $^ instead of 'STDOUT_DUP_TOP'\n";
     $test++;
-    }
+}
+select $oldfh;
+close STDOUT_DUP;
 
-   $^  = "STDOUT_TOP";
-   $=  =  7;		# Page length
-   $-  =  0;		# Lines left
+$^  = "STDOUT_TOP";
+$=  =  7;		# Page length
+$-  =  0;		# Lines left
 my $ps = $^L; $^L = "";	# Catch the page separator
 my $tm =  1;		# Top margin (empty lines before first output)
 my $bm =  2;		# Bottom marging (empty lines between last text and footer)
 my $lm =  4;		# Left margin (indent in spaces)
 
-select ((select (STDOUT), $| = 1)[0]);
-if ($lm > 0 and !open STDOUT, "|-") {	# Left margin (in this test ALWAYS set)
-    select ((select (STDOUT), $| = 1)[0]);
+# -----------------------------------------------------------------------
+#
+# execute the rest of the script in a child process. The parent reads the
+# output from the child and compares it with <DATA>.
+
+my @data = <DATA>;
+
+select ((select (STDOUT), $| = 1)[0]); # flush STDOUT
+
+my $opened = open FROM_CHILD, "-|";
+unless (defined $opened) {
+    print "not ok $test - open gave $!\n"; exit 0;
+}
+
+if ($opened) {
+    # in parent here
+
+    print "ok $test - open\n"; $test++;
     my $s = " " x $lm;
-    while (<STDIN>) {
+    while (<FROM_CHILD>) {
+	unless (@data) {
+	    print "not ok $test - too much output\n";
+	    exit;
+	}
 	s/^/$s/;
-	print + ($_ eq <DATA> ? "" : "not "), "ok ", $test++, "\n";
+	my $exp = shift @data;
+	print + ($_ eq $exp ? "" : "not "), "ok ", $test++, " \n";
+	if ($_ ne $exp) {
+	    s/\n/\\n/g for $_, $exp;
+	    print "#expected: $exp\n#got:      $_\n";
 	}
-    close STDIN;
-    print + (<DATA>?"not ":""), "ok ", $test++, "\n";
-    close STDOUT;
-    exit;
     }
+    close FROM_CHILD;
+    print + (@data?"not ":""), "ok ", $test++, " - too litle output\n";
+    exit;
+}
+
+# in child here
+
+    select ((select (STDOUT), $| = 1)[0]);
 $tm = "\n" x $tm;
 $= -= $bm + 1; # count one for the trailing "----"
 my $lastmin = 0;
diff --git a/gnu/usr.bin/perl/t/uni/tr_7jis.t b/gnu/usr.bin/perl/t/uni/tr_7jis.t
index 6e74f1daa80..b640cce5798 100644
--- a/gnu/usr.bin/perl/t/uni/tr_7jis.t
+++ b/gnu/usr.bin/perl/t/uni/tr_7jis.t
@@ -1,5 +1,5 @@
 #
-# $Id$
+# $Id: tr_7jis.t,v 1.1.1.2 2004/08/09 17:48:37 millert Exp $
 #
 # This script is written intentionally in ISO-2022-JP
 # requires Encode 1.83 or better to work
@@ -8,7 +8,7 @@
 BEGIN {
     if ($ENV{'PERL_CORE'}){
         chdir 't';
-        unshift @INC, '../lib';
+        @INC = '../lib';
     }
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bEncode\b/) {
@@ -23,16 +23,14 @@ BEGIN {
         print "1..0 # Skip: PerlIO required\n";
         exit 0;
     }
-    eval 'use Encode';
-    if ($@ =~ /dynamic loading not available/) {
-        print "1..0 # Skip: no dynamic loading, no Encode\n";
+    if ($ENV{PERL_CORE_MINITEST}) {
+        print "1..0 # Skip: no dynamic loading on miniperl, no Encode\n";
         exit 0;
     }
     $| = 1;
 }
 
 use strict;
-#use Test::More qw(no_plan);
 use Test::More tests => 6;
 use Encode;
 use encoding 'iso-2022-jp';
diff --git a/gnu/usr.bin/perl/t/uni/tr_eucjp.t b/gnu/usr.bin/perl/t/uni/tr_eucjp.t
index 6958f465a8d..b7033f2bdc5 100644
--- a/gnu/usr.bin/perl/t/uni/tr_eucjp.t
+++ b/gnu/usr.bin/perl/t/uni/tr_eucjp.t
@@ -1,5 +1,5 @@
 #
-# $Id$
+# $Id: tr_eucjp.t,v 1.2 2003/12/03 03:02:49 millert Exp $
 #
 # This script is written intentionally in EUC-JP
 # -- dankogai
@@ -7,7 +7,7 @@
 BEGIN {
     if ($ENV{'PERL_CORE'}){
         chdir 't';
-        unshift @INC, '../lib';
+        @INC = '../lib';
     }
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bEncode\b/) {
@@ -22,16 +22,14 @@ BEGIN {
         print "1..0 # Skip: PerlIO required\n";
         exit 0;
     }
-    eval 'use Encode';
-    if ($@ =~ /dynamic loading not available/) {
-        print "1..0 # Skip: no dynamic loading, no Encode\n";
+    if ($ENV{PERL_CORE_MINITEST}) {
+        print "1..0 # Skip: no dynamic loading on miniperl, no Encode\n";
         exit 0;
     }
     $| = 1;
 }
 
 use strict;
-#use Test::More qw(no_plan);
 use Test::More tests => 6;
 use Encode;
 use encoding 'euc-jp';
diff --git a/gnu/usr.bin/perl/t/uni/tr_sjis.t b/gnu/usr.bin/perl/t/uni/tr_sjis.t
index 732eb1ab0b3..7857e05eed1 100644
--- a/gnu/usr.bin/perl/t/uni/tr_sjis.t
+++ b/gnu/usr.bin/perl/t/uni/tr_sjis.t
@@ -1,5 +1,5 @@
 #
-# $Id$
+# $Id: tr_sjis.t,v 1.1.1.2 2004/08/09 17:48:37 millert Exp $
 #
 # This script is written intentionally in Shift JIS
 # -- dankogai
@@ -7,7 +7,7 @@
 BEGIN {
     if ($ENV{'PERL_CORE'}){
         chdir 't';
-        unshift @INC, '../lib';
+        @INC = '../lib';
     }
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bEncode\b/) {
@@ -22,16 +22,14 @@ BEGIN {
         print "1..0 # Skip: PerlIO required\n";
         exit 0;
     }
-    eval 'use Encode';
-    if ($@ =~ /dynamic loading not available/) {
-        print "1..0 # Skip: no dynamic loading, no Encode\n";
+    if ($ENV{PERL_CORE_MINITEST}) {
+        print "1..0 # Skip: no dynamic loading on miniperl, no Encode\n";
         exit 0;
     }
     $| = 1;
 }
 
 use strict;
-#use Test::More qw(no_plan);
 use Test::More tests => 6;
 use Encode;
 use encoding 'shiftjis';
diff --git a/gnu/usr.bin/perl/t/uni/tr_utf8.t b/gnu/usr.bin/perl/t/uni/tr_utf8.t
index e6239095499..002a2457ba6 100644
--- a/gnu/usr.bin/perl/t/uni/tr_utf8.t
+++ b/gnu/usr.bin/perl/t/uni/tr_utf8.t
@@ -1,5 +1,5 @@
 #
-# $Id$
+# $Id: tr_utf8.t,v 1.1.1.2 2004/08/09 17:48:37 millert Exp $
 #
 # This script is written intentionally in UTF-8
 # Requires Encode 1.83 or better
@@ -8,7 +8,7 @@
 BEGIN {
     if ($ENV{'PERL_CORE'}){
         chdir 't';
-        unshift @INC, '../lib';
+        @INC = '../lib';
     }
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bEncode\b/) {
@@ -23,16 +23,14 @@ BEGIN {
         print "1..0 # Skip: PerlIO required\n";
         exit 0;
     }
-    eval 'use Encode';
-    if ($@ =~ /dynamic loading not available/) {
-        print "1..0 # Skip: no dynamic loading, no Encode\n";
+    if ($ENV{PERL_CORE_MINITEST}) {
+        print "1..0 # Skip: no dynamic loading on miniperl, no Encode\n";
         exit 0;
     }
     $| = 1;
 }
 
 use strict;
-#use Test::More qw(no_plan);
 use Test::More tests => 7;
 
 use encoding 'utf8';