Merge in perl 5.10.1; part two

137 files changed, 15067 insertions, 13640 deletions

diff --git a/gnu/usr.bin/perl/t/Module_Pluggable/lib/OddTest/Plugin/Foo.pm b/gnu/usr.bin/perl/t/Module_Pluggable/lib/OddTest/Plugin/Foo.pm
deleted file mode 100644
index bcf37e34bf0..00000000000
--- a/gnu/usr.bin/perl/t/Module_Pluggable/lib/OddTest/Plugin/Foo.pm
+++ /dev/null
@@ -1,5 +0,0 @@
-package OddFiles/Plugin/Foo.pm
-
-sub new {}
-
-1;
diff --git a/gnu/usr.bin/perl/t/Module_Pluggable/lib/TA/C/A/I.pm b/gnu/usr.bin/perl/t/Module_Pluggable/lib/TA/C/A/I.pm
deleted file mode 100644
index 35575dfdde7..00000000000
--- a/gnu/usr.bin/perl/t/Module_Pluggable/lib/TA/C/A/I.pm
+++ /dev/null
@@ -1,13 +0,0 @@
-package TA::C::A::I;
-
-sub foo { }
-
-package TA::C::A::I::A;
-
-sub foo { }
-
-package TA::C::A::I::A::B;
-
-sub foo { }
-
-1;
diff --git a/gnu/usr.bin/perl/t/base/lex.t b/gnu/usr.bin/perl/t/base/lex.t
index f45e56cdf7f..1b8045be715 100644
--- a/gnu/usr.bin/perl/t/base/lex.t
+++ b/gnu/usr.bin/perl/t/base/lex.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..56\n";
+print "1..57\n";
 
 $x = 'x';
 
@@ -267,3 +267,8 @@ foo::::::bar;
 eval "\$x =\xE2foo";
 if ($@ =~ /Unrecognized character \\xE2 in column 5/) { print "ok $test\n"; } else { print "not ok $test\n"; }
 $test++;
+
+# Is "[~" scanned correctly?
+@a = (1,2,3);
+print "not " unless($a[~~2] == 3);
+print "ok 57\n";
diff --git a/gnu/usr.bin/perl/t/cmd/for.t b/gnu/usr.bin/perl/t/cmd/for.t
index ccd042426ba..184d024fbcd 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..80\n";
+print "1..118\n";
 
 for ($i = 0; $i <= 10; $i++) {
     $x[$i] = $i;
@@ -129,6 +129,16 @@ for (map {$_} 1,2,3) {
     $r .= $_;
 }
 is ($r, '123', 'Forwards for list via map');
+$r = '';
+for (1 .. 3) {
+    $r .= $_;
+}
+is ($r, '123', 'Forwards for list via ..');
+$r = '';
+for ('A' .. 'C') {
+    $r .= $_;
+}
+is ($r, 'ABC', 'Forwards for list via ..');
 
 $r = '';
 for (reverse @array) {
@@ -150,6 +160,16 @@ for (reverse map {$_} 1,2,3) {
     $r .= $_;
 }
 is ($r, '321', 'Reverse for list via map');
+$r = '';
+for (reverse 1 .. 3) {
+    $r .= $_;
+}
+is ($r, '321', 'Reverse for list via ..');
+$r = '';
+for (reverse 'A' .. 'C') {
+    $r .= $_;
+}
+is ($r, 'CBA', 'Reverse for list via ..');
 
 $r = '';
 for my $i (@array) {
@@ -171,6 +191,16 @@ for my $i (map {$_} 1,2,3) {
     $r .= $i;
 }
 is ($r, '123', 'Forwards for list via map with var');
+$r = '';
+for my $i (1 .. 3) {
+    $r .= $i;
+}
+is ($r, '123', 'Forwards for list via .. with var');
+$r = '';
+for my $i ('A' .. 'C') {
+    $r .= $i;
+}
+is ($r, 'ABC', 'Forwards for list via .. with var');
 
 $r = '';
 for my $i (reverse @array) {
@@ -192,6 +222,16 @@ for my $i (reverse map {$_} 1,2,3) {
     $r .= $i;
 }
 is ($r, '321', 'Reverse for list via map with var');
+$r = '';
+for my $i (reverse 1 .. 3) {
+    $r .= $i;
+}
+is ($r, '321', 'Reverse for list via .. with var');
+$r = '';
+for my $i (reverse 'A' .. 'C') {
+    $r .= $i;
+}
+is ($r, 'CBA', 'Reverse for list via .. with var');
 
 # For some reason the generate optree is different when $_ is implicit.
 $r = '';
@@ -214,6 +254,16 @@ for $_ (map {$_} 1,2,3) {
     $r .= $_;
 }
 is ($r, '123', 'Forwards for list via map with explicit $_');
+$r = '';
+for $_ (1 .. 3) {
+    $r .= $_;
+}
+is ($r, '123', 'Forwards for list via .. with var with explicit $_');
+$r = '';
+for $_ ('A' .. 'C') {
+    $r .= $_;
+}
+is ($r, 'ABC', 'Forwards for list via .. with var with explicit $_');
 
 $r = '';
 for $_ (reverse @array) {
@@ -235,6 +285,16 @@ for $_ (reverse map {$_} 1,2,3) {
     $r .= $_;
 }
 is ($r, '321', 'Reverse for list via map with explicit $_');
+$r = '';
+for $_ (reverse 1 .. 3) {
+    $r .= $_;
+}
+is ($r, '321', 'Reverse for list via .. with var with explicit $_');
+$r = '';
+for $_ (reverse 'A' .. 'C') {
+    $r .= $_;
+}
+is ($r, 'CBA', 'Reverse for list via .. with var with explicit $_');
 
 # I don't think that my is that different from our in the optree. But test a
 # few:
@@ -258,6 +318,16 @@ for our $i (reverse map {$_} 1,2,3) {
     $r .= $i;
 }
 is ($r, '321', 'Reverse for list via map with our var');
+$r = '';
+for our $i (reverse 1 .. 3) {
+    $r .= $i;
+}
+is ($r, '321', 'Reverse for list via .. with our var');
+$r = '';
+for our $i (reverse 'A' .. 'C') {
+    $r .= $i;
+}
+is ($r, 'CBA', 'Reverse for list via .. with our var');
 
 
 $r = '';
@@ -280,6 +350,16 @@ for ('A', reverse map {$_} 1,2,3) {
     $r .= $_;
 }
 is ($r, 'A321', 'Reverse for list via map with leading value');
+$r = '';
+for ('A', reverse 1 .. 3) {
+    $r .= $_;
+}
+is ($r, 'A321', 'Reverse for list via .. with leading value');
+$r = '';
+for (1, reverse 'A' .. 'C') {
+    $r .= $_;
+}
+is ($r, '1CBA', 'Reverse for list via .. with leading value');
 
 $r = '';
 for (reverse (@array), 1) {
@@ -301,6 +381,16 @@ for (reverse (map {$_} 1,2,3), 'A') {
     $r .= $_;
 }
 is ($r, '321A', 'Reverse for list via map with trailing value');
+$r = '';
+for (reverse (1 .. 3), 'A') {
+    $r .= $_;
+}
+is ($r, '321A', 'Reverse for list via .. with trailing value');
+$r = '';
+for (reverse ('A' .. 'C'), 1) {
+    $r .= $_;
+}
+is ($r, 'CBA1', 'Reverse for list via .. with trailing value');
 
 
 $r = '';
@@ -324,6 +414,16 @@ for $_ ('A', reverse map {$_} 1,2,3) {
     $r .= $_;
 }
 is ($r, 'A321', 'Reverse for list via map with leading value with explicit $_');
+$r = '';
+for $_ ('A', reverse 1 .. 3) {
+    $r .= $_;
+}
+is ($r, 'A321', 'Reverse for list via .. with leading value with explicit $_');
+$r = '';
+for $_ (1, reverse 'A' .. 'C') {
+    $r .= $_;
+}
+is ($r, '1CBA', 'Reverse for list via .. with leading value with explicit $_');
 
 $r = '';
 for $_ (reverse (@array), 1) {
@@ -347,6 +447,16 @@ for $_ (reverse (map {$_} 1,2,3), 'A') {
 }
 is ($r, '321A',
     'Reverse for list via map with trailing value with explicit $_');
+$r = '';
+for $_ (reverse (1 .. 3), 'A') {
+    $r .= $_;
+}
+is ($r, '321A', 'Reverse for list via .. with trailing value with explicit $_');
+$r = '';
+for $_ (reverse ('A' .. 'C'), 1) {
+    $r .= $_;
+}
+is ($r, 'CBA1', 'Reverse for list via .. with trailing value with explicit $_');
 
 $r = '';
 for my $i (1, reverse @array) {
@@ -368,6 +478,16 @@ for my $i ('A', reverse map {$_} 1,2,3) {
     $r .= $i;
 }
 is ($r, 'A321', 'Reverse for list via map with leading value and var');
+$r = '';
+for my $i ('A', reverse 1 .. 3) {
+    $r .= $i;
+}
+is ($r, 'A321', 'Reverse for list via .. with leading value and var');
+$r = '';
+for my $i (1, reverse 'A' .. 'C') {
+    $r .= $i;
+}
+is ($r, '1CBA', 'Reverse for list via .. with leading value and var');
 
 $r = '';
 for my $i (reverse (@array), 1) {
@@ -389,6 +509,16 @@ for my $i (reverse (map {$_} 1,2,3), 'A') {
     $r .= $i;
 }
 is ($r, '321A', 'Reverse for list via map with trailing value and var');
+$r = '';
+for my $i (reverse (1 .. 3), 'A') {
+    $r .= $i;
+}
+is ($r, '321A', 'Reverse for list via .. with trailing value and var');
+$r = '';
+for my $i (reverse ('A' .. 'C'), 1) {
+    $r .= $i;
+}
+is ($r, 'CBA1', 'Reverse for list via .. with trailing value and var');
 
 
 $r = '';
@@ -401,6 +531,26 @@ for (reverse map {$_} 1, @array) {
     $r .= $_;
 }
 is ($r, 'CBA1', 'Reverse for value and array via map');
+$r = '';
+for (reverse 1 .. 3, @array) {
+    $r .= $_;
+}
+is ($r, 'CBA321', 'Reverse for .. and array');
+$r = '';
+for (reverse 'X' .. 'Z', @array) {
+    $r .= $_;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array');
+$r = '';
+for (reverse map {$_} 1 .. 3, @array) {
+    $r .= $_;
+}
+is ($r, 'CBA321', 'Reverse for .. and array via map');
+$r = '';
+for (reverse map {$_} 'X' .. 'Z', @array) {
+    $r .= $_;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array via map');
 
 $r = '';
 for (reverse (@array, 1)) {
@@ -423,6 +573,26 @@ for $_ (reverse map {$_} 1, @array) {
     $r .= $_;
 }
 is ($r, 'CBA1', 'Reverse for value and array via map with explicit $_');
+$r = '';
+for $_ (reverse 1 .. 3, @array) {
+    $r .= $_;
+}
+is ($r, 'CBA321', 'Reverse for .. and array with explicit $_');
+$r = '';
+for $_ (reverse 'X' .. 'Z', @array) {
+    $r .= $_;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array with explicit $_');
+$r = '';
+for $_ (reverse map {$_} 1 .. 3, @array) {
+    $r .= $_;
+}
+is ($r, 'CBA321', 'Reverse for .. and array via map with explicit $_');
+$r = '';
+for $_ (reverse map {$_} 'X' .. 'Z', @array) {
+    $r .= $_;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array via map with explicit $_');
 
 $r = '';
 for $_ (reverse (@array, 1)) {
@@ -446,6 +616,26 @@ for my $i (reverse map {$_} 1, @array) {
     $r .= $i;
 }
 is ($r, 'CBA1', 'Reverse for value and array via map with var');
+$r = '';
+for my $i (reverse 1 .. 3, @array) {
+    $r .= $i;
+}
+is ($r, 'CBA321', 'Reverse for .. and array with var');
+$r = '';
+for my $i (reverse 'X' .. 'Z', @array) {
+    $r .= $i;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array with var');
+$r = '';
+for my $i (reverse map {$_} 1 .. 3, @array) {
+    $r .= $i;
+}
+is ($r, 'CBA321', 'Reverse for .. and array via map with var');
+$r = '';
+for my $i (reverse map {$_} 'X' .. 'Z', @array) {
+    $r .= $i;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array via map with var');
 
 $r = '';
 for my $i (reverse (@array, 1)) {
diff --git a/gnu/usr.bin/perl/t/comp/multiline.t b/gnu/usr.bin/perl/t/comp/multiline.t
index e8b7cf4a161..0409f8b8786 100644
--- a/gnu/usr.bin/perl/t/comp/multiline.t
+++ b/gnu/usr.bin/perl/t/comp/multiline.t
@@ -8,7 +8,8 @@ BEGIN {
 
 plan(tests => 6);
 
-open(TRY,'>Comp.try') || (die "Can't open temp file.");
+my $filename = tempfile();
+open(TRY,'>',$filename) || (die "Can't open $filename: $!");
 
 $x = 'now is the time
 for all good men
@@ -28,7 +29,7 @@ is($x, $y,  'test data is sane');
 print TRY $x;
 close TRY or die "Could not close: $!";
 
-open(TRY,'Comp.try') || (die "Can't reopen temp file.");
+open(TRY,$filename) || (die "Can't reopen $filename: $!");
 $count = 0;
 $z = '';
 while (<TRY>) {
@@ -41,13 +42,13 @@ is($z, $y,  'basic multiline reading');
 is($count, 7,   '    line count');
 is($., 7,       '    $.' );
 
-$out = (($^O eq 'MSWin32') || $^O eq 'NetWare' || $^O eq 'VMS') ? `type Comp.try`
-    : ($^O eq 'MacOS') ? `catenate Comp.try`
-    : `cat Comp.try`;
+$out = (($^O eq 'MSWin32') || $^O eq 'NetWare') ? `type $filename`
+    : ($^O eq 'VMS') ? `type $filename.;0`   # otherwise .LIS is assumed
+    : ($^O eq 'MacOS') ? `catenate $filename`
+    : `cat $filename`;
 
 like($out, qr/.*\n.*\n.*\n$/);
 
-close(TRY) || (die "Can't close temp file.");
-unlink 'Comp.try' || `/bin/rm -f Comp.try`;
+close(TRY) || (die "Can't close $filename: $!");
 
 is($out, $y);
diff --git a/gnu/usr.bin/perl/t/comp/script.t b/gnu/usr.bin/perl/t/comp/script.t
index 6efffdf81a6..83d733abd23 100644
--- a/gnu/usr.bin/perl/t/comp/script.t
+++ b/gnu/usr.bin/perl/t/comp/script.t
@@ -8,22 +8,22 @@ BEGIN {
 
 my $Perl = which_perl();
 
+my $filename = tempfile();
+
 print "1..3\n";
 
 $x = `$Perl -le "print 'ok';"`;
 
 if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";}
 
-open(try,">Comp.script") || (die "Can't open temp file.");
+open(try,">$filename") || (die "Can't open temp file.");
 print try 'print "ok\n";'; print try "\n";
 close try or die "Could not close: $!";
 
-$x = `$Perl Comp.script`;
+$x = `$Perl $filename`;
 
 if ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";}
 
-$x = `$Perl <Comp.script`;
+$x = `$Perl <$filename`;
 
 if ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";}
-
-unlink 'Comp.script' || `/bin/rm -f Comp.script`;
diff --git a/gnu/usr.bin/perl/t/comp/use.t b/gnu/usr.bin/perl/t/comp/use.t
index a43bbeb44c9..d3a3568c1c2 100644
--- a/gnu/usr.bin/perl/t/comp/use.t
+++ b/gnu/usr.bin/perl/t/comp/use.t
@@ -190,12 +190,12 @@ if ($^O eq 'MacOS') {
 {
     # Regression test for patch 14937: 
     #   Check that a .pm file with no package or VERSION doesn't core.
-    open F, ">xxx.pm" or die "Cannot open xxx.pm: $!\n";
+    open F, ">xxx$$.pm" or die "Cannot open xxx$$.pm: $!\n";
     print F "1;\n";
     close F;
-    eval "use lib '.'; use xxx 3;";
-    like ($@, qr/^xxx defines neither package nor VERSION--version check failed at/);
-    unlink 'xxx.pm';
+    eval "use lib '.'; use xxx$$ 3;";
+    like ($@, qr/^xxx$$ defines neither package nor VERSION--version check failed at/);
+    unlink "xxx$$.pm";
 }
 
 my @ver = split /\./, sprintf "%vd", $^V;
diff --git a/gnu/usr.bin/perl/t/io/dup.t b/gnu/usr.bin/perl/t/io/dup.t
index 3f211b40d2c..ac2f3f465dd 100644
--- a/gnu/usr.bin/perl/t/io/dup.t
+++ b/gnu/usr.bin/perl/t/io/dup.t
@@ -17,7 +17,9 @@ print "ok 1\n";
 open(DUPOUT,">&STDOUT");
 open(DUPERR,">&STDERR");
 
-open(STDOUT,">Io.dup")  || die "Can't open stdout";
+my $tempfile = tempfile();
+
+open(STDOUT,">$tempfile")  || die "Can't open stdout";
 open(STDERR,">&STDOUT") || die "Can't open stderr";
 
 select(STDERR); $| = 1;
@@ -36,19 +38,12 @@ $cmd = sprintf "$echo 1>&2", 5;
 $cmd = sprintf $echo, 5 if $^O eq 'MacOS';  # don't know if we can do this ...
 print `$cmd`;
 
-# KNOWN BUG system() does not honor STDOUT redirections on VMS.
-if( $^O eq 'VMS' ) {
-    print "not ok $_ # TODO system() not honoring STDOUT redirect on VMS\n"
-      for 6..7;
+system sprintf $echo, 6;
+if ($^O eq 'MacOS') {
+    system sprintf $echo, 7;
 }
 else {
-    system sprintf $echo, 6;
-    if ($^O eq 'MacOS') {
-        system sprintf $echo, 7;
-    }
-    else {
-        system sprintf "$echo 1>&2", 7;
-    }
+    system sprintf "$echo 1>&2", 7;
 }
 
 close(STDOUT) or die "Could not close: $!";
@@ -57,10 +52,10 @@ close(STDERR) or die "Could not close: $!";
 open(STDOUT,">&DUPOUT") or die "Could not open: $!";
 open(STDERR,">&DUPERR") or die "Could not open: $!";
 
-if (($^O eq 'MSWin32') || ($^O eq 'NetWare') || ($^O eq 'VMS')) { print `type Io.dup` }
-elsif ($^O eq 'MacOS') { system 'catenate Io.dup' }
-else                   { system 'cat Io.dup' }
-unlink 'Io.dup';
+if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) { print `type $tempfile` }
+elsif ($^O eq 'VMS')   { system "type $tempfile.;" } # TYPE defaults to .LIS when there is no extension
+elsif ($^O eq 'MacOS') { system "catenate $tempfile" }
+else                   { system "cat $tempfile" }
 
 print STDOUT "ok 8\n";
 
@@ -110,7 +105,7 @@ SKIP: {
     is(fileno(F), fileno(STDERR));
     close F;
 
-    open(G, ">dup$$") or die;
+    open(G, ">$tempfile") or die;
     my $g = fileno(G);
 
     ok(open(F, ">&=$g"));
@@ -126,7 +121,7 @@ SKIP: {
     close G; # flush first
     close F; # flush second
 
-    open(G, "<dup$$") or die;
+    open(G, "<$tempfile") or die;
     {
 	my $line;
 	$line = <G>; chomp $line; is($line, "ggg");
@@ -134,7 +129,7 @@ SKIP: {
     }
     close G;
 
-    open UTFOUT, '>:utf8', "dup$$" or die $!;
+    open UTFOUT, '>:utf8', $tempfile or die $!;
     open UTFDUP, '>&UTFOUT' or die $!;
     # some old greek saying.
     my $message = "\x{03A0}\x{0391}\x{039D}\x{03A4}\x{0391} \x{03A1}\x{0395}\x{0399}\n";
@@ -144,7 +139,7 @@ SKIP: {
     print UTFDUP $message;
     close UTFOUT;
     close UTFDUP;
-    open(UTFIN, "<:utf8", "dup$$") or die $!;
+    open(UTFIN, "<:utf8", $tempfile) or die $!;
     {
 	my $line;
 	$line = <UTFIN>; is($line, $message);
@@ -153,5 +148,4 @@ SKIP: {
     }
     close UTFIN;
 
-    END { 1 while unlink "dup$$" }
 }
diff --git a/gnu/usr.bin/perl/t/io/fs.t b/gnu/usr.bin/perl/t/io/fs.t
index b8976471067..8c45c8d9f4d 100644
--- a/gnu/usr.bin/perl/t/io/fs.t
+++ b/gnu/usr.bin/perl/t/io/fs.t
@@ -51,25 +51,27 @@ my $skip_mode_checks =
 
 plan tests => 51;
 
+my $tmpdir = tempfile();
+my $tmpdir1 = tempfile();
 
 if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) {
-    `rmdir /s /q tmp 2>nul`;
-    `mkdir tmp`;
+    `rmdir /s /q $tmpdir 2>nul`;
+    `mkdir $tmpdir`;
 }
 elsif ($^O eq 'VMS') {
-    `if f\$search("[.tmp]*.*") .nes. "" then delete/nolog/noconfirm [.tmp]*.*.*`;
-    `if f\$search("tmp.dir") .nes. "" then set file/prot=o:rwed tmp.dir;`;
-    `if f\$search("tmp.dir") .nes. "" then delete/nolog/noconfirm tmp.dir;`;
-    `create/directory [.tmp]`;
+    `if f\$search("[.$tmpdir]*.*") .nes. "" then delete/nolog/noconfirm [.$tmpdir]*.*.*`;
+    `if f\$search("$tmpdir.dir") .nes. "" then set file/prot=o:rwed $tmpdir.dir;`;
+    `if f\$search("$tmpdir.dir") .nes. "" then delete/nolog/noconfirm $tmpdir.dir;`;
+    `create/directory [.$tmpdir]`;
 }
 elsif ($Is_MacOS) {
-    rmdir "tmp"; mkdir "tmp";
+    rmdir "$tmpdir"; mkdir "$tmpdir";
 }
 else {
-    `rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`;
+    `rm -f $tmpdir 2>/dev/null; mkdir $tmpdir 2>/dev/null`;
 }
 
-chdir catdir(curdir(), 'tmp');
+chdir catdir(curdir(), $tmpdir);
 
 `/bin/rm -rf a b c x` if -x '/bin/rm';
 
@@ -87,7 +89,7 @@ open(FH,'>a') || die "Can't create a";
 close(FH);
 
 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-    $blksize,$blocks);
+    $blksize,$blocks,$a_mode);
 
 SKIP: {
     skip("no link", 4) unless $has_link;
@@ -95,6 +97,8 @@ SKIP: {
     ok(link('a','b'), "link a b");
     ok(link('b','c'), "link b c");
 
+    $a_mode = (stat('a'))[2];
+
     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
      $blksize,$blocks) = stat('c');
 
@@ -111,7 +115,9 @@ SKIP: {
 #      if ($^O eq 'cygwin') { # new files on cygwin get rwx instead of rw-
 #          is($mode & 0777, 0777, "mode of triply-linked file");
 #      } else {
-            is($mode & 0777, 0666, "mode of triply-linked file");
+            is(sprintf("0%o", $mode & 0777), 
+               sprintf("0%o", $a_mode & 0777), 
+               "mode of triply-linked file");
 #      }
     }
 }
@@ -275,7 +281,7 @@ sub check_utime_result {
 		is( $atime, 500000001,          'atime' );
 		is( $mtime, 500000000 + $delta, 'mtime' );
 	    }
-	    elsif ($^O eq 'beos') {
+	    elsif ($^O eq 'beos' || $^O eq 'haiku') {
             SKIP: {
 		    skip "atime not updated", 1;
 		}
@@ -326,8 +332,8 @@ SKIP: {
     unlink("TEST$$");
 }
 
-unlink "Iofs.tmp";
-open IOFSCOM, ">Iofs.tmp" or die "Could not write IOfs.tmp: $!";
+my $tmpfile = tempfile();
+open IOFSCOM, ">$tmpfile" or die "Could not write IOfs.tmp: $!";
 print IOFSCOM 'helloworld';
 close(IOFSCOM);
 
@@ -336,24 +342,24 @@ close(IOFSCOM);
 
 SKIP: {
 # Check truncating a closed file.
-    eval { truncate "Iofs.tmp", 5; };
+    eval { truncate $tmpfile, 5; };
 
     skip("no truncate - $@", 8) if $@;
 
-    is(-s "Iofs.tmp", 5, "truncation to five bytes");
+    is(-s $tmpfile, 5, "truncation to five bytes");
 
-    truncate "Iofs.tmp", 0;
+    truncate $tmpfile, 0;
 
-    ok(-z "Iofs.tmp",    "truncation to zero bytes");
+    ok(-z $tmpfile,    "truncation to zero bytes");
 
 #these steps are necessary to check if file is really truncated
 #On Win95, FH is updated, but file properties aren't
-    open(FH, ">Iofs.tmp") or die "Can't create Iofs.tmp";
+    open(FH, ">$tmpfile") or die "Can't create $tmpfile";
     print FH "x\n" x 200;
     close FH;
 
 # Check truncating an open file.
-    open(FH, ">>Iofs.tmp") or die "Can't open Iofs.tmp for appending";
+    open(FH, ">>$tmpfile") or die "Can't open $tmpfile for appending";
 
     binmode FH;
     select FH;
@@ -367,7 +373,7 @@ SKIP: {
     }
 
     if ($needs_fh_reopen) {
-	close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
+	close (FH); open (FH, ">>$tmpfile") or die "Can't reopen $tmpfile";
     }
 
     SKIP: {
@@ -375,19 +381,19 @@ SKIP: {
 	    skip ("# TODO - hit VOS bug posix-973 - cannot resize an open file below the current file pos.", 5);
 	}
 
-	is(-s "Iofs.tmp", 200, "fh resize to 200 working (filename check)");
+	is(-s $tmpfile, 200, "fh resize to 200 working (filename check)");
 
 	ok(truncate(FH, 0), "fh resize to zero");
 
 	if ($needs_fh_reopen) {
-	    close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
+	    close (FH); open (FH, ">>$tmpfile") or die "Can't reopen $tmpfile";
 	}
 
-	ok(-z "Iofs.tmp", "fh resize to zero working (filename check)");
+	ok(-z $tmpfile, "fh resize to zero working (filename check)");
 
 	close FH;
 
-	open(FH, ">>Iofs.tmp") or die "Can't open Iofs.tmp for appending";
+	open(FH, ">>$tmpfile") or die "Can't open $tmpfile for appending";
 
 	binmode FH;
 	select FH;
@@ -401,10 +407,10 @@ SKIP: {
 	}
 
 	if ($needs_fh_reopen) {
-	    close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
+	    close (FH); open (FH, ">>$tmpfile") or die "Can't reopen $tmpfile";
 	}
 
-	is(-s "Iofs.tmp", 100, "fh resize by IO slot working");
+	is(-s $tmpfile, 100, "fh resize by IO slot working");
 
 	close FH;
     }
@@ -415,7 +421,7 @@ SKIP: {
     skip "Works in Cygwin only if check_case is set to relaxed", 1
       if ($ENV{'CYGWIN'} && ($ENV{'CYGWIN'} =~ /check_case:(?:adjust|strict)/));
 
-    chdir './tmp';
+    chdir "./$tmpdir";
     open(FH,'>x') || die "Can't create x";
     close(FH);
     rename('x', 'X');
@@ -430,15 +436,15 @@ SKIP: {
 # check if rename() works on directories
 if ($^O eq 'VMS') {
     # must have delete access to rename a directory
-    `set file tmp.dir/protection=o:d`;
-    ok(rename('tmp.dir', 'tmp1.dir'), "rename on directories") ||
+    `set file $tmpdir.dir/protection=o:d`;
+    ok(rename("$tmpdir.dir", "$tmpdir1.dir"), "rename on directories") ||
       print "# errno: $!\n";
 }
 else {
-    ok(rename('tmp', 'tmp1'), "rename on directories");
+    ok(rename($tmpdir, $tmpdir1), "rename on directories");
 }
 
-ok(-d 'tmp1', "rename on directories working");
+ok(-d $tmpdir1, "rename on directories working");
 
 {
     # Change 26011: Re: A surprising segfault
@@ -451,5 +457,5 @@ ok(-d 'tmp1', "rename on directories working");
     ok(1, "extend sp in pp_chown");
 }
 
-# need to remove 'tmp' if rename() in test 28 failed!
-END { rmdir 'tmp1'; rmdir 'tmp'; 1 while unlink "Iofs.tmp"; }
+# need to remove $tmpdir if rename() in test 28 failed!
+END { rmdir $tmpdir1; rmdir $tmpdir; }
diff --git a/gnu/usr.bin/perl/t/io/inplace.t b/gnu/usr.bin/perl/t/io/inplace.t
index a7a21e4f4d7..a9664dce754 100644
--- a/gnu/usr.bin/perl/t/io/inplace.t
+++ b/gnu/usr.bin/perl/t/io/inplace.t
@@ -6,10 +6,10 @@ $^I = $^O eq 'VMS' ? '_bak' : '.bak';
 
 plan( tests => 2 );
 
-my @tfiles     = ('.a','.b','.c');
-my @tfiles_bak = (".a$^I", ".b$^I", ".c$^I");
+my @tfiles     = (tempfile(), tempfile(), tempfile());
+my @tfiles_bak = map "$_$^I", @tfiles;
 
-END { unlink_all('.a','.b','.c',".a$^I", ".b$^I", ".c$^I"); }
+END { unlink_all(@tfiles_bak); }
 
 for my $file (@tfiles) {
     runperl( prog => 'print qq(foo\n);', 
diff --git a/gnu/usr.bin/perl/t/io/open.t b/gnu/usr.bin/perl/t/io/open.t
index f08eed50a4a..325d637e9e0 100644
--- a/gnu/usr.bin/perl/t/io/open.t
+++ b/gnu/usr.bin/perl/t/io/open.t
@@ -9,21 +9,21 @@ BEGIN {
 $|  = 1;
 use warnings;
 use Config;
-$Is_VMS = $^O eq 'VMS';
 $Is_MacOS = $^O eq 'MacOS';
 
 plan tests => 108;
 
 my $Perl = which_perl();
 
+my $afile = tempfile();
 {
-    unlink("afile") if -f "afile";
+    unlink($afile) if -f $afile;
 
-    $! = 0;  # the -f above will set $! if 'afile' doesn't exist.
-    ok( open(my $f,"+>afile"),  'open(my $f, "+>...")' );
+    $! = 0;  # the -f above will set $! if $afile doesn't exist.
+    ok( open(my $f,"+>$afile"),  'open(my $f, "+>...")' );
 
     binmode $f;
-    ok( -f "afile",             '       its a file');
+    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' );
@@ -36,25 +36,25 @@ my $Perl = which_perl();
     like( $@, qr/<\$f> line 1/, '       die message correct' );
     
     ok( close($f),              '       close()' );
-    ok( unlink("afile"),        '       unlink()' );
+    ok( unlink($afile),         '       unlink()' );
 }
 
 {
-    ok( open(my $f,'>', 'afile'),       "open(my \$f, '>', 'afile')" );
+    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' );
+    ok( -s $afile < 10,                 '       -s' );
 }
 
 {
-    ok( open(my $f,'>>', 'afile'),      "open(my \$f, '>>', 'afile')" );
+    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'    );
+    ok( -s $afile > 10,                 '       -s'    );
 }
 
 {
-    ok( open(my $f, '<', 'afile'),      "open(my \$f, '<', 'afile')" );
+    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' );
@@ -63,22 +63,19 @@ my $Perl = which_perl();
 }
 
 {
-    ok( -s 'afile' < 20,                '-s' );
+    ok( -s $afile < 20,                 '-s' );
 
-    ok( open(my $f, '+<', 'afile'),     'open +<' );
+    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' );
+    ok( -s $afile > 20,                 '       -s' );
 
-    unlink("afile");
+    unlink($afile);
 }
-
-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
@@ -87,7 +84,6 @@ EOC
     is( scalar @rows, 2,                '       readline, list context' );
     ok( close($f),                      '       close' );
 }
-
 SKIP: {
     skip "Output for |- doesn't go to shell on MacOS", 5 if $Is_MacOS;
 
@@ -109,18 +105,18 @@ EOC
 }
 
 
-ok( !eval { open my $f, '<&', 'afile'; 1; },    '<& on a non-filehandle' );
-like( $@, qr/Bad filehandle:\s+afile/,          '       right error' );
+ok( !eval { open my $f, '<&', $afile; 1; },    '<& on a non-filehandle' );
+like( $@, qr/Bad filehandle:\s+$afile/,          '       right error' );
 
 
 # local $file tests
 {
-    unlink("afile") if -f "afile";
+    unlink($afile) if -f $afile;
 
-    ok( open(local $f,"+>afile"),       'open local $f, "+>", ...' );
+    ok( open(local $f,"+>$afile"),       'open local $f, "+>", ...' );
     binmode $f;
 
-    ok( -f "afile",                     '       -f' );
+    ok( -f $afile,                      '       -f' );
     ok( (print $f "SomeData\n"),        '       print' );
     is( tell($f), 9,                    '       tell' );
     ok( seek($f,0,0),                   '       seek set' );
@@ -133,47 +129,45 @@ like( $@, qr/Bad filehandle:\s+afile/,          '       right error' );
     like( $@, qr/<\$f> line 1/,         '       proper die message' );
     ok( close($f),                      '       close' );
 
-    unlink("afile");
+    unlink($afile);
 }
 
 {
-    ok( open(local $f,'>', 'afile'),    'open local $f, ">", ...' );
+    ok( open(local $f,'>', $afile),     'open local $f, ">", ...' );
     ok( (print $f "a row\n"),           '       print');
     ok( close($f),                      '       close');
-    ok( -s 'afile' < 10,                '       -s' );
+    ok( -s $afile < 10,                 '       -s' );
 }
 
 {
-    ok( open(local $f,'>>', 'afile'),   'open local $f, ">>", ...' );
+    ok( open(local $f,'>>', $afile),    'open local $f, ">>", ...' );
     ok( (print $f "a row\n"),           '       print');
     ok( close($f),                      '       close');
-    ok( -s 'afile' > 10,                '       -s' );
+    ok( -s $afile > 10,                 '       -s' );
 }
 
 {
-    ok( open(local $f, '<', 'afile'),   'open local $f, "<", ...' );
+    ok( open(local $f, '<', $afile),    'open local $f, "<", ...' );
     my @rows = <$f>;
     is( scalar @rows, 2,                '       readline list context' );
     ok( close($f),                      '       close' );
 }
 
-ok( -s 'afile' < 20,                '       -s' );
+ok( -s $afile < 20,                     '       -s' );
 
 {
-    ok( open(local $f, '+<', 'afile'),  'open local $f, "+<", ...' );
+    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' );
+    ok( -s $afile > 20,                 '       -s' );
 
-    unlink("afile");
+    unlink($afile);
 }
 
-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
@@ -204,8 +198,8 @@ EOC
 }
 
 
-ok( !eval { open local $f, '<&', 'afile'; 1 },  'local <& on non-filehandle');
-like( $@, qr/Bad filehandle:\s+afile/,          '       right error' );
+ok( !eval { open local $f, '<&', $afile; 1 },  'local <& on non-filehandle');
+like( $@, qr/Bad filehandle:\s+$afile/,          '       right error' );
 
 {
     local *F;
@@ -289,19 +283,19 @@ SKIP: {
     use warnings 'layer';
     local $SIG{__WARN__} = sub { $w = shift };
 
-    eval { open(F, ">>>", "afile") };
+    eval { open(F, ">>>", $afile) };
     like($w, qr/Invalid separator character '>' in PerlIO layer spec/,
 	 "bad open (>>>) warning");
     like($@, qr/Unknown open\(\) mode '>>>'/,
 	 "bad open (>>>) failure");
 
-    eval { open(F, ">:u", "afile" ) };
+    eval { open(F, ">:u", $afile ) };
     like($w, qr/Unknown PerlIO layer "u"/,
 	 'bad layer ">:u" warning');
-    eval { open(F, "<:u", "afile" ) };
+    eval { open(F, "<:u", $afile ) };
     like($w, qr/Unknown PerlIO layer "u"/,
 	 'bad layer "<:u" warning');
-    eval { open(F, ":c", "afile" ) };
+    eval { open(F, ":c", $afile ) };
     like($@, qr/Unknown open\(\) mode ':c'/,
 	 'bad layer ":c" failure');
 }
diff --git a/gnu/usr.bin/perl/t/io/read.t b/gnu/usr.bin/perl/t/io/read.t
index 2665ecb9210..57e671d27c8 100644
--- a/gnu/usr.bin/perl/t/io/read.t
+++ b/gnu/usr.bin/perl/t/io/read.t
@@ -12,7 +12,9 @@ die $@ if $@ and !$ENV{PERL_CORE_MINITEST};
 
 plan tests => 2;
 
-open(A,"+>a");
+my $tmpfile = tempfile();
+
+open(A,"+>$tmpfile");
 print A "_";
 seek(A,0,0);
 
@@ -23,12 +25,8 @@ read(A,$b,1,4);
 
 close(A);
 
-unlink("a");
-
 is($b,"\000\000\000\000_"); # otherwise probably "\000bcd_"
 
-unlink 'a';
-
 SKIP: {
     skip "no EBADF", 1 if (!exists &Errno::EBADF);
 
diff --git a/gnu/usr.bin/perl/t/io/tell.t b/gnu/usr.bin/perl/t/io/tell.t
index 4881d4340fa..09b61a3dfa3 100644
--- a/gnu/usr.bin/perl/t/io/tell.t
+++ b/gnu/usr.bin/perl/t/io/tell.t
@@ -3,6 +3,7 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
 print "1..28\n";
@@ -101,9 +102,7 @@ close(OTHER);
 # something else.  ftell() on pipes, fifos, and sockets is defined to
 # return -1.
 
-my $written = "tell_write.txt";
-
-END { 1 while unlink($written) }
+my $written = tempfile();
 
 close($TST);
 open($tst,">$written")  || die "Cannot open $written:$!";
diff --git a/gnu/usr.bin/perl/t/lib/Dummy.pm b/gnu/usr.bin/perl/t/lib/Dummy.pm
deleted file mode 100644
index 504330f8b16..00000000000
--- a/gnu/usr.bin/perl/t/lib/Dummy.pm
+++ /dev/null
@@ -1,4 +0,0 @@
-package Dummy;
-
-# Attempt to emulate a bug with finding the version in Exporter.
-$VERSION = '5.562';
diff --git a/gnu/usr.bin/perl/t/lib/HasSigDie.pm b/gnu/usr.bin/perl/t/lib/HasSigDie.pm
deleted file mode 100644
index 3368e049957..00000000000
--- a/gnu/usr.bin/perl/t/lib/HasSigDie.pm
+++ /dev/null
@@ -1,6 +0,0 @@
-package HasSigDie;
-
-$SIG{__DIE__} = sub { "Die, Bart, Die!" };
-
-1;
-
diff --git a/gnu/usr.bin/perl/t/lib/NoExporter.pm b/gnu/usr.bin/perl/t/lib/NoExporter.pm
deleted file mode 100644
index 1ab5b8f9f42..00000000000
--- a/gnu/usr.bin/perl/t/lib/NoExporter.pm
+++ /dev/null
@@ -1,10 +0,0 @@
-package NoExporter;
-
-$VERSION = 1.02;
-sub import { 
-    shift;
-    die "NoExporter exports nothing.  You asked for: @_" if @_;
-}
-
-1;
-
diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/Catch.pm b/gnu/usr.bin/perl/t/lib/Test/Simple/Catch.pm
index 6f6049356db..9a2efb192d6 100644
--- a/gnu/usr.bin/perl/t/lib/Test/Simple/Catch.pm
+++ b/gnu/usr.bin/perl/t/lib/Test/Simple/Catch.pm
@@ -1,7 +1,8 @@
 # For testing Test::Simple;
-# $Id$
 package Test::Simple::Catch;
 
+use strict;
+
 use Symbol;
 use TieOut;
 my( $out_fh, $err_fh ) = ( gensym, gensym );
diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death.plx
index 14ec3d6d97f..e682ec08a25 100644
--- a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death.plx
+++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death.plx
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death_in_eval.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death_in_eval.plx
index f3fb6ab3758..269bffa8025 100644
--- a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death_in_eval.plx
+++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death_in_eval.plx
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 use Carp;
 
 push @INC, 't/lib';
diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death_with_handler.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death_with_handler.plx
index 935ab36ac70..7dabb31d609 100644
--- a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death_with_handler.plx
+++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death_with_handler.plx
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id: death_with_handler.plx,v 1.1 2009/05/16 21:42:58 simon Exp $
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
@@ -16,4 +15,6 @@ tie *STDERR, 'Dev::Null';
 
 ok(1);
 ok(1);
+
+$! = 0;
 die "This is a test";
diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/exit.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/exit.plx
index 26c3b031ef6..7f8ff73f752 100644
--- a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/exit.plx
+++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/exit.plx
@@ -1,4 +1,3 @@
 require Test::Builder;
-# $Id: exit.plx,v 1.2 2009/05/16 21:42:58 simon Exp $
 
 exit 1;
diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/extras.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/extras.plx
index d2e9e99baf8..c9c89520aa3 100644
--- a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/extras.plx
+++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/extras.plx
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/five_fail.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/five_fail.plx
index 6110cb6f652..c058e1f8f01 100644
--- a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/five_fail.plx
+++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/five_fail.plx
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 use lib 't/lib';
 require Test::Simple::Catch;
diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/last_minute_death.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/last_minute_death.plx
index 94274adf046..e3d01beeb78 100644
--- a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/last_minute_death.plx
+++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/last_minute_death.plx
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
@@ -16,4 +15,5 @@ ok(1);
 ok(1);
 ok(1);
 
+$! = 0;
 die "This is a test";
diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/one_fail.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/one_fail.plx
index 80aba3109be..99c720250d2 100644
--- a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/one_fail.plx
+++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/one_fail.plx
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/pre_plan_death.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/pre_plan_death.plx
index 6b2ddb87832..f72d3b65e57 100644
--- a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/pre_plan_death.plx
+++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/pre_plan_death.plx
@@ -1,5 +1,4 @@
 # ID 20020716.013, the exit code would become 0 if the test died
-# $Id: pre_plan_death.plx,v 1.2 2009/05/16 21:42:58 simon Exp $
 # before a plan.
 
 require Test::Simple;
diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/require.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/require.plx
index 7f9adebf87d..1a06690d9dc 100644
--- a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/require.plx
+++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/require.plx
@@ -1,2 +1 @@
 require Test::Simple;
-# $Id$
diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/success.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/success.plx
index 99c2d9b542c..585d6c3d790 100644
--- a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/success.plx
+++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/success.plx
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/too_few.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/too_few.plx
index 003b07d6ed4..bbc630ddcec 100644
--- a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/too_few.plx
+++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/too_few.plx
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/too_few_fail.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/too_few_fail.plx
index e5ab8b3e1d3..9ca4517b662 100644
--- a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/too_few_fail.plx
+++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/too_few_fail.plx
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id: too_few_fail.plx,v 1.2 2009/05/16 21:42:58 simon Exp $
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/two_fail.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/two_fail.plx
index d4d6c378fff..e3d92296af9 100644
--- a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/two_fail.plx
+++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/two_fail.plx
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/bailout b/gnu/usr.bin/perl/t/lib/sample-tests/bailout
deleted file mode 100644
index f67f673e7d3..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/bailout
+++ /dev/null
@@ -1,9 +0,0 @@
-print <<DUMMY_TEST;
-1..5
-ok 1
-ok 2
-ok 3
-Bail out!  GERONIMMMOOOOOO!!!
-ok 4
-ok 5
-DUMMY_TEST
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/bignum b/gnu/usr.bin/perl/t/lib/sample-tests/bignum
deleted file mode 100644
index 3f51d38a424..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/bignum
+++ /dev/null
@@ -1,7 +0,0 @@
-print <<DUMMY;
-1..2
-ok 1
-ok 2
-ok 100001
-ok 136211425
-DUMMY
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/bignum_many b/gnu/usr.bin/perl/t/lib/sample-tests/bignum_many
deleted file mode 100644
index 1e30b2f1dd2..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/bignum_many
+++ /dev/null
@@ -1,14 +0,0 @@
-print <<DUMMY;
-1..2
-ok 1
-ok 2
-ok 99997
-ok 99998
-ok 99999
-ok 100000
-ok 100001
-ok 100002
-ok 100003
-ok 100004
-ok 100005
-DUMMY
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/combined b/gnu/usr.bin/perl/t/lib/sample-tests/combined
deleted file mode 100644
index 8dfaa28e926..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/combined
+++ /dev/null
@@ -1,13 +0,0 @@
-print <<DUMMY_TEST;
-1..10 todo 4 10
-ok 1
-ok 2 basset hounds got long ears
-not ok 3        all hell broke lose
-ok 4
-ok
-ok 6
-ok 7            # Skip contract negociations
-ok 8
-not ok 9
-not ok 10
-DUMMY_TEST
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/descriptive b/gnu/usr.bin/perl/t/lib/sample-tests/descriptive
deleted file mode 100644
index e165ac1bf5c..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/descriptive
+++ /dev/null
@@ -1,8 +0,0 @@
-print <<DUMMY_TEST;
-1..5
-ok 1    Interlock activated
-ok 2    Megathrusters are go
-ok 3    Head formed
-ok 4    Blazing sword formed
-ok 5    Robeast destroyed
-DUMMY_TEST
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/die b/gnu/usr.bin/perl/t/lib/sample-tests/die
deleted file mode 100644
index 4c8534082da..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/die
+++ /dev/null
@@ -1,2 +0,0 @@
-use if ($^O eq 'VMS'), vmsish => 'hushed';
-exit 1;  # exit because die() can be noisy
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/die_head_end b/gnu/usr.bin/perl/t/lib/sample-tests/die_head_end
deleted file mode 100644
index afcea1b3c83..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/die_head_end
+++ /dev/null
@@ -1,9 +0,0 @@
-print <<DUMMY_TEST;
-ok 1
-ok 2
-ok 3
-ok 4
-DUMMY_TEST
-
-use if $^O eq 'VMS', vmsish => 'hushed';
-exit 1;
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/die_last_minute b/gnu/usr.bin/perl/t/lib/sample-tests/die_last_minute
deleted file mode 100644
index e421dd1c0e2..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/die_last_minute
+++ /dev/null
@@ -1,10 +0,0 @@
-print <<DUMMY_TEST;
-ok 1
-ok 2
-ok 3
-ok 4
-1..4
-DUMMY_TEST
-
-use if $^O eq 'VMS', vmsish => 'hushed';
-exit 1;
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/duplicates b/gnu/usr.bin/perl/t/lib/sample-tests/duplicates
deleted file mode 100644
index 63f6a706b63..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/duplicates
+++ /dev/null
@@ -1,14 +0,0 @@
-print <<DUMMY_TEST
-1..10
-ok 1
-ok 2
-ok 3
-ok 4
-ok 4
-ok 5
-ok 6
-ok 7
-ok 8
-ok 9
-ok 10
-DUMMY_TEST
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/head_end b/gnu/usr.bin/perl/t/lib/sample-tests/head_end
deleted file mode 100644
index 14a32f2fe6b..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/head_end
+++ /dev/null
@@ -1,11 +0,0 @@
-print <<DUMMY_TEST;
-# comments
-ok 1
-ok 2
-ok 3
-ok 4
-# comment
-1..4
-# more ignored stuff
-# and yet more
-DUMMY_TEST
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/head_fail b/gnu/usr.bin/perl/t/lib/sample-tests/head_fail
deleted file mode 100644
index 9d1667ab19a..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/head_fail
+++ /dev/null
@@ -1,11 +0,0 @@
-print <<DUMMY_TEST;
-# comments
-ok 1
-not ok 2
-ok 3
-ok 4
-# comment
-1..4
-# more ignored stuff
-# and yet more
-DUMMY_TEST
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/inc_taint b/gnu/usr.bin/perl/t/lib/sample-tests/inc_taint
deleted file mode 100644
index c0dc994989c..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/inc_taint
+++ /dev/null
@@ -1,7 +0,0 @@
-#!/usr/bin/perl -Tw
-
-use lib qw(t/lib);
-use Test::More tests => 1;
-
-ok( grep(/we_added_this_lib/, @INC) );
-
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/lone_not_bug b/gnu/usr.bin/perl/t/lib/sample-tests/lone_not_bug
deleted file mode 100644
index 10eaa2a3b02..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/lone_not_bug
+++ /dev/null
@@ -1,9 +0,0 @@
-# There was a bug where the first test would be considered a
-# 'lone not' failure.
-print <<DUMMY;
-ok 1
-ok 2
-ok 3
-ok 4
-1..4
-DUMMY
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/no_nums b/gnu/usr.bin/perl/t/lib/sample-tests/no_nums
deleted file mode 100644
index c32d3f22baa..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/no_nums
+++ /dev/null
@@ -1,8 +0,0 @@
-print <<DUMMY_TEST;
-1..5
-ok
-ok
-not ok
-ok
-ok
-DUMMY_TEST
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/no_output b/gnu/usr.bin/perl/t/lib/sample-tests/no_output
deleted file mode 100644
index 505acda7e6d..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/no_output
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/usr/bin/perl -w
-
-exit;
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/out_of_order b/gnu/usr.bin/perl/t/lib/sample-tests/out_of_order
deleted file mode 100644
index 77641aa3620..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/out_of_order
+++ /dev/null
@@ -1,22 +0,0 @@
-# From a bungled core thread test.
-#
-# The important thing here is that the last test is the right test.
-# Test::Harness would misparse this as being a valid test.
-print <<DUMMY;
-ok 2 - Test that argument passing works
-ok 3 - Test that passing arguments as references work
-ok 4 - Test a normal sub
-ok 6 - Detach test
-ok 8 - Nested thread test
-ok 9 - Nested thread test
-ok 10 - Wanted 7, got 7
-ok 11 - Wanted 7, got 7
-ok 12 - Wanted 8, got 8
-ok 13 - Wanted 8, got 8
-1..15
-ok 1
-ok 5 - Check that Config::threads is true
-ok 7 - Detach test
-ok 14 - Check so that tid for threads work for main thread
-ok 15 - Check so that tid for threads work for main thread
-DUMMY
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/segfault b/gnu/usr.bin/perl/t/lib/sample-tests/segfault
deleted file mode 100644
index c5670a42b59..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/segfault
+++ /dev/null
@@ -1,5 +0,0 @@
-#!/usr/bin/perl
-
-print "1..1\n";
-print "ok 1\n";
-kill 11, $$;
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/shbang_misparse b/gnu/usr.bin/perl/t/lib/sample-tests/shbang_misparse
deleted file mode 100644
index bc1b524a347..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/shbang_misparse
+++ /dev/null
@@ -1,12 +0,0 @@
-#!/usr/bin/perl-latest
-
-# The above #! line was misparsed as having a -t.
-# Pre-5.8 this will simply cause perl to choke, since there was no -t.
-# Post-5.8 taint warnings will mistakenly be on.
-
-print "1..2\n";
-print "ok 1\n";
-my $warning = '';
-$SIG{__WARN__} = sub { $warning .= $_[0] };
-eval("#" . substr($0, 0, 0));
-print $warning ? "not ok 2\n" : "ok 2\n";
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/simple b/gnu/usr.bin/perl/t/lib/sample-tests/simple
deleted file mode 100644
index d6b85846b26..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/simple
+++ /dev/null
@@ -1,8 +0,0 @@
-print <<DUMMY_TEST;
-1..5
-ok 1
-ok 2
-ok 3
-ok 4
-ok 5
-DUMMY_TEST
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/simple_fail b/gnu/usr.bin/perl/t/lib/sample-tests/simple_fail
deleted file mode 100644
index aa65f5f66de..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/simple_fail
+++ /dev/null
@@ -1,8 +0,0 @@
-print <<DUMMY_TEST;
-1..5
-ok 1
-not ok 2
-ok 3
-ok 4
-not ok 5
-DUMMY_TEST
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/skip b/gnu/usr.bin/perl/t/lib/sample-tests/skip
deleted file mode 100644
index 1b43d12f3b9..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/skip
+++ /dev/null
@@ -1,8 +0,0 @@
-print <<DUMMY_TEST;
-1..5
-ok 1
-ok 2    # skipped rain delay
-ok 3
-ok 4
-ok 5
-DUMMY_TEST
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/skip_nomsg b/gnu/usr.bin/perl/t/lib/sample-tests/skip_nomsg
deleted file mode 100644
index 51d1ed6b43f..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/skip_nomsg
+++ /dev/null
@@ -1,4 +0,0 @@
-print <<DUMMY;
-1..1
-ok 1 # Skip
-DUMMY
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/skipall b/gnu/usr.bin/perl/t/lib/sample-tests/skipall
deleted file mode 100644
index 8c4679660c2..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/skipall
+++ /dev/null
@@ -1,3 +0,0 @@
-print <<DUMMY_TEST;
-1..0 # skip: rope
-DUMMY_TEST
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/skipall_nomsg b/gnu/usr.bin/perl/t/lib/sample-tests/skipall_nomsg
deleted file mode 100644
index 9b0dc11a697..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/skipall_nomsg
+++ /dev/null
@@ -1,2 +0,0 @@
-print "1..0\n";
-exit 0;
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/switches b/gnu/usr.bin/perl/t/lib/sample-tests/switches
deleted file mode 100644
index 8ce9c9a589e..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/switches
+++ /dev/null
@@ -1,2 +0,0 @@
-print "1..1\n";
-print $INC{'strict.pm'} ? "ok 1\n" : "not ok 1\n";
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/taint b/gnu/usr.bin/perl/t/lib/sample-tests/taint
deleted file mode 100644
index 42968d36e32..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/taint
+++ /dev/null
@@ -1,7 +0,0 @@
-#!/usr/bin/perl -Tw
-
-use lib qw(t/lib);
-use Test::More tests => 1;
-
-eval { kill 0, $^X };
-like( $@, '/^Insecure dependency/',   '-T honored' );
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/taint_warn b/gnu/usr.bin/perl/t/lib/sample-tests/taint_warn
deleted file mode 100644
index 5b4c4861667..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/taint_warn
+++ /dev/null
@@ -1,11 +0,0 @@
-#!/usr/bin/perl -tw
-
-use lib qw(t/lib);
-use Test::More tests => 1;
-
-my $warnings = '';
-{
-    local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
-    kill 0, $^X;
-}
-like( $warnings, '/^Insecure dependency/',   '-t honored' );
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/todo b/gnu/usr.bin/perl/t/lib/sample-tests/todo
deleted file mode 100644
index 5620ee20ee0..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/todo
+++ /dev/null
@@ -1,8 +0,0 @@
-print <<DUMMY_TEST;
-1..5 todo 3   2;
-ok 1
-ok 2
-not ok 3
-ok 4
-ok 5
-DUMMY_TEST
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/todo_inline b/gnu/usr.bin/perl/t/lib/sample-tests/todo_inline
deleted file mode 100644
index 5b96d68caf2..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/todo_inline
+++ /dev/null
@@ -1,6 +0,0 @@
-print <<DUMMY_TEST;
-1..3
-not ok 1 - Foo # TODO Just testing the todo interface.
-ok 2 - Unexpected success # TODO Just testing the todo interface.
-ok 3 - This is not todo
-DUMMY_TEST
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/too_many b/gnu/usr.bin/perl/t/lib/sample-tests/too_many
deleted file mode 100644
index 46acaded4d5..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/too_many
+++ /dev/null
@@ -1,14 +0,0 @@
-print <<DUMMY;
-1..3
-ok 1
-ok 2
-ok 3
-ok 4
-ok 5
-ok 6
-ok 7
-DUMMY
-
-exit 4;  # simulate Test::More's exit status
-
-
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/vms_nit b/gnu/usr.bin/perl/t/lib/sample-tests/vms_nit
deleted file mode 100644
index 1df7804309f..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/vms_nit
+++ /dev/null
@@ -1,6 +0,0 @@
-print <<DUMMY;
-1..2
-not 
-ok 1
-ok 2
-DUMMY
diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/with_comments b/gnu/usr.bin/perl/t/lib/sample-tests/with_comments
deleted file mode 100644
index 7aa913985b1..00000000000
--- a/gnu/usr.bin/perl/t/lib/sample-tests/with_comments
+++ /dev/null
@@ -1,14 +0,0 @@
-print <<DUMMY_TEST;
-# and stuff
-1..5 todo 1 2 4 5;
-# yeah, that
-not ok 1
-# Failed test 1 in t/todo.t at line 9 *TODO*
-ok 2 # (t/todo.t at line 10 TODO?!)
-ok 3
-not ok 4
-# Test 4 got: '0' (t/todo.t at line 12 *TODO*)
-#   Expected: '1' (need more tuits)
-ok 5 # (t/todo.t at line 13 TODO?!)
-# woo
-DUMMY_TEST
diff --git a/gnu/usr.bin/perl/t/op/bop.t b/gnu/usr.bin/perl/t/op/bop.t
index 7e8a0c7aa21..b7f82eefc5f 100644
--- a/gnu/usr.bin/perl/t/op/bop.t
+++ b/gnu/usr.bin/perl/t/op/bop.t
@@ -15,7 +15,7 @@ BEGIN {
 # 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 => 161;
+plan tests => 161 + (10*13*2) + 4;
 
 # numerics
 ok ((0xdead & 0xbeef) == 0x9ead);
@@ -428,3 +428,105 @@ SKIP: {
   my $ref = "\x{10000}\0";
   is(~~$str, $ref);
 }
+
+# ref tests
+
+my %res;
+
+for my $str ("x", "\x{100}") {
+    for my $chr (qw/S A H G X ( * F/) {
+        for my $op (qw/| & ^/) {
+            my $co = ord $chr;
+            my $so = ord $str;
+            $res{"$chr$op$str"} = eval qq/chr($co $op $so)/;
+        }
+    }
+    $res{"undef|$str"} = $str;
+    $res{"undef&$str"} = "";
+    $res{"undef^$str"} = $str;
+}
+
+sub PVBM () { "X" }
+index "foo", PVBM;
+
+my $warn = 0;
+local $^W = 1;
+local $SIG{__WARN__} = sub { $warn++ };
+
+sub is_first {
+    my ($got, $orig, $op, $str, $name) = @_;
+    is(substr($got, 0, 1), $res{"$orig$op$str"}, $name);
+}
+
+for (
+    # [object to test, first char of stringification, name]
+    [undef,             "undef",    "undef"         ],
+    [\1,                "S",        "scalar ref"    ],
+    [[],                "A",        "array ref"     ],
+    [{},                "H",        "hash ref"      ],
+    [qr/x/,             "(",        "qr//"          ],
+    [*foo,              "*",        "glob"          ],
+    [\*foo,             "G",        "glob ref"      ],
+    [PVBM,              "X",        "PVBM"          ],
+    [\PVBM,             "S",        "PVBM ref"      ],
+    [bless([], "Foo"),  "F",        "object"        ],
+) {
+    my ($val, $orig, $type) = @$_;
+
+    for (["x", "string"], ["\x{100}", "utf8"]) {
+        my ($str, $desc) = @$_;
+
+        $warn = 0;
+
+        is_first($val | $str, $orig, "|", $str, "$type | $desc");
+        is_first($val & $str, $orig, "&", $str, "$type & $desc");
+        is_first($val ^ $str, $orig, "^", $str, "$type ^ $desc");
+
+        is_first($str | $val, $orig, "|", $str, "$desc | $type");
+        is_first($str & $val, $orig, "&", $str, "$desc & $type");
+        is_first($str ^ $val, $orig, "^", $str, "$desc ^ $type");
+
+        my $new;
+        ($new = $val) |= $str;
+        is_first($new, $orig, "|", $str, "$type |= $desc");
+        ($new = $val) &= $str;
+        is_first($new, $orig, "&", $str, "$type &= $desc");
+        ($new = $val) ^= $str;
+        is_first($new, $orig, "^", $str, "$type ^= $desc");
+
+        ($new = $str) |= $val;
+        is_first($new, $orig, "|", $str, "$desc |= $type");
+        ($new = $str) &= $val;
+        is_first($new, $orig, "&", $str, "$desc &= $type");
+        ($new = $str) ^= $val;
+        is_first($new, $orig, "^", $str, "$desc ^= $type");
+
+        if ($orig eq "undef") {
+            # undef |= and undef ^= don't warn
+            is($warn, 10, "no duplicate warnings");
+        }
+        else {
+            is($warn, 0, "no warnings");
+        }
+    }
+}
+
+my $strval;
+
+{
+    package Bar;
+    use overload q/""/ => sub { $strval };
+
+    package Baz;
+    use overload q/|/ => sub { "y" };
+}
+
+ok(!eval { bless([], "Bar") | "x"; 1 },     "string overload can't use |");
+like($@, qr/no method found/,               "correct error");
+is(eval { bless([], "Baz") | "x" }, "y",    "| overload works");
+
+my $obj = bless [], "Bar";
+$strval = "x";
+eval { $obj |= "Q" };
+$strval = "z";
+is("$obj", "z", "|= doesn't break string overload");
diff --git a/gnu/usr.bin/perl/t/op/closure.t b/gnu/usr.bin/perl/t/op/closure.t
index 7d8df6a2cc4..5e3bf455911 100644
--- a/gnu/usr.bin/perl/t/op/closure.t
+++ b/gnu/usr.bin/perl/t/op/closure.t
@@ -14,7 +14,7 @@ BEGIN {
 use Config;
 require './test.pl'; # for runperl()
 
-print "1..187\n";
+print "1..188\n";
 
 my $test = 1;
 sub test (&) {
@@ -463,9 +463,8 @@ END
 	    }
 	  } else {
 	    # No fork().  Do it the hard way.
-	    my $cmdfile = "tcmd$$";  $cmdfile++ while -e $cmdfile;
-	    my $errfile = "terr$$";  $errfile++ while -e $errfile;
-	    my @tmpfiles = ($cmdfile, $errfile);
+	    my $cmdfile = tempfile();
+	    my $errfile = tempfile();
 	    open CMD, ">$cmdfile"; print CMD $code; close CMD;
 	    my $cmd = which_perl();
 	    $cmd .= " -w $cmdfile 2>$errfile";
@@ -477,18 +476,15 @@ END
 	      { local $/; $output = join '', <PERL> }
 	      close PERL;
 	    } else {
-	      my $outfile = "tout$$";  $outfile++ while -e $outfile;
-	      push @tmpfiles, $outfile;
+	      my $outfile = tempfile();
 	      system "$cmd >$outfile";
 	      { local $/; open IN, $outfile; $output = <IN>; close IN }
 	    }
 	    if ($?) {
 	      printf "not ok: exited with error code %04X\n", $?;
-	      $debugging or do { 1 while unlink @tmpfiles };
 	      exit;
 	    }
 	    { local $/; open IN, $errfile; $errors = <IN>; close IN }
-	    1 while unlink @tmpfiles;
 	  }
 	  print $output;
 	  print STDERR $errors;
@@ -688,7 +684,22 @@ __EOF__
     test { $flag == 1 };
 }
 
+# don't copy a stale lexical; crate a fresh undef one instead
 
+sub f {
+    my $x if $_[0];
+    sub { \$x }
+}
+
+{
+    f(1);
+    my $c1= f(0);
+    my $c2= f(0);
+
+    my $r1 = $c1->();
+    my $r2 = $c2->();
+    test { $r1 != $r2 };
+}
 
 
 
diff --git a/gnu/usr.bin/perl/t/op/eval.t b/gnu/usr.bin/perl/t/op/eval.t
index 2eb9b1e9edd..071b2fa05ce 100644
--- a/gnu/usr.bin/perl/t/op/eval.t
+++ b/gnu/usr.bin/perl/t/op/eval.t
@@ -3,9 +3,10 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
-print "1..95\n";
+print "1..99\n";
 
 eval 'print "ok 1\n";';
 
@@ -38,11 +39,12 @@ $fact = 'local($foo)=$foo; $foo <= 1 ? 1 : $foo-- * (eval $fact);';
 $ans = eval $fact;
 if ($ans == 120) {print "ok 9\n";} else {print "not ok 9 $ans\n";}
 
-open(try,'>Op.eval');
-print try 'print "ok 10\n"; unlink "Op.eval";',"\n";
+my $tempfile = tempfile();
+open(try,'>',$tempfile);
+print try 'print "ok 10\n";',"\n";
 close try;
 
-do './Op.eval'; print $@;
+do "./$tempfile"; print $@;
 
 # Test the singlequoted eval optimizer
 
@@ -485,4 +487,73 @@ print "ok $test - eval and last\n"; $test++;
 }
 
 
+# [perl #51370] eval { die "\x{a10d}" } followed by eval { 1 } did not reset
+# length $@ 
+$@ = "";
+eval { die "\x{a10d}"; };
+$_ = length $@;
+eval { 1 };
+
+print "not " if ($@ ne "");
+print "ok $test # length of \$@ after eval\n"; $test++;
+
+print "not " if (length $@ != 0);
+print "ok $test # length of \$@ after eval\n"; $test++;
+
+# Check if eval { 1 }; compeltly resets $@
+if (eval "use Devel::Peek; 1;") {
+  $tempfile = tempfile();
+  $outfile = tempfile();
+  open PROG, ">", $tempfile or die "Can't create test file";
+  my $prog = <<'END_EVAL_TEST';
+    use Devel::Peek;
+    $! = 0;
+    $@ = $!;
+    my $ok = 0;
+    open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
+    if (open(OUT, '>', '@@@@')) {
+      open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
+      Dump($@);
+      print STDERR "******\n";
+      eval { die "\x{a10d}"; };
+      $_ = length $@;
+      eval { 1 };
+      Dump($@);
+      open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
+      close(OUT);
+      if (open(IN, '<', '@@@@')) {
+        local $/;
+        my $in = <IN>;
+        my ($first, $second) = split (/\*\*\*\*\*\*\n/, $in, 2);
+        $first =~ s/,pNOK//;
+        $ok = 1 if ($first eq $second);
+      }
+    }
+
+    print $ok;
+END_EVAL_TEST
+    $prog =~ s/\@\@\@\@/$outfile/g;
+    print PROG $prog;
+   close PROG;
 
+   my $ok = runperl(progfile => $tempfile);
+   print "not " unless $ok;
+   print "ok $test # eval { 1 } completly resets \$@\n";
+}
+else {
+  print "ok $test # skipped - eval { 1 } completly resets \$@\n";
+}
+$test++;
+
+# Test that "use feature" and other hint transmission in evals and s///ee
+# don't leak memory
+{
+    use feature qw(:5.10);
+    my $count_expected = ($^H & 0x20000) ? 2 : 1;
+    my $t;
+    my $s = "a";
+    $s =~ s/a/$t = \%^H;  qq( qq() );/ee;
+    print "not " if Internals::SvREFCNT(%$t) != $count_expected;
+    print "ok $test - RT 63110\n";
+    $test++;
+}
diff --git a/gnu/usr.bin/perl/t/op/exec.t b/gnu/usr.bin/perl/t/op/exec.t
index c23364b29d4..91821aa08e6 100644
--- a/gnu/usr.bin/perl/t/op/exec.t
+++ b/gnu/usr.bin/perl/t/op/exec.t
@@ -6,6 +6,25 @@ BEGIN {
     require './test.pl';
 }
 
+my $vms_exit_mode = 0;
+
+if ($^O eq 'VMS') {
+    if (eval 'require VMS::Feature') {
+        $vms_exit_mode = !(VMS::Feature::current("posix_exit"));
+    } else {
+        my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+        my $env_posix_ex = $ENV{'PERL_VMS_POSIX_EXIT'} || '';
+        my $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; 
+        my $posix_ex = $env_posix_ex =~ /^[ET1]/i;
+        if (($unix_rpt || $posix_ex) ) {
+            $vms_exit_mode = 0;
+        } else {
+            $vms_exit_mode = 1;
+        }
+    }
+}
+
+
 # supress VMS whinging about bad execs.
 use vmsish qw(hushed);
 
@@ -85,7 +104,7 @@ is( $echo_out, "ok\n", 'piped echo emulation');
 
 is( system(qq{$Perl -e "exit 0"}), 0,     'Explicit exit of 0' );
 
-my $exit_one = $Is_VMS ? 4 << 8 : 1 << 8;
+my $exit_one = $vms_exit_mode ? 4 << 8 : 1 << 8;
 is( system(qq{$Perl "-I../lib" -e "use vmsish qw(hushed); exit 1"}), $exit_one,
     'Explicit exit of 1' );
 
diff --git a/gnu/usr.bin/perl/t/op/fork.t b/gnu/usr.bin/perl/t/op/fork.t
index 7318449a7c7..9fe8107cfa1 100644
--- a/gnu/usr.bin/perl/t/op/fork.t
+++ b/gnu/usr.bin/perl/t/op/fork.t
@@ -11,6 +11,7 @@ BEGIN {
 	exit 0;
     }
     $ENV{PERL5LIB} = "../lib";
+    require './test.pl';
 }
 
 if ($^O eq 'mpeix') {
@@ -24,9 +25,8 @@ undef $/;
 @prgs = split "\n########\n", <DATA>;
 print "1..", scalar @prgs, "\n";
 
-$tmpfile = "forktmp000";
-1 while -f ++$tmpfile;
-END { close TEST; unlink $tmpfile if $tmpfile; }
+$tmpfile = tempfile();
+END { close TEST }
 
 $CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : (($^O eq 'NetWare') ? 'perl -e "print <>"' : 'cat'));
 
@@ -54,8 +54,8 @@ for (@prgs){
     }
     $status = $?;
     $results =~ s/\n+$//;
-    $results =~ s/at\s+forktmp\d+\s+line/at - line/g;
-    $results =~ s/of\s+forktmp\d+\s+aborted/of - aborted/g;
+    $results =~ s/at\s+$::tempfile_regexp\s+line/at - line/g;
+    $results =~ s/of\s+$::tempfile_regexp\s+aborted/of - aborted/g;
 # bison says 'parse error' instead of 'syntax error',
 # various yaccs may or may not capitalize 'syntax'.
     $results =~ s/^(syntax|parse) error/syntax error/mig;
@@ -445,16 +445,14 @@ pipe(RDR,WTR) or die $!;
 my $pid = fork;
 die "fork: $!" if !defined $pid;
 if ($pid == 0) {
-    my $rand_child = rand;
     close RDR;
-    print WTR $rand_child, "\n";
+    print WTR "STRING_FROM_CHILD\n";
     close WTR;
 } else {
-    my $rand_parent = rand;
     close WTR;
-    chomp(my $rand_child  = <RDR>);
+    chomp(my $string_from_child  = <RDR>);
     close RDR;
-    print $rand_child ne $rand_parent, "\n";
+    print $string_from_child eq "STRING_FROM_CHILD", "\n";
 }
 EXPECT
 1
diff --git a/gnu/usr.bin/perl/t/op/goto.t b/gnu/usr.bin/perl/t/op/goto.t
index 9254d7c7c23..c79b424b905 100644
--- a/gnu/usr.bin/perl/t/op/goto.t
+++ b/gnu/usr.bin/perl/t/op/goto.t
@@ -205,7 +205,7 @@ is($ok, 1, 'goto in for(;;) with continuation');
 
 # bug #22299 - goto in require doesn't find label
 
-open my $f, ">goto01.pm" or die;
+open my $f, ">Op_goto01.pm" or die;
 print $f <<'EOT';
 package goto01;
 goto YYY;
@@ -215,9 +215,9 @@ YYY: print "OK\n";
 EOT
 close $f;
 
-$r = runperl(prog => 'use goto01; print qq[DONE\n]');
+$r = runperl(prog => 'use Op_goto01; print qq[DONE\n]');
 is($r, "OK\nDONE\n", "goto within use-d file"); 
-unlink "goto01.pm";
+unlink "Op_goto01.pm";
 
 # test for [perl #24108]
 $ok = 1;
diff --git a/gnu/usr.bin/perl/t/op/groups.t b/gnu/usr.bin/perl/t/op/groups.t
index f682f610d1f..404b8cd8ab6 100644
--- a/gnu/usr.bin/perl/t/op/groups.t
+++ b/gnu/usr.bin/perl/t/op/groups.t
@@ -1,7 +1,7 @@
 #!./perl
 
 $ENV{PATH} ="/bin:/usr/bin:/usr/xpg4/bin:/usr/ucb" .
-    exists $ENV{PATH} ? ":$ENV{PATH}" : "";
+    exists $ENV{PATH} ? ":$ENV{PATH}" : "" unless $^O eq 'VMS';
 $ENV{LC_ALL} = "C"; # so that external utilities speak English
 $ENV{LANGUAGE} = 'C'; # GNU locale extension
 
@@ -27,7 +27,8 @@ unless (eval { getgrgid(0); 1 }) {
     exit 0;
 }
 
-quit() if (($^O eq 'MSWin32' || $^O eq 'NetWare') or $^O =~ /lynxos/i);
+quit() if (($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS')
+           or $^O =~ /lynxos/i);
 
 # We have to find a command that prints all (effective
 # and real) group names (not ids).  The known commands are:
@@ -136,7 +137,7 @@ for (split(' ', $()) {
 print "# gr = @gr\n";
 
 my %did;
-if ($^O =~ /^(?:uwin|cygwin|interix|solaris)$/) {
+if ($^O =~ /^(?:uwin|cygwin|interix|solaris|linux)$/) {
 	# Or anybody else who can have spaces in group names.
 	$gr1 = join(' ', grep(!$did{$_}++, sort split(' ', join(' ', @gr))));
 } else {
diff --git a/gnu/usr.bin/perl/t/op/gv.t b/gnu/usr.bin/perl/t/op/gv.t
index 5b04f8719ad..e04c2cafc84 100644
--- a/gnu/usr.bin/perl/t/op/gv.t
+++ b/gnu/usr.bin/perl/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 use warnings;
 
 require './test.pl';
-plan( tests => 161 );
+plan( tests => 178 );
 
 # type coersion on assignment
 $foo = 'foo';
@@ -377,18 +377,15 @@ is (ref $::{oonk}, 'SCALAR', "Export doesn't affect original");
 is (eval 'spritsits', "Value", "Constant has correct value");
 is (ref \$::{spritsits}, 'GLOB', "Symbol table has full typeglob");
 
-my $result;
 # Check that assignment to an existing typeglob works
 {
   my $w = '';
   local $SIG{__WARN__} = sub { $w = $_[0] };
-  $result = *{"plunk"} = \&{"oonk"};
+  *{"plunk"} = [];
+  *{"plunk"} = \&{"oonk"};
   is($w, '', "Should be no warning");
 }
 
-is (ref \$result, 'GLOB',
-    "Non void assignment should still return a typeglob");
-
 is (ref $::{oonk}, 'SCALAR', "Export doesn't affect original");
 is (eval 'plunk', "Value", "Constant has correct value");
 is (ref \$::{plunk}, 'GLOB', "Symbol table has full typeglob");
@@ -398,7 +395,7 @@ my $gr = eval '\*plunk' or die;
 {
   my $w = '';
   local $SIG{__WARN__} = sub { $w = $_[0] };
-  $result = *{$gr} = \&{"oonk"};
+  *{$gr} = \&{"oonk"};
   is($w, '', "Redefining a constant sub to another constant sub with the same underlying value should not warn (It's just re-exporting, and that was always legal)");
 }
 
@@ -406,6 +403,48 @@ is (ref $::{oonk}, 'SCALAR', "Export doesn't affect original");
 is (eval 'plunk', "Value", "Constant has correct value");
 is (ref \$::{plunk}, 'GLOB', "Symbol table has full typeglob");
 
+# Non-void context should defeat the optimisation, and will cause the original
+# to be promoted (what change 26482 intended)
+my $result;
+{
+  my $w = '';
+  local $SIG{__WARN__} = sub { $w = $_[0] };
+  $result = *{"awkkkkkk"} = \&{"oonk"};
+  is($w, '', "Should be no warning");
+}
+
+is (ref \$result, 'GLOB',
+    "Non void assignment should still return a typeglob");
+
+is (ref \$::{oonk}, 'GLOB', "This export does affect original");
+is (eval 'plunk', "Value", "Constant has correct value");
+is (ref \$::{plunk}, 'GLOB', "Symbol table has full typeglob");
+
+delete $::{oonk};
+$::{oonk} = \"Value";
+
+sub non_dangling {
+  my $w = '';
+  local $SIG{__WARN__} = sub { $w = $_[0] };
+  *{"zap"} = \&{"oonk"};
+  is($w, '', "Should be no warning");
+}
+
+non_dangling();
+is (ref $::{oonk}, 'SCALAR', "Export doesn't affect original");
+is (eval 'zap', "Value", "Constant has correct value");
+is (ref $::{zap}, 'SCALAR', "Exported target is also a PCS");
+
+sub dangling {
+  local $SIG{__WARN__} = sub { die $_[0] };
+  *{"biff"} = \&{"oonk"};
+}
+
+dangling();
+is (ref \$::{oonk}, 'GLOB', "This export does affect original");
+is (eval 'biff', "Value", "Constant has correct value");
+is (ref \$::{biff}, 'GLOB', "Symbol table has full typeglob");
+
 {
     use vars qw($glook $smek $foof);
     # Check reference assignment isn't affected by the SV type (bug #38439)
@@ -494,6 +533,30 @@ foreach my $value ([1,2,3], {1=>2}, *STDOUT{IO}, \&ok, *STDOUT{FORMAT}) {
              "Assigment works when glob created midway (bug 45607)"); 1'
 	or die $@;
 }
+
+# For now these tests are here, but they would probably be better in a file for
+# tests for croaks. (And in turn, that probably deserves to be in a different
+# directory. Gerard Goossen has a point about the layout being unclear
+
+sub coerce_integer {
+    no warnings 'numeric';
+    $_[0] |= 0;
+}
+sub coerce_number {
+    no warnings 'numeric';
+    $_[0] += 0;
+}
+sub coerce_string {
+    $_[0] .= '';
+}
+
+foreach my $type (qw(integer number string)) {
+    my $prog = "coerce_$type(*STDERR)";
+    is (scalar eval "$prog; 1", undef, "$prog failed...");
+    like ($@, qr/Can't coerce GLOB to $type in/,
+	  "with the correct error message");
+}
+
 __END__
 Perl
 Rules
diff --git a/gnu/usr.bin/perl/t/op/inc.t b/gnu/usr.bin/perl/t/op/inc.t
index 3eec5cd872a..5606f85a4f3 100644
--- a/gnu/usr.bin/perl/t/op/inc.t
+++ b/gnu/usr.bin/perl/t/op/inc.t
@@ -2,7 +2,7 @@
 
 # use strict;
 
-print "1..34\n";
+print "1..38\n";
 
 my $test = 1;
 
@@ -194,3 +194,14 @@ ok ($a == 2147483647, $a);
     $x--;
     ok ($x == 0, "(void) i_postdec");
 }
+
+# these will segfault if they fail
+
+sub PVBM () { 'foo' }
+{ my $dummy = index 'foo', PVBM }
+
+ok (scalar eval { my $pvbm = PVBM; $pvbm++ });
+ok (scalar eval { my $pvbm = PVBM; $pvbm-- });
+ok (scalar eval { my $pvbm = PVBM; ++$pvbm });
+ok (scalar eval { my $pvbm = PVBM; --$pvbm });
+
diff --git a/gnu/usr.bin/perl/t/op/index.t b/gnu/usr.bin/perl/t/op/index.t
index b384bef445c..834814e296a 100644
--- a/gnu/usr.bin/perl/t/op/index.t
+++ b/gnu/usr.bin/perl/t/op/index.t
@@ -7,7 +7,11 @@ BEGIN {
 }
 
 use strict;
-plan( tests => 69 );
+plan( tests => 111 );
+
+run_tests() unless caller;
+
+sub run_tests {
 
 my $foo = 'Now is the time for all good men to come to the aid of their country.';
 
@@ -155,3 +159,43 @@ SKIP: {
     local ${^UTF8CACHE} = -1;
     is(index($t, 'xyz'), 4, "0xfffffffd and utf8cache");
 }
+
+
+# Tests for NUL characters.
+{
+    my @tests = (
+        ["",            -1, -1, -1],
+        ["foo",         -1, -1, -1],
+        ["\0",           0, -1, -1],
+        ["\0\0",         0,  0, -1],
+        ["\0\0\0",       0,  0,  0],
+        ["foo\0",        3, -1, -1],
+        ["foo\0foo\0\0", 3,  7, -1],
+    );
+    foreach my $l (1 .. 3) {
+        my $q = "\0" x $l;
+        my $i = 0;
+        foreach my $test (@tests) {
+            $i ++;
+            my $str = $$test [0];
+            my $res = $$test [$l];
+
+            {
+                is (index ($str, $q), $res, "Find NUL character(s)");
+            }
+
+            #
+            # Bug #53746 shows a difference between variables and literals,
+            # so test literals as well.
+            #
+            my $test_str = qq {is (index ("$str", "$q"), $res, } .
+                           qq {"Find NUL character(s)")};
+               $test_str =~ s/\0/\\0/g;
+
+            eval $test_str;
+            die $@ if $@;
+        }
+    }
+}
+
+}
diff --git a/gnu/usr.bin/perl/t/op/local.t b/gnu/usr.bin/perl/t/op/local.t
index ee250e111d6..5bf56af36ac 100644
--- a/gnu/usr.bin/perl/t/op/local.t
+++ b/gnu/usr.bin/perl/t/op/local.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = qw(. ../lib);
     require './test.pl';
 }
-plan tests => 122;
+plan tests => 123;
 
 my $list_assignment_supported = 1;
 
@@ -451,6 +451,11 @@ sub f { ok(0 == $[); }
     is($h{'k1'},111);
 }
 
+like( runperl(stderr => 1,
+              prog => 'use constant foo => q(a);' .
+                      'index(q(a), foo);' .
+                      'local *g=${::}{foo};print q(ok);'), "ok", "[perl #52740]");
+
 # Keep this test last, as it can SEGV
 {
     local *@;
diff --git a/gnu/usr.bin/perl/t/op/magic.t b/gnu/usr.bin/perl/t/op/magic.t
index 799c7178ac2..bfb68a75104 100644
--- a/gnu/usr.bin/perl/t/op/magic.t
+++ b/gnu/usr.bin/perl/t/op/magic.t
@@ -5,38 +5,14 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     $SIG{__WARN__} = sub { die "Dying on warning: ", @_ };
+    require './test.pl';
 }
 
 use warnings;
 use Config;
 
-my $test = 1;
-sub ok {
-    my($ok, $info, $todo) = @_;
 
-    # You have to do it this way or VMS will get confused.
-    printf "%s $test%s\n", $ok ? "ok" : "not ok",
-                           $todo ? " # TODO $todo" : '';
-
-    unless( $ok ) {
-        printf "# Failed test at line %d\n", (caller)[2];
-        print  "# $info\n" if defined $info;
-    }
-
-    $test++;
-    return $ok;
-}
-
-sub skip {
-    my($reason) = @_;
-
-    printf "ok $test # skipped%s\n", defined $reason ? ": $reason" : '';
-
-    $test++;
-    return 1;
-}
-
-print "1..58\n";
+plan (tests => 59);
 
 $Is_MSWin32  = $^O eq 'MSWin32';
 $Is_NetWare  = $^O eq 'NetWare';
@@ -55,24 +31,28 @@ $PERL = $ENV{PERL}
        $Is_MSWin32            ? '.\perl' :
        './perl');
 
+END {
+    # On VMS, environment variable changes are peristent after perl exits
+    delete $ENV{'FOO'} if $Is_VMS;
+}
+
 eval '$ENV{"FOO"} = "hi there";';	# check that ENV is inited inside eval
 # cmd.exe will echo 'variable=value' but 4nt will echo just the value
 # -- Nikola Knezevic
-if ($Is_MSWin32)  { ok `set FOO` =~ /^(?:FOO=)?hi there$/; }
+if ($Is_MSWin32)  { like `set FOO`, qr/^(?:FOO=)?hi there$/; }
 elsif ($Is_MacOS) { ok "1 # skipped", 1; }
-elsif ($Is_VMS)   { ok `write sys\$output f\$trnlnm("FOO")` eq "hi there\n"; }
-else              { ok `echo \$FOO` eq "hi there\n"; }
+elsif ($Is_VMS)   { is `write sys\$output f\$trnlnm("FOO")`, "hi there\n"; }
+else              { is `echo \$FOO`, "hi there\n"; }
 
 unlink 'ajslkdfpqjsjfk';
 $! = 0;
 open(FOO,'ajslkdfpqjsjfk');
-ok $!, $!;
+isnt($!, 0);
 close FOO; # just mention it, squelch used-only-once
 
-if ($Is_MSWin32 || $Is_NetWare || $Is_Dos || $Is_MPE || $Is_MacOS) {
-    skip('SIGINT not safe on this platform') for 1..4;
-}
-else {
+SKIP: {
+    skip('SIGINT not safe on this platform', 5)
+	if $Is_MSWin32 || $Is_NetWare || $Is_Dos || $Is_MPE || $Is_MacOS;
   # the next tests are done in a subprocess because sh spits out a
   # newline onto stderr when a child process kills itself with SIGINT.
   # We use a pipe rather than system() because the VMS command buffer
@@ -131,58 +111,72 @@ END
     my $todo = ($^O eq 'os2' ? ' # TODO: EMX v0.9d_fix4 bug: wrong nibble? ' : '');
     print $? & 0xFF ? "ok 6$todo\n" : "not ok 6$todo\n";
 
-    $test += 4;
+    open(CMDPIPE, "| $PERL");
+    print CMDPIPE <<'END';
+
+    sub PVBM () { 'foo' }
+    index 'foo', PVBM;
+    my $pvbm = PVBM;
+
+    sub foo { exit 0 }
+
+    $SIG{"INT"} = $pvbm;
+    kill "INT", $$; sleep 1;
+END
+    close CMDPIPE;
+    $? >>= 8 if $^O eq 'VMS';
+    print $? ? "not ok 7\n" : "ok 7\n";
+
+    curr_test(curr_test() + 5);
 }
 
 # can we slice ENV?
 @val1 = @ENV{keys(%ENV)};
 @val2 = values(%ENV);
-ok join(':',@val1) eq join(':',@val2);
-ok @val1 > 1;
+is join(':',@val1), join(':',@val2);
+cmp_ok @val1, '>', 1;
 
 # regex vars
 'foobarbaz' =~ /b(a)r/;
-ok $` eq 'foo', $`;
-ok $& eq 'bar', $&;
-ok $' eq 'baz', $';
-ok $+ eq 'a', $+;
+is $`, 'foo';
+is $&, 'bar';
+is $', 'baz';
+is $+, 'a';
 
 # $"
 @a = qw(foo bar baz);
-ok "@a" eq "foo bar baz", "@a";
+is "@a", "foo bar baz";
 {
     local $" = ',';
-    ok "@a" eq "foo,bar,baz", "@a";
+    is "@a", "foo,bar,baz";
 }
 
 # $;
 %h = ();
 $h{'foo', 'bar'} = 1;
-ok((keys %h)[0] eq "foo\034bar", (keys %h)[0]);
+is((keys %h)[0], "foo\034bar");
 {
     local $; = 'x';
     %h = ();
     $h{'foo', 'bar'} = 1;
-    ok((keys %h)[0] eq 'fooxbar', (keys %h)[0]);
+    is((keys %h)[0], 'fooxbar');
 }
 
 # $?, $@, $$
-if ($Is_MacOS) {
-    skip('$? + system are broken on MacPerl') for 1..2;
-}
-else {
+SKIP:  {
+    skip('$? + system are broken on MacPerl', 2) if $Is_MacOS;
     system qq[$PERL "-I../lib" -e "use vmsish qw(hushed); exit(0)"];
-    ok $? == 0, $?;
+    is $?, 0;
     system qq[$PERL "-I../lib" -e "use vmsish qw(hushed); exit(1)"];
-    ok $? != 0, $?;
+    isnt $?, 0;
 }
 
 eval { die "foo\n" };
-ok $@ eq "foo\n", $@;
+is $@, "foo\n";
 
-ok $$ > 0, $$;
+cmp_ok($$, '>', 0);
 eval { $$++ };
-ok $@ =~ /^Modification of a read-only value attempted/;
+like ($@, qr/^Modification of a read-only value attempted/);
 
 # $^X and $0
 {
@@ -251,70 +245,88 @@ EOX
 EOH
     }
     $s1 = "\$^X is $perl, \$0 is $script\n";
-    ok open(SCRIPT, ">$script"), $!;
-    ok print(SCRIPT $headmaybe . <<EOB . $middlemaybe . <<'EOF' . $tailmaybe), $!;
+    ok open(SCRIPT, ">$script") or diag $!;
+    ok print(SCRIPT $headmaybe . <<EOB . $middlemaybe . <<'EOF' . $tailmaybe) or diag $!;
 #!$wd/perl
 EOB
 print "\$^X is $^X, \$0 is $0\n";
 EOF
-    ok close(SCRIPT), $!;
-    ok chmod(0755, $script), $!;
+    ok close(SCRIPT) or diag $!;
+    ok chmod(0755, $script) or diag $!;
     $_ = ($Is_MacOS || $Is_VMS) ? `$perl $script` : `$script`;
     s/\.exe//i if $Is_Dos or $Is_Cygwin or $Is_os2;
     s{./$script}{$script} if $Is_BeOS; # revert BeOS execvp() side-effect
     s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
     s{is perl}{is $perl}; # for systems where $^X is only a basename
     s{\\}{/}g;
-    ok((($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1:");
+    if ($Is_MSWin32 || $Is_os2) {
+	is uc $_, uc $s1;
+    } else {
+	is $_, $s1;
+    }
     $_ = `$perl $script`;
     s/\.exe//i if $Is_Dos or $Is_os2 or $Is_Cygwin;
     s{./$perl}{$perl} if $Is_BeOS; # revert BeOS execvp() side-effect
     s{\\}{/}g;
-    ok((($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1: after `$perl $script`");
-    ok unlink($script), $!;
+    if ($Is_MSWin32 || $Is_os2) {
+	is uc $_, uc $s1;
+    } else {
+	is $_, $s1;
+    }
+    ok unlink($script) or diag $!;
 }
 
 # $], $^O, $^T
-ok $] >= 5.00319, $];
+cmp_ok $], '>=', 5.00319;
 ok $^O;
-ok $^T > 850000000, $^T;
+cmp_ok $^T, '>', 850000000;
 
 # Test change 25062 is working
 my $orig_osname = $^O;
 {
 local $^I = '.bak';
-ok($^O eq $orig_osname, 'Assigning $^I does not clobber $^O');
+is $^O, $orig_osname, 'Assigning $^I does not clobber $^O';
 }
 $^O = $orig_osname;
 
-if ($Is_VMS || $Is_Dos || $Is_MacOS) {
-    skip("%ENV manipulations fail or aren't safe on $^O") for 1..4;
-}
-else {
-	if ($ENV{PERL_VALGRIND}) {
-	    skip("clearing \%ENV is not safe when running under valgrind");
-	} else {
+SKIP: {
+    skip("%ENV manipulations fail or aren't safe on $^O", 4)
+	if $Is_VMS || $Is_Dos || $Is_MacOS;
+
+ SKIP: {
+	skip("clearing \%ENV is not safe when running under valgrind")
+	    if $ENV{PERL_VALGRIND};
+
 	    $PATH = $ENV{PATH};
 	    $PDL = $ENV{PERL_DESTRUCT_LEVEL} || 0;
 	    $ENV{foo} = "bar";
 	    %ENV = ();
 	    $ENV{PATH} = $PATH;
 	    $ENV{PERL_DESTRUCT_LEVEL} = $PDL || 0;
-	    ok ($Is_MSWin32 ? (`set foo 2>NUL` eq "")
-			    : (`echo \$foo` eq "\n") );
+	    if ($Is_MSWin32) {
+		is `set foo 2>NUL`, "";
+	    } else {
+		is `echo \$foo`, "\n";
+	    }
 	}
 
 	$ENV{__NoNeSuCh} = "foo";
 	$0 = "bar";
 # cmd.exe will echo 'variable=value' but 4nt will echo just the value
 # -- Nikola Knezevic
-       ok ($Is_MSWin32 ? (`set __NoNeSuCh` =~ /^(?:__NoNeSuCh=)?foo$/)
-			    : (`echo \$__NoNeSuCh` eq "foo\n") );
-	if ($^O =~ /^(linux|freebsd)$/ &&
-	    open CMDLINE, "/proc/$$/cmdline") {
+    	if ($Is_MSWin32) {
+	    like `set __NoNeSuCh`, qr/^(?:__NoNeSuCh=)?foo$/;
+	} else {
+	    is `echo \$__NoNeSuCh`, "foo\n";
+	}
+    SKIP: {
+	    skip("\$0 check only on Linux and FreeBSD", 2)
+		unless $^O =~ /^(linux|freebsd)$/
+		    && open CMDLINE, "/proc/$$/cmdline";
+
 	    chomp(my $line = scalar <CMDLINE>);
 	    my $me = (split /\0/, $line)[0];
-	    ok($me eq $0, 'altering $0 is effective (testing with /proc/)');
+	    is $me, $0, 'altering $0 is effective (testing with /proc/)';
 	    close CMDLINE;
             # perlbug #22811
             my $mydollarzero = sub {
@@ -342,37 +354,34 @@ else {
 	       # can get rid of the first one.
 	       || ($^O eq 'freebsd' && $ps =~ m/^(?:perl: )?x(?: \(perl\))?$/),
 		       'altering $0 is effective (testing with `ps`)');
-	} else {
-	    skip("\$0 check only on Linux and FreeBSD") for 0, 1;
 	}
 }
 
 {
     my $ok = 1;
     my $warn = '';
-    local $SIG{'__WARN__'} = sub { $ok = 0; $warn = join '', @_; };
+    local $SIG{'__WARN__'} = sub { $ok = 0; $warn = join '', @_; $warn =~ s/\n$//; };
     $! = undef;
-    ok($ok, $warn, $Is_VMS ? "'\$!=undef' does throw a warning" : '');
+    local $TODO = $Is_VMS ? "'\$!=undef' does throw a warning" : '';
+    ok($ok, $warn);
 }
 
 # test case-insignificance of %ENV (these tests must be enabled only
 # when perl is compiled with -DENV_IS_CASELESS)
-if ($Is_MSWin32 || $Is_NetWare) {
+SKIP: {
+    skip('no caseless %ENV support', 4) unless $Is_MSWin32 || $Is_NetWare;
+
     %ENV = ();
     $ENV{'Foo'} = 'bar';
     $ENV{'fOo'} = 'baz';
-    ok (scalar(keys(%ENV)) == 1);
-    ok exists($ENV{'FOo'});
-    ok (delete($ENV{'foO'}) eq 'baz');
-    ok (scalar(keys(%ENV)) == 0);
-}
-else {
-    skip('no caseless %ENV support') for 1..4;
+    is scalar(keys(%ENV)), 1;
+    ok exists $ENV{'FOo'};
+    is delete $ENV{'foO'}, 'baz';
+    is scalar(keys(%ENV)), 0;
 }
 
-if ($Is_miniperl) {
-    skip ("miniperl can't rely on loading %Errno") for 1..2;
-} else {
+SKIP: {
+    skip ("miniperl can't rely on loading %Errno", 2) if $Is_miniperl;
    no warnings 'void';
 
 # Make sure Errno hasn't been prematurely autoloaded
@@ -387,9 +396,8 @@ if ($Is_miniperl) {
    }, $@;
 }
 
-if ($Is_miniperl) {
-    skip ("miniperl can't rely on loading %Errno");
-} else {
+SKIP:  {
+    skip ("miniperl can't rely on loading %Errno") if $Is_miniperl;
     # Make sure that Errno loading doesn't clobber $!
 
     undef %Errno::;
@@ -400,21 +408,21 @@ if ($Is_miniperl) {
     ok ${"!"}{ENOENT};
 }
 
-ok $^S == 0 && defined $^S;
-eval { ok $^S == 1 };
+is $^S, 0;
+eval { is $^S,1 };
 eval " BEGIN { ok ! defined \$^S } ";
-ok $^S == 0 && defined $^S;
+is $^S, 0;
 
-ok ${^TAINT} == 0;
+is ${^TAINT}, 0;
 eval { ${^TAINT} = 1 };
-ok ${^TAINT} == 0;
+is ${^TAINT}, 0;
 
 # 5.6.1 had a bug: @+ and @- were not properly interpolated
 # into double-quoted strings
 # 20020414 mjd-perl-patch+@plover.com
 "I like pie" =~ /(I) (like) (pie)/;
-ok "@-" eq  "0 0 2 7";
-ok "@+" eq "10 1 6 10";
+is "@-",  "0 0 2 7";
+is "@+", "10 1 6 10";
 
 # Tests for the magic get of $\
 {
@@ -443,29 +451,27 @@ ok "@+" eq "10 1 6 10";
 	return @+;
     };
     my @y = f();
-    ok( $x eq "@y", "return a magic array ($x) vs (@y)" );
+    is $x, "@y", "return a magic array ($x) vs (@y)";
 }
 
 # Test for bug [perl #36434]
-if (!$Is_VMS) {
+# Can not do this test on VMS, EPOC, and SYMBIAN according to comments
+# in mg.c/Perl_magic_clear_all_env()
+SKIP: {
+    skip('Can\'t make assignment to \%ENV on this system', 3) if $Is_VMS;
+
     local @ISA;
     local %ENV;
     # This used to be __PACKAGE__, but that causes recursive
     #  inheritance, which is detected earlier now and broke
     #  this test
     eval { push @ISA, __FILE__ };
-    ok( $@ eq '', 'Push a constant on a magic array');
+    is $@, '', 'Push a constant on a magic array';
     $@ and print "# $@";
     eval { %ENV = (PATH => __PACKAGE__) };
-    ok( $@ eq '', 'Assign a constant to a magic hash');
+    is $@, '', 'Assign a constant to a magic hash';
     $@ and print "# $@";
     eval { my %h = qw(A B); %ENV = (PATH => (keys %h)[0]) };
-    ok( $@ eq '', 'Assign a shared key to a magic hash');
+    is $@, '', 'Assign a shared key to a magic hash';
     $@ and print "# $@";
 }
-else {
-# Can not do this test on VMS, EPOC, and SYMBIAN according to comments
-# in mg.c/Perl_magic_clear_all_env()
-#
-    skip('Can\'t make assignment to \%ENV on this system') for 1..3;
-}
diff --git a/gnu/usr.bin/perl/t/op/method.t b/gnu/usr.bin/perl/t/op/method.t
index aaf29be8df1..46c46426eb9 100644
--- a/gnu/usr.bin/perl/t/op/method.t
+++ b/gnu/usr.bin/perl/t/op/method.t
@@ -183,23 +183,23 @@ is(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined");
 
 
 # test error messages if method loading fails
-is(do { eval '$e = bless {}, "E::A"; E::A->foo()';
-	  $@ =~ /^\QCan't locate object method "foo" via package "E::A" at/ ? 1 : $@}, 1);
-is(do { eval '$e = bless {}, "E::B"; $e->foo()';  
-	  $@ =~ /^\QCan't locate object method "foo" via package "E::B" at/ ? 1 : $@}, 1);
-is(do { eval 'E::C->foo()';
-	  $@ =~ /^\QCan't locate object method "foo" via package "E::C" (perhaps / ? 1 : $@}, 1);
-
-is(do { eval 'UNIVERSAL->E::D::foo()';
-	  $@ =~ /^\QCan't locate object method "foo" via package "E::D" (perhaps / ? 1 : $@}, 1);
-is(do { eval '$e = bless {}, "UNIVERSAL"; $e->E::E::foo()';
-	  $@ =~ /^\QCan't locate object method "foo" via package "E::E" (perhaps / ? 1 : $@}, 1);
+eval '$e = bless {}, "E::A"; E::A->foo()';
+like ($@, qr/^\QCan't locate object method "foo" via package "E::A" at/);
+eval '$e = bless {}, "E::B"; $e->foo()';  
+like ($@, qr/^\QCan't locate object method "foo" via package "E::B" at/);
+eval 'E::C->foo()';
+like ($@, qr/^\QCan't locate object method "foo" via package "E::C" (perhaps /);
+
+eval 'UNIVERSAL->E::D::foo()';
+like ($@, qr/^\QCan't locate object method "foo" via package "E::D" (perhaps /);
+eval '$e = bless {}, "UNIVERSAL"; $e->E::E::foo()';
+like ($@, qr/^\QCan't locate object method "foo" via package "E::E" (perhaps /);
 
 $e = bless {}, "E::F";  # force package to exist
-is(do { eval 'UNIVERSAL->E::F::foo()';
-	  $@ =~ /^\QCan't locate object method "foo" via package "E::F" at/ ? 1 : $@}, 1);
-is(do { eval '$e = bless {}, "UNIVERSAL"; $e->E::F::foo()';
-	  $@ =~ /^\QCan't locate object method "foo" via package "E::F" at/ ? 1 : $@}, 1);
+eval 'UNIVERSAL->E::F::foo()';
+like ($@, qr/^\QCan't locate object method "foo" via package "E::F" at/);
+eval '$e = bless {}, "UNIVERSAL"; $e->E::F::foo()';
+like ($@, qr/^\QCan't locate object method "foo" via package "E::F" at/);
 
 # TODO: we need some tests for the SUPER:: pseudoclass
 
diff --git a/gnu/usr.bin/perl/t/op/pack.t b/gnu/usr.bin/perl/t/op/pack.t
index 9312646cbb3..4b5f9a5bc5a 100644
--- a/gnu/usr.bin/perl/t/op/pack.t
+++ b/gnu/usr.bin/perl/t/op/pack.t
@@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' :
 my $no_signedness = $] > 5.009 ? '' :
   "Signed/unsigned pack modifiers not available on this perl";
 
-plan tests => 14696;
+plan tests => 14697;
 
 use strict;
 use warnings qw(FATAL all);
@@ -1980,3 +1980,8 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
     is(unpack('@!4 a*', "\x{301}\x{302}\x{303}\x{304}\x{305}"),
        "\x{303}\x{304}\x{305}", 'Test basic utf8 @!');
 }
+{
+    #50256
+    my ($v) = split //, unpack ('(B)*', 'ab');
+    is($v, 0); # Doesn't SEGV :-)
+}
diff --git a/gnu/usr.bin/perl/t/op/pat.t b/gnu/usr.bin/perl/t/op/pat.t
index 7d03eb6b824..0b2c729b238 100644
--- a/gnu/usr.bin/perl/t/op/pat.t
+++ b/gnu/usr.bin/perl/t/op/pat.t
@@ -4,4564 +4,4370 @@
 # the format supported by op/regexp.t.  If you want to add a test
 # that does fit that format, add it to op/re_tests, not here.
 
+use strict;
+use warnings;
+use 5.010;
+
+
+sub run_tests;
+
 $| = 1;
 
-# Test counter output is generated by a BEGIN block at bottom of file
+my $EXPECTED_TESTS = 4065;  # Update this when adding/deleting tests.
 
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
 }
+our $TODO;
 our $Message = "Noname test";
-
+our $Error;
+our $DiePattern;
+our $WarnPattern;
+our $BugId;
+our $PatchId;
+our $running_as_thread;
+
+my $ordA = ord ('A');  # This defines ASCII/UTF-8 vs EBCDIC/UTF-EBCDIC
+# This defined the platform.
+my $IS_ASCII  = $ordA ==  65;
+my $IS_EBCDIC = $ordA == 193;
+
+use vars '%Config';
 eval 'use Config';          #  Defaults assumed if this fails
 
-$x = "abc\ndef\n";
+my $test = 0;
 
-if ($x =~ /^abc/) {print "ok 1\n";} else {print "not ok 1\n";}
-if ($x !~ /^def/) {print "ok 2\n";} else {print "not ok 2\n";}
+print "1..$EXPECTED_TESTS\n";
 
-# used to be a test for $*
-if ($x =~ /^def/m) {print "ok 3\n";} else {print "not ok 3\n";}
+run_tests unless caller ();
 
-$_ = '123';
-if (/^([0-9][0-9]*)/) {print "ok 4\n";} else {print "not ok 4\n";}
+END {
+}
 
-if ($x =~ /^xxx/) {print "not ok 5\n";} else {print "ok 5\n";}
-if ($x !~ /^abc/) {print "not ok 6\n";} else {print "ok 6\n";}
+sub pretty {
+    my ($mess) = @_;
+    $mess =~ s/\n/\\n/g;
+    $mess =~ s/\r/\\r/g;
+    $mess =~ s/\t/\\t/g;
+    $mess =~ s/([\00-\37\177])/sprintf '\%03o', ord $1/eg;
+    $mess =~ s/#/\\#/g;
+    $mess;
+}
 
-if ($x =~ /def/) {print "ok 7\n";} else {print "not ok 7\n";}
-if ($x !~ /def/) {print "not ok 8\n";} else {print "ok 8\n";}
+sub safe_globals {
+    defined($_) and s/#/\\#/g for $BugId, $PatchId, $TODO;
+}
 
-if ($x !~ /.def/) {print "ok 9\n";} else {print "not ok 9\n";}
-if ($x =~ /.def/) {print "not ok 10\n";} else {print "ok 10\n";}
+sub _ok {
+    my ($ok, $mess, $error) = @_;
+    safe_globals();
+    $mess    = pretty ($mess // $Message);
+    $mess   .= "; Bug $BugId"     if defined $BugId;
+    $mess   .= "; Patch $PatchId" if defined $PatchId;
+    $mess   .= " # TODO $TODO"     if defined $TODO;
 
-if ($x =~ /\ndef/) {print "ok 11\n";} else {print "not ok 11\n";}
-if ($x !~ /\ndef/) {print "not ok 12\n";} else {print "ok 12\n";}
+    my $line_nr = (caller(1)) [2];
 
-$_ = 'aaabbbccc';
-if (/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc') {
-	print "ok 13\n";
-} else {
-	print "not ok 13\n";
-}
-if (/(a+b+c+)/ && $1 eq 'aaabbbccc') {
-	print "ok 14\n";
-} else {
-	print "not ok 14\n";
-}
+    printf "%sok %d - %s\n",
+              ($ok ? "" : "not "),
+              ++ $test,
+              "$mess\tLine $line_nr";
 
-if (/a+b?c+/) {print "not ok 15\n";} else {print "ok 15\n";}
+    unless ($ok) {
+        print "# Failed test at line $line_nr\n" unless defined $TODO;
+        if ($error //= $Error) {
+            no warnings 'utf8';
+            chomp $error;
+            $error = join "\n#", map {pretty $_} split /\n\h*#/ => $error;
+            $error = "# $error" unless $error =~ /^\h*#/;
+            print $error, "\n";
+        }
+    }
 
-$_ = 'aaabccc';
-if (/a+b?c+/) {print "ok 16\n";} else {print "not ok 16\n";}
-if (/a*b+c*/) {print "ok 17\n";} else {print "not ok 17\n";}
+    return $ok;
+}
 
-$_ = 'aaaccc';
-if (/a*b?c*/) {print "ok 18\n";} else {print "not ok 18\n";}
-if (/a*b+c*/) {print "not ok 19\n";} else {print "ok 19\n";}
+# Force scalar context on the pattern match
+sub  ok ($;$$) {_ok  $_ [0], $_ [1], $_ [2]}
+sub nok ($;$$) {_ok !$_ [0], "Failed: " . ($_ [1] // $Message), $_ [2]}
 
-$_ = 'abcdef';
-if (/bcd|xyz/) {print "ok 20\n";} else {print "not ok 20\n";}
-if (/xyz|bcd/) {print "ok 21\n";} else {print "not ok 21\n";}
 
-if (m|bc/*d|) {print "ok 22\n";} else {print "not ok 22\n";}
+sub skip {
+    my $why = shift;
+    safe_globals();
+    $why =~ s/\n.*//s;
+    $why .= "; Bug $BugId" if defined $BugId;
+    # seems like the new harness code doesnt like todo and skip to be mixed.
+    # which seems like a bug in the harness to me. -- dmq
+    #$why .= " # TODO $TODO" if defined $TODO;
+    
+    my $n = shift // 1;
+    my $line_nr = (caller(0)) [2];
+    for (1 .. $n) {
+        ++ $test;
+        #print "not " if defined $TODO;
+        print "ok $test # skip $why\tLine $line_nr\n";
+    }
+    no warnings "exiting";
+    last SKIP;
+}
 
-if (/^$_$/) {print "ok 23\n";} else {print "not ok 23\n";}
+sub iseq ($$;$) { 
+    my ($got, $expect, $name) = @_;
+    
+    $_ = defined ($_) ? "'$_'" : "undef" for $got, $expect;
+        
+    my $ok    = $got eq $expect;
+    my $error = "# expected: $expect\n" .
+                "#   result: $got";
 
-# used to be a test for $*
-if ("ab\ncd\n" =~ /^cd/m) {print "ok 24\n";} else {print "not ok 24\n";}
+    _ok $ok, $name, $error;
+}   
 
-$XXX{123} = 123;
-$XXX{234} = 234;
-$XXX{345} = 345;
+sub isneq ($$;$) { 
+    my ($got, $expect, $name) = @_;
+    my $todo = $TODO ? " # TODO $TODO" : '';
+    
+    $_ = defined ($_) ? "'$_'" : "undef" for $got, $expect;
+        
+    my $ok    = $got ne $expect;
+    my $error = "# results are equal ($got)";
 
-@XXX = ('ok 25','not ok 25', 'ok 26','not ok 26','not ok 27');
-while ($_ = shift(@XXX)) {
-    ?(.*)? && (print $1,"\n");
-    /not/ && reset;
-    if (/not ok 26/) {
-      if ($^O eq 'VMS') {
-	$_ = shift(@XXX);
-      }
-      else {
-	reset 'X';
-      }
-   }
-}
+    _ok $ok, $name, $error;
+}   
 
-if ($^O ne 'VMS') {
-  while (($key,$val) = each(%XXX)) {
-    print "not ok 27\n";
-    exit;
-  }
-}
 
-print "ok 27\n";
-
-'cde' =~ /[^ab]*/;
-'xyz' =~ //;
-if ($& eq 'xyz') {print "ok 28\n";} else {print "not ok 28\n";}
-
-$foo = '[^ab]*';
-'cde' =~ /$foo/;
-'xyz' =~ //;
-if ($& eq 'xyz') {print "ok 29\n";} else {print "not ok 29\n";}
-
-$foo = '[^ab]*';
-'cde' =~ /$foo/;
-'xyz' =~ /$null/;
-if ($& eq 'xyz') {print "ok 30\n";} else {print "not ok 30\n";}
-
-$_ = 'abcdefghi';
-/def/;		# optimized up to cmd
-if ("$`:$&:$'" eq 'abc:def:ghi') {print "ok 31\n";} else {print "not ok 31\n";}
-
-/cde/ + 0;	# optimized only to spat
-if ("$`:$&:$'" eq 'ab:cde:fghi') {print "ok 32\n";} else {print "not ok 32\n";}
-
-/[d][e][f]/;	# not optimized
-if ("$`:$&:$'" eq 'abc:def:ghi') {print "ok 33\n";} else {print "not ok 33\n";}
-
-$_ = 'now is the {time for all} good men to come to.';
-/ {([^}]*)}/;
-if ($1 eq 'time for all') {print "ok 34\n";} else {print "not ok 34 $1\n";}
-
-$_ = 'xxx {3,4}  yyy   zzz';
-print /( {3,4})/ ? "ok 35\n" : "not ok 35\n";
-print $1 eq '   ' ? "ok 36\n" : "not ok 36\n";
-print /( {4,})/ ? "not ok 37\n" : "ok 37\n";
-print /( {2,3}.)/ ? "ok 38\n" : "not ok 38\n";
-print $1 eq '  y' ? "ok 39\n" : "not ok 39\n";
-print /(y{2,3}.)/ ? "ok 40\n" : "not ok 40\n";
-print $1 eq 'yyy ' ? "ok 41\n" : "not ok 41\n";
-print /x {3,4}/ ? "not ok 42\n" : "ok 42\n";
-print /^xxx {3,4}/ ? "not ok 43\n" : "ok 43\n";
-
-$_ = "now is the time for all good men to come to.";
-@words = /(\w+)/g;
-print join(':',@words) eq "now:is:the:time:for:all:good:men:to:come:to"
-    ? "ok 44\n"
-    : "not ok 44\n";
-
-@words = ();
-while (/\w+/g) {
-    push(@words, $&);
-}
-print join(':',@words) eq "now:is:the:time:for:all:good:men:to:come:to"
-    ? "ok 45\n"
-    : "not ok 45\n";
-
-@words = ();
-pos = 0;
-while (/to/g) {
-    push(@words, $&);
-}
-print join(':',@words) eq "to:to"
-    ? "ok 46\n"
-    : "not ok 46 `@words'\n";
-
-pos $_ = 0;
-@words = /to/g;
-print join(':',@words) eq "to:to"
-    ? "ok 47\n"
-    : "not ok 47 `@words'\n";
-
-$_ = "abcdefghi";
-
-$pat1 = 'def';
-$pat2 = '^def';
-$pat3 = '.def.';
-$pat4 = 'abc';
-$pat5 = '^abc';
-$pat6 = 'abc$';
-$pat7 = 'ghi';
-$pat8 = '\w*ghi';
-$pat9 = 'ghi$';
-
-$t1=$t2=$t3=$t4=$t5=$t6=$t7=$t8=$t9=0;
-
-for $iter (1..5) {
-    $t1++ if /$pat1/o;
-    $t2++ if /$pat2/o;
-    $t3++ if /$pat3/o;
-    $t4++ if /$pat4/o;
-    $t5++ if /$pat5/o;
-    $t6++ if /$pat6/o;
-    $t7++ if /$pat7/o;
-    $t8++ if /$pat8/o;
-    $t9++ if /$pat9/o;
+sub eval_ok ($;$) {
+    my ($code, $name) = @_;
+    local $@;
+    if (ref $code) {
+        _ok eval {&$code} && !$@, $name;
+    }
+    else {
+        _ok eval  ($code) && !$@, $name;
+    }
 }
 
-$x = "$t1$t2$t3$t4$t5$t6$t7$t8$t9";
-print $x eq '505550555' ? "ok 48\n" : "not ok 48 $x\n";
-
-$xyz = 'xyz';
-print "abc" =~ /^abc$|$xyz/ ? "ok 49\n" : "not ok 49\n";
-
-# perl 4.009 says "unmatched ()"
-eval '"abc" =~ /a(bc$)|$xyz/; $result = "$&:$1"';
-print $@ eq "" ? "ok 50\n" : "not ok 50\n";
-print $result eq "abc:bc" ? "ok 51\n" : "not ok 51\n";
-
-
-$_="abcfooabcbar";
-$x=/abc/g;
-print $` eq "" ? "ok 52\n" : "not ok 52\n" if $x;
-$x=/abc/g;
-print $` eq "abcfoo" ? "ok 53\n" : "not ok 53\n" if $x;
-$x=/abc/g;
-print $x == 0 ? "ok 54\n" : "not ok 54\n";
-pos = 0;
-$x=/ABC/gi;
-print $` eq "" ? "ok 55\n" : "not ok 55\n" if $x;
-$x=/ABC/gi;
-print $` eq "abcfoo" ? "ok 56\n" : "not ok 56\n" if $x;
-$x=/ABC/gi;
-print $x == 0 ? "ok 57\n" : "not ok 57\n";
-pos = 0;
-$x=/abc/g;
-print $' eq "fooabcbar" ? "ok 58\n" : "not ok 58\n" if $x;
-$x=/abc/g;
-print $' eq "bar" ? "ok 59\n" : "not ok 59\n" if $x;
-$_ .= '';
-@x=/abc/g;
-print scalar @x == 2 ? "ok 60\n" : "not ok 60\n";
-
-$_ = "abdc";
-pos $_ = 2;
-/\Gc/gc;
-print "not " if (pos $_) != 2;
-print "ok 61\n";
-/\Gc/g;
-print "not " if defined pos $_;
-print "ok 62\n";
-
-$out = 1;
-'abc' =~ m'a(?{ $out = 2 })b';
-print "not " if $out != 2;
-print "ok 63\n";
-
-$out = 1;
-'abc' =~ m'a(?{ $out = 3 })c';
-print "not " if $out != 1;
-print "ok 64\n";
-
-$_ = 'foobar1 bar2 foobar3 barfoobar5 foobar6';
-@out = /(?<!foo)bar./g;
-print "not " if "@out" ne 'bar2 barf';
-print "ok 65\n";
-
-# Tests which depend on REG_INFTY
-$reg_infty = defined $Config{reg_infty} ? $Config{reg_infty} : 32767;
-$reg_infty_m = $reg_infty - 1; $reg_infty_p = $reg_infty + 1;
-
-# As well as failing if the pattern matches do unexpected things, the
-# next three tests will fail if you should have picked up a lower-than-
-# default value for $reg_infty from Config.pm, but have not.
-
-undef $@;
-print "not " if eval q(('aaa' =~ /(a{1,$reg_infty_m})/)[0] ne 'aaa') || $@;
-print "ok 66\n";
-
-undef $@;
-print "not " if eval q(('a' x $reg_infty_m) !~ /a{$reg_infty_m}/) || $@;
-print "ok 67\n";
-
-undef $@;
-print "not " if eval q(('a' x ($reg_infty_m - 1)) =~ /a{$reg_infty_m}/) || $@;
-print "ok 68\n";
-
-undef $@;
-eval "'aaa' =~ /a{1,$reg_infty}/";
-print "not " if $@ !~ m%^\QQuantifier in {,} bigger than%;
-print "ok 69\n";
-
-eval "'aaa' =~ /a{1,$reg_infty_p}/";
-print "not "
-	if $@ !~ m%^\QQuantifier in {,} bigger than%;
-print "ok 70\n";
-undef $@;
-
-# Poke a couple more parse failures
-
-$context = 'x' x 256;
-eval qq("${context}y" =~ /(?<=$context)y/);
-print "not " if $@ !~ m%^\QLookbehind longer than 255 not%;
-print "ok 71\n";
-
-# removed test
-print "ok 72\n";
-
-# Long Monsters
-$test = 73;
-for $l (125, 140, 250, 270, 300000, 30) { # Ordered to free memory
-  $a = 'a' x $l;
-  print "# length=$l\nnot " unless "ba$a=" =~ /a$a=/;
-  print "ok $test\n";
-  $test++;
-
-  print "not " if "b$a=" =~ /a$a=/;
-  print "ok $test\n";
-  $test++;
+sub must_die {
+    my ($code, $pattern, $name) = @_;
+    $pattern //= $DiePattern;
+    undef $@;
+    ref $code ? &$code : eval $code;
+    my  $r = $@ && $@ =~ /$pattern/;
+    _ok $r, $name // $Message // "\$\@ =~ /$pattern/";
 }
 
-# 20000 nodes, each taking 3 words per string, and 1 per branch
-$long_constant_len = join '|', 12120 .. 32645;
-$long_var_len = join '|', 8120 .. 28645;
-%ans = ( 'ax13876y25677lbc' => 1,
-	 'ax13876y25677mcb' => 0, # not b.
-	 'ax13876y35677nbc' => 0, # Num too big
-	 'ax13876y25677y21378obc' => 1,
-	 'ax13876y25677y21378zbc' => 0,	# Not followed by [k-o]
-	 'ax13876y25677y21378y21378kbc' => 1,
-	 'ax13876y25677y21378y21378kcb' => 0, # Not b.
-	 'ax13876y25677y21378y21378y21378kbc' => 0, # 5 runs
-       );
-
-for ( keys %ans ) {
-  print "# const-len `$_' not =>  $ans{$_}\nnot "
-    if $ans{$_} xor /a(?=([yx]($long_constant_len)){2,4}[k-o]).*b./o;
-  print "ok $test\n";
-  $test++;
-  print "# var-len   `$_' not =>  $ans{$_}\nnot "
-    if $ans{$_} xor /a(?=([yx]($long_var_len)){2,4}[k-o]).*b./o;
-  print "ok $test\n";
-  $test++;
+sub must_warn {
+    my ($code, $pattern, $name) = @_;
+    $pattern //= $WarnPattern;
+    my $w;
+    local $SIG {__WARN__} = sub {$w .= join "" => @_};
+    use warnings 'all';
+    ref $code ? &$code : eval $code;
+    my $r = $w && $w =~ /$pattern/;
+    $w //= "UNDEF";
+    _ok $r, $name // $Message // "Got warning /$pattern/",
+            "# expected: /$pattern/\n" .
+            "#   result: $w";
+}
+
+sub may_not_warn {
+    my ($code, $name) = @_;
+    my $w;
+    local $SIG {__WARN__} = sub {$w .= join "" => @_};
+    use warnings 'all';
+    ref $code ? &$code : eval $code;
+    _ok !$w, $name // ($Message ? "$Message (did not warn)"
+                                : "Did not warn"),
+             "Got warning '$w'";
 }
 
-$_ = " a (bla()) and x(y b((l)u((e))) and b(l(e)e)e";
-$expect = "(bla()) ((l)u((e))) (l(e)e)";
-
-sub matchit {
-  m/
-     (
-       \(
-       (?{ $c = 1 })		# Initialize
-       (?:
-	 (?(?{ $c == 0 })       # PREVIOUS iteration was OK, stop the loop
-	   (?!
-	   )			# Fail: will unwind one iteration back
-	 )	
-	 (?:
-	   [^()]+		# Match a big chunk
-	   (?=
-	     [()]
-	   )			# Do not try to match subchunks
-	 |
-	   \(
-	   (?{ ++$c })
-	 |
-	   \)
-	   (?{ --$c })
-	 )
-       )+			# This may not match with different subblocks
-     )
-     (?(?{ $c != 0 })
-       (?!
-       )			# Fail
-     )				# Otherwise the chunk 1 may succeed with $c>0
-   /xg;
-}
 
-@ans = ();
-push @ans, $res while $res = matchit;
-
-print "# ans='@ans'\n# expect='$expect'\nnot " if "@ans" ne "1 1 1";
-print "ok $test\n";
-$test++;
-
-@ans = matchit;
-
-print "# ans='@ans'\n# expect='$expect'\nnot " if "@ans" ne $expect;
-print "ok $test\n";
-$test++;
-
-print "not " unless "abc" =~ /^(??{"a"})b/;
-print "ok $test\n";
-$test++;
-
-my $matched;
-$matched = qr/\((?:(?>[^()]+)|(??{$matched}))*\)/;
-
-@ans = @ans1 = ();
-push(@ans, $res), push(@ans1, $&) while $res = m/$matched/g;
-
-print "# ans='@ans'\n# expect='$expect'\nnot " if "@ans" ne "1 1 1";
-print "ok $test\n";
-$test++;
-
-print "# ans1='@ans1'\n# expect='$expect'\nnot " if "@ans1" ne $expect;
-print "ok $test\n";
-$test++;
-
-@ans = m/$matched/g;
-
-print "# ans='@ans'\n# expect='$expect'\nnot " if "@ans" ne $expect;
-print "ok $test\n";
-$test++;
-
-@ans = ('a/b' =~ m%(.*/)?(.*)%);	# Stack may be bad
-print "not " if "@ans" ne 'a/ b';
-print "ok $test\n";
-$test++;
-
-$code = '{$blah = 45}';
-$blah = 12;
-eval { /(?$code)/ };
-print "not " unless $@ and $@ =~ /not allowed at runtime/ and $blah == 12;
-print "ok $test\n";
-$test++;
-
-for $code ('{$blah = 45}','=xx') {
-  $blah = 12;
-  $res = eval { "xx" =~ /(?$code)/o };
-  if ($code eq '=xx') {
-    print "#'$@','$res','$blah'\nnot " unless not $@ and $res;
-  } else {
-    print "#'$@','$res','$blah'\nnot " unless $@ and $@ =~ /not allowed at runtime/ and $blah == 12;
-  }
-  print "ok $test\n";
-  $test++;
-}
+#
+# Tests start here.
+#
+sub run_tests {
 
-$code = '{$blah = 45}';
-$blah = 12;
-eval "/(?$code)/";			
-print "not " if $blah != 45;
-print "ok $test\n";
-$test++;
-
-$blah = 12;
-/(?{$blah = 45})/;			
-print "not " if $blah != 45;
-print "ok $test\n";
-$test++;
-
-$x = 'banana';
-$x =~ /.a/g;
-print "not " unless pos($x) == 2;
-print "ok $test\n";
-$test++;
-
-$x =~ /.z/gc;
-print "not " unless pos($x) == 2;
-print "ok $test\n";
-$test++;
-
-sub f {
-    my $p = $_[0];
-    return $p;
-}
+    {
 
-$x =~ /.a/g;
-print "not " unless f(pos($x)) == 4;
-print "ok $test\n";
-$test++;
-
-$x = $^R = 67;
-'foot' =~ /foo(?{$x = 12; 75})[t]/;
-print "not " unless $^R eq '75';
-print "ok $test\n";
-$test++;
-
-$x = $^R = 67;
-'foot' =~ /foo(?{$x = 12; 75})[xy]/;
-print "not " unless $^R eq '67' and $x eq '12';
-print "ok $test\n";
-$test++;
-
-$x = $^R = 67;
-'foot' =~ /foo(?{ $^R + 12 })((?{ $x = 12; $^R + 17 })[xy])?/;
-print "not " unless $^R eq '79' and $x eq '12';
-print "ok $test\n";
-$test++;
-
-print "not " unless qr/\b\v$/i eq '(?i-xsm:\b\v$)';
-print "ok $test\n";
-$test++;
-
-print "not " unless qr/\b\v$/s eq '(?s-xim:\b\v$)';
-print "ok $test\n";
-$test++;
-
-print "not " unless qr/\b\v$/m eq '(?m-xis:\b\v$)';
-print "ok $test\n";
-$test++;
-
-print "not " unless qr/\b\v$/x eq '(?x-ism:\b\v$)';
-print "ok $test\n";
-$test++;
-
-print "not " unless qr/\b\v$/xism eq '(?msix:\b\v$)';
-print "ok $test\n";
-$test++;
-
-print "not " unless qr/\b\v$/ eq '(?-xism:\b\v$)';
-print "ok $test\n";
-$test++;
-
-$_ = 'xabcx';
-foreach $ans ('', 'c') {
-  /(?<=(?=a)..)((?=c)|.)/g;
-  print "# \$1  ='$1'\n# \$ans='$ans'\nnot " unless $1 eq $ans;
-  print "ok $test\n";
-  $test++;
-}
+        my $x = "abc\ndef\n";
 
-$_ = 'a';
-foreach $ans ('', 'a', '') {
-  /^|a|$/g;
-  print "# \$&  ='$&'\n# \$ans='$ans'\nnot " unless $& eq $ans;
-  print "ok $test\n";
-  $test++;
-}
+        ok $x =~ /^abc/,  qq ["$x" =~ /^abc/];
+        ok $x !~ /^def/,  qq ["$x" !~ /^def/];
 
-sub prefixify {
-  my($v,$a,$b,$res) = @_;
-  $v =~ s/\Q$a\E/$b/;
-  print "not " unless $res eq $v;
-  print "ok $test\n";
-  $test++;
-}
-prefixify('/a/b/lib/arch', "/a/b/lib", 'X/lib', 'X/lib/arch');
-prefixify('/a/b/man/arch', "/a/b/man", 'X/man', 'X/man/arch');
-
-$_ = 'var="foo"';
-/(\")/;
-print "not " unless $1 and /$1/;
-print "ok $test\n";
-$test++;
-
-$a=qr/(?{++$b})/;
-$b = 7;
-/$a$a/;
-print "not " unless $b eq '9';
-print "ok $test\n";
-$test++;
-
-$c="$a";
-/$a$a/;
-print "not " unless $b eq '11';
-print "ok $test\n";
-$test++;
-
-{
-  use re "eval";
-  /$a$c$a/;
-  print "not " unless $b eq '14';
-  print "ok $test\n";
-  $test++;
-
-  local $lex_a = 2;
-  my $lex_a = 43;
-  my $lex_b = 17;
-  my $lex_c = 27;
-  my $lex_res = ($lex_b =~ qr/$lex_b(?{ $lex_c = $lex_a++ })/);
-  print "not " unless $lex_res eq '1';
-  print "ok $test\n";
-  $test++;
-  print "not " unless $lex_a eq '44';
-  print "ok $test\n";
-  $test++;
-  print "not " unless $lex_c eq '43';
-  print "ok $test\n";
-  $test++;
-
-
-  no re "eval";
-  $match = eval { /$a$c$a/ };
-  print "not "
-    unless $b eq '14' and $@ =~ /Eval-group not allowed/ and not $match;
-  print "ok $test\n";
-  $test++;
-}
+        # used to be a test for $*
+        ok $x =~ /^def/m, qq ["$x" =~ /^def/m];
 
-{
-  local $lex_a = 2;
-  my $lex_a = 43;
-  my $lex_b = 17;
-  my $lex_c = 27;
-  my $lex_res = ($lex_b =~ qr/17(?{ $lex_c = $lex_a++ })/);
-  print "not " unless $lex_res eq '1';
-  print "ok $test\n";
-  $test++;
-  print "not " unless $lex_a eq '44';
-  print "ok $test\n";
-  $test++;
-  print "not " unless $lex_c eq '43';
-  print "ok $test\n";
-  $test++;
-}
+        nok $x =~ /^xxx/, qq ["$x" =~ /^xxx/];
+        nok $x !~ /^abc/, qq ["$x" !~ /^abc/];
 
-{
-  package aa;
-  $c = 2;
-  $::c = 3;
-  '' =~ /(?{ $c = 4 })/;
-  print "not " unless $c == 4;
-}
-print "ok $test\n";
-$test++;
-print "not " unless $c == 3;
-print "ok $test\n";
-$test++;
-
-sub must_warn_pat {
-    my $warn_pat = shift;
-    return sub { print "not " unless $_[0] =~ /$warn_pat/ }
-}
+         ok $x =~ /def/, qq ["$x" =~ /def/];
+        nok $x !~ /def/, qq ["$x" !~ /def/];
 
-sub must_warn {
-    my ($warn_pat, $code) = @_;
-    local %SIG;
-    eval 'BEGIN { use warnings; $SIG{__WARN__} = $warn_pat };' . $code;
-    print "ok $test\n";
-    $test++;
-}
+         ok $x !~ /.def/, qq ["$x" !~ /.def/];
+        nok $x =~ /.def/, qq ["$x" =~ /.def/];
 
+         ok $x =~ /\ndef/, qq ["$x" =~ /\ndef/];
+        nok $x !~ /\ndef/, qq ["$x" !~ /\ndef/];
+    }
 
-sub make_must_warn {
-    my $warn_pat = shift;
-    return sub { must_warn(must_warn_pat($warn_pat)) }
-}
+    {
+        $_ = '123';
+        ok /^([0-9][0-9]*)/, qq [\$_ = '$_'; /^([0-9][0-9]*)/];
+    }
 
-my $for_future = make_must_warn('reserved for future extensions');
-
-&$for_future('q(a:[b]:) =~ /[x[:foo:]]/');
-
-#&$for_future('q(a=[b]=) =~ /[x[=foo=]]/');
-print "ok $test\n"; $test++; # now a fatal croak
-
-#&$for_future('q(a.[b].) =~ /[x[.foo.]]/');
-print "ok $test\n"; $test++; # now a fatal croak
-
-# test if failure of patterns returns empty list
-$_ = 'aaa';
-@_ = /bbb/;
-print "not " if @_;
-print "ok $test\n";
-$test++;
-
-@_ = /bbb/g;
-print "not " if @_;
-print "ok $test\n";
-$test++;
-
-@_ = /(bbb)/;
-print "not " if @_;
-print "ok $test\n";
-$test++;
-
-@_ = /(bbb)/g;
-print "not " if @_;
-print "ok $test\n";
-$test++;
-
-/a(?=.$)/;
-print "not " if $#+ != 0 or $#- != 0;
-print "ok $test\n";
-$test++;
-
-print "not " if $+[0] != 2 or $-[0] != 1;
-print "ok $test\n";
-$test++;
-
-print "not "
-   if defined $+[1] or defined $-[1] or defined $+[2] or defined $-[2];
-print "ok $test\n";
-$test++;
-
-/a(a)(a)/;
-print "not " if $#+ != 2 or $#- != 2;
-print "ok $test\n";
-$test++;
-
-print "not " if $+[0] != 3 or $-[0] != 0;
-print "ok $test\n";
-$test++;
-
-print "not " if $+[1] != 2 or $-[1] != 1;
-print "ok $test\n";
-$test++;
-
-print "not " if $+[2] != 3 or $-[2] != 2;
-print "ok $test\n";
-$test++;
-
-print "not "
-   if defined $+[3] or defined $-[3] or defined $+[4] or defined $-[4];
-print "ok $test\n";
-$test++;
-
-/.(a)(b)?(a)/;
-print "not " if $#+ != 3 or $#- != 3;
-print "ok $test\n";
-$test++;
-
-print "not " if $+[0] != 3 or $-[0] != 0;
-print "ok $test\n";
-$test++;
-
-print "not " if $+[1] != 2 or $-[1] != 1;
-print "ok $test\n";
-$test++;
-
-print "not " if $+[3] != 3 or $-[3] != 2;
-print "ok $test\n";
-$test++;
-
-print "not "
-   if defined $+[2] or defined $-[2] or defined $+[4] or defined $-[4];
-print "ok $test\n";
-$test++;
-
-/.(a)/;
-print "not " if $#+ != 1 or $#- != 1;
-print "ok $test\n";
-$test++;
-
-print "not " if $+[0] != 2 or $-[0] != 0;
-print "ok $test\n";
-$test++;
-
-print "not " if $+[1] != 2 or $-[1] != 1;
-print "ok $test\n";
-$test++;
-
-print "not "
-   if defined $+[2] or defined $-[2] or defined $+[3] or defined $-[3];
-print "ok $test\n";
-$test++;
-
-eval { $+[0] = 13; };
-print "not "
-   if $@ !~ /^Modification of a read-only value attempted/;
-print "ok $test\n";
-$test++;
-
-eval { $-[0] = 13; };
-print "not "
-   if $@ !~ /^Modification of a read-only value attempted/;
-print "ok $test\n";
-$test++;
-
-eval { @+ = (7, 6, 5); };
-print "not "
-   if $@ !~ /^Modification of a read-only value attempted/;
-print "ok $test\n";
-$test++;
-
-eval { @- = qw(foo bar); };
-print "not "
-   if $@ !~ /^Modification of a read-only value attempted/;
-print "ok $test\n";
-$test++;
-
-/.(a)(ba*)?/;
-print "#$#-..$#+\nnot " if $#+ != 2 or $#- != 1;
-print "ok $test\n";
-$test++;
-
-$_ = 'aaa';
-pos = 1;
-@a = /\Ga/g;
-print "not " unless "@a" eq "a a";
-print "ok $test\n";
-$test++;
-
-$str = 'abcde';
-pos $str = 2;
-
-print "not " if $str =~ /^\G/;
-print "ok $test\n";
-$test++;
-
-print "not " if $str =~ /^.\G/;
-print "ok $test\n";
-$test++;
-
-print "not " unless $str =~ /^..\G/;
-print "ok $test\n";
-$test++;
-
-print "not " if $str =~ /^...\G/;
-print "ok $test\n";
-$test++;
-
-print "not " unless $str =~ /.\G./ and $& eq 'bc';
-print "ok $test\n";
-$test++;
-
-print "not " unless $str =~ /\G../ and $& eq 'cd';
-print "ok $test\n";
-$test++;
-
-undef $foo; undef $bar;
-print "#'$str','$foo','$bar'\nnot "
-    unless $str =~ /b(?{$foo = $_; $bar = pos})c/
-	and $foo eq 'abcde' and $bar eq 2;
-print "ok $test\n";
-$test++;
-
-undef $foo; undef $bar;
-pos $str = undef;
-print "#'$str','$foo','$bar'\nnot "
-    unless $str =~ /b(?{$foo = $_; $bar = pos})c/g
-	and $foo eq 'abcde' and $bar eq 2 and pos $str eq 3;
-print "ok $test\n";
-$test++;
-
-$_ = $str;
-
-undef $foo; undef $bar;
-print "#'$str','$foo','$bar'\nnot "
-    unless /b(?{$foo = $_; $bar = pos})c/
-	and $foo eq 'abcde' and $bar eq 2;
-print "ok $test\n";
-$test++;
-
-undef $foo; undef $bar;
-print "#'$str','$foo','$bar'\nnot "
-    unless /b(?{$foo = $_; $bar = pos})c/g
-	and $foo eq 'abcde' and $bar eq 2 and pos eq 3;
-print "ok $test\n";
-$test++;
-
-undef $foo; undef $bar;
-pos = undef;
-1 while /b(?{$foo = $_; $bar = pos})c/g;
-print "#'$str','$foo','$bar'\nnot "
-    unless $foo eq 'abcde' and $bar eq 2 and not defined pos;
-print "ok $test\n";
-$test++;
-
-undef $foo; undef $bar;
-$_ = 'abcde|abcde';
-print "#'$str','$foo','$bar','$_'\nnot "
-    unless s/b(?{$foo = $_; $bar = pos})c/x/g and $foo eq 'abcde|abcde'
-	and $bar eq 8 and $_ eq 'axde|axde';
-print "ok $test\n";
-$test++;
-
-@res = ();
-# List context:
-$_ = 'abcde|abcde';
-@dummy = /([ace]).(?{push @res, $1,$2})([ce])(?{push @res, $1,$2})/g;
-@res = map {defined $_ ? "'$_'" : 'undef'} @res;
-$res = "@res";
-print "#'@res' '$_'\nnot "
-    unless "@res" eq "'a' undef 'a' 'c' 'e' undef 'a' undef 'a' 'c'";
-print "ok $test\n";
-$test++;
-
-@res = ();
-@dummy = /([ace]).(?{push @res, $`,$&,$'})([ce])(?{push @res, $`,$&,$'})/g;
-@res = map {defined $_ ? "'$_'" : 'undef'} @res;
-$res = "@res";
-print "#'@res' '$_'\nnot "
-    unless "@res" eq
-  "'' 'ab' 'cde|abcde' " .
-  "'' 'abc' 'de|abcde' " .
-  "'abcd' 'e|' 'abcde' " .
-  "'abcde|' 'ab' 'cde' " .
-  "'abcde|' 'abc' 'de'" ;
-print "ok $test\n";
-$test++;
-
-#Some more \G anchor checks
-$foo='aabbccddeeffgg';
-
-pos($foo)=1;
-
-$foo=~/.\G(..)/g;
-iseq($1,'ab');
-
-pos($foo) += 1;
-$foo=~/.\G(..)/g;
-print "not " unless($1 eq 'cc');
-print "ok $test\n";
-$test++;
-
-pos($foo) += 1;
-$foo=~/.\G(..)/g;
-print "not " unless($1 eq 'de');
-print "ok $test\n";
-$test++;
-
-print "not " unless $foo =~ /\Gef/g;
-print "ok $test\n";
-$test++;
-
-undef pos $foo;
-
-$foo=~/\G(..)/g;
-print "not " unless($1  eq 'aa');
-print "ok $test\n";
-$test++;
-
-$foo=~/\G(..)/g;
-print "not " unless($1  eq 'bb');
-print "ok $test\n";
-$test++;
-
-pos($foo)=5;
-$foo=~/\G(..)/g;
-print "not " unless($1  eq 'cd');
-print "ok $test\n";
-$test++;
-
-$_='123x123';
-@res = /(\d*|x)/g;
-print "not " unless('123||x|123|' eq join '|', @res);
-print "ok $test\n";
-$test++;
-
-# see if matching against temporaries (created via pp_helem()) is safe
-{ foo => "ok $test\n".$^X }->{foo} =~ /^(.*)\n/g;
-print "$1\n";
-$test++;
-
-# See if $i work inside (?{}) in the presense of saved substrings and
-# changing $_
-@a = qw(foo bar);
-@b = ();
-s/(\w)(?{push @b, $1})/,$1,/g for @a;
-
-print "# \@b='@b', expect 'f o o b a r'\nnot " unless("@b" eq "f o o b a r");
-print "ok $test\n";
-$test++;
-
-print "not " unless("@a" eq ",f,,o,,o, ,b,,a,,r,");
-print "ok $test\n";
-$test++;
-
-$brackets = qr{
-	         {  (?> [^{}]+ | (??{ $brackets }) )* }
-	      }x;
-
-"{{}" =~ $brackets;
-print "ok $test\n";		# Did we survive?
-$test++;
-
-"something { long { and } hairy" =~ $brackets;
-print "ok $test\n";		# Did we survive?
-$test++;
-
-"something { long { and } hairy" =~ m/((??{ $brackets }))/;
-print "not " unless $1 eq "{ and }";
-print "ok $test\n";
-$test++;
-
-$_ = "a-a\nxbb";
-pos=1;
-m/^-.*bb/mg and print "not ";
-print "ok $test\n";
-$test++;
-
-$text = "aaXbXcc";
-pos($text)=0;
-$text =~ /\GXb*X/g and print 'not ';
-print "ok $test\n";
-$test++;
-
-$text = "xA\n" x 500;
-$text =~ /^\s*A/m and print 'not ';
-print "ok $test\n";
-$test++;
-
-$text = "abc dbf";
-@res = ($text =~ /.*?(b).*?\b/g);
-"@res" eq 'b b' or print 'not ';
-print "ok $test\n";
-$test++;
-
-@a = map chr,0..255;
-
-@b = grep(/\S/,@a);
-@c = grep(/[^\s]/,@a);
-print "not " if "@b" ne "@c";
-print "ok $test\n";
-$test++;
-
-@b = grep(/\S/,@a);
-@c = grep(/[\S]/,@a);
-print "not " if "@b" ne "@c";
-print "ok $test\n";
-$test++;
-
-@b = grep(/\s/,@a);
-@c = grep(/[^\S]/,@a);
-print "not " if "@b" ne "@c";
-print "ok $test\n";
-$test++;
-
-@b = grep(/\s/,@a);
-@c = grep(/[\s]/,@a);
-print "not " if "@b" ne "@c";
-print "ok $test\n";
-$test++;
-
-@b = grep(/\D/,@a);
-@c = grep(/[^\d]/,@a);
-print "not " if "@b" ne "@c";
-print "ok $test\n";
-$test++;
-
-@b = grep(/\D/,@a);
-@c = grep(/[\D]/,@a);
-print "not " if "@b" ne "@c";
-print "ok $test\n";
-$test++;
-
-@b = grep(/\d/,@a);
-@c = grep(/[^\D]/,@a);
-print "not " if "@b" ne "@c";
-print "ok $test\n";
-$test++;
-
-@b = grep(/\d/,@a);
-@c = grep(/[\d]/,@a);
-print "not " if "@b" ne "@c";
-print "ok $test\n";
-$test++;
-
-@b = grep(/\W/,@a);
-@c = grep(/[^\w]/,@a);
-print "not " if "@b" ne "@c";
-print "ok $test\n";
-$test++;
-
-@b = grep(/\W/,@a);
-@c = grep(/[\W]/,@a);
-print "not " if "@b" ne "@c";
-print "ok $test\n";
-$test++;
-
-@b = grep(/\w/,@a);
-@c = grep(/[^\W]/,@a);
-print "not " if "@b" ne "@c";
-print "ok $test\n";
-$test++;
-
-@b = grep(/\w/,@a);
-@c = grep(/[\w]/,@a);
-iseq("@b","@c");
-
-# see if backtracking optimization works correctly
-"\n\n" =~ /\n  $ \n/x or print "not ";
-print "ok $test\n";
-$test++;
-
-"\n\n" =~ /\n* $ \n/x or print "not ";
-print "ok $test\n";
-$test++;
-
-"\n\n" =~ /\n+ $ \n/x or print "not ";
-print "ok $test\n";
-$test++;
-
-[] =~ /^ARRAY/ or print "# [] \nnot ";
-print "ok $test\n";
-$test++;
-
-eval << 'EOE';
-{
- package S;
- use overload '""' => sub { 'Object S' };
- sub new { bless [] }
-}
-$a = 'S'->new;
-EOE
-
-$a and $a =~ /^Object\sS/ or print "# '$a' \nnot ";
-print "ok $test\n";
-$test++;
-
-# test result of match used as match (!)
-'a1b' =~ ('xyz' =~ /y/) and $` eq 'a' or print "not ";
-print "ok $test\n";
-$test++;
-
-'a1b' =~ ('xyz' =~ /t/) and $` eq 'a' or print "not ";
-print "ok $test\n";
-$test++;
-
-$w = 0;
-{
-    local $SIG{__WARN__} = sub { $w = 1 };
-    local $^W = 1;
-	$w = 1 if ("1\n" x 102) =~ /^\s*\n/m;
-}
-print $w ? "not " : "", "ok $test\n";
-$test++;
-
-my %space = ( spc   => " ",
-	      tab   => "\t",
-	      cr    => "\r",
-	      lf    => "\n",
-	      ff    => "\f",
-# There's no \v but the vertical tabulator seems miraculously
-# be 11 both in ASCII and EBCDIC.
-	      vt    => chr(11),
-	      false => "space" );
-
-my @space0 = sort grep { $space{$_} =~ /\s/ }          keys %space;
-my @space1 = sort grep { $space{$_} =~ /[[:space:]]/ } keys %space;
-my @space2 = sort grep { $space{$_} =~ /[[:blank:]]/ } keys %space;
-
-print "not " unless "@space0" eq "cr ff lf spc tab";
-print "ok $test # @space0\n";
-$test++;
-
-print "not " unless "@space1" eq "cr ff lf spc tab vt";
-print "ok $test # @space1\n";
-$test++;
-
-print "not " unless "@space2" eq "spc tab";
-print "ok $test # @space2\n";
-$test++;
-
-# bugid 20001021.005 - this caused a SEGV
-print "not " unless undef =~ /^([^\/]*)(.*)$/;
-print "ok $test\n";
-$test++;
-
-# bugid 20000731.001
-
-print "not " unless "A \x{263a} B z C" =~ /A . B (??{ "z" }) C/;
-print "ok $test\n";
-$test++;
-
-my $ordA = ord('A');
-
-$_ = "a\x{100}b";
-if (/(.)(\C)(\C)(.)/) {
-  print "ok 232\n";
-  if ($1 eq "a") {
-    print "ok 233\n";
-  } else {
-    print "not ok 233\n";
-  }
-  if ($ordA == 65) { # ASCII (or equivalent), should be UTF-8
-      if ($2 eq "\xC4") {
-	  print "ok 234\n";
-      } else {
-	  print "not ok 234\n";
-      }
-      if ($3 eq "\x80") {
-	  print "ok 235\n";
-      } else {
-	  print "not ok 235\n";
-      }
-  } elsif ($ordA == 193) { # EBCDIC (or equivalent), should be UTF-EBCDIC
-      if ($2 eq "\x8C") {
-	  print "ok 234\n";
-      } else {
-	  print "not ok 234\n";
-      }
-      if ($3 eq "\x41") {
-	  print "ok 235\n";
-      } else {
-	  print "not ok 235\n";
-      }
-  } else {
-      for (234..235) {
-	  print "not ok $_ # ord('A') == $ordA\n";
-      }
-  }
-  if ($4 eq "b") {
-    print "ok 236\n";
-  } else {
-    print "not ok 236\n";
-  }
-} else {
-  for (232..236) {
-    print "not ok $_\n";
-  }
-}
-$_ = "\x{100}";
-if (/(\C)/g) {
-  print "ok 237\n";
-  # currently \C are still tagged as UTF-8
-  if ($ordA == 65) {
-      if ($1 eq "\xC4") {
-	  print "ok 238\n";
-      } else {
-	  print "not ok 238\n";
-      }
-  } elsif ($ordA == 193) {
-      if ($1 eq "\x8C") {
-	  print "ok 238\n";
-      } else {
-	  print "not ok 238\n";
-      }
-  } else {
-      print "not ok 238 # ord('A') == $ordA\n";
-  }
-} else {
-  for (237..238) {
-    print "not ok $_\n";
-  }
-}
-if (/(\C)/g) {
-  print "ok 239\n";
-  # currently \C are still tagged as UTF-8
-  if ($ordA == 65) {
-      if ($1 eq "\x80") {
-	  print "ok 240\n";
-      } else {
-	  print "not ok 240\n";
-      }
-  } elsif ($ordA == 193) {
-      if ($1 eq "\x41") {
-	  print "ok 240\n";
-      } else {
-	  print "not ok 240\n";
-      }
-  } else {
-      print "not ok 240 # ord('A') == $ordA\n";
-  }
-} else {
-  for (239..240) {
-    print "not ok $_\n";
-  }
-}
+    {
+        $_ = 'aaabbbccc';
+         ok /(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc',
+                                             qq [\$_ = '$_'; /(a*b*)(c*)/];
+         ok /(a+b+c+)/ && $1 eq 'aaabbbccc', qq [\$_ = '$_'; /(a+b+c+)/];
+        nok /a+b?c+/,                        qq [\$_ = '$_'; /a+b?c+/];
+
+        $_ = 'aaabccc';
+         ok /a+b?c+/, qq [\$_ = '$_'; /a+b?c+/];
+         ok /a*b?c*/, qq [\$_ = '$_'; /a*b?c*/];
+
+        $_ = 'aaaccc';
+         ok /a*b?c*/, qq [\$_ = '$_'; /a*b?c*/];
+        nok /a*b+c*/, qq [\$_ = '$_'; /a*b+c*/];
+
+        $_ = 'abcdef';
+         ok /bcd|xyz/, qq [\$_ = '$_'; /bcd|xyz/];
+         ok /xyz|bcd/, qq [\$_ = '$_'; /xyz|bcd/];
+         ok m|bc/*d|,  qq [\$_ = '$_'; m|bc/*d|];
+         ok /^$_$/,    qq [\$_ = '$_'; /^\$_\$/];
+    }
 
-{
-  # japhy -- added 03/03/2001
-  () = (my $str = "abc") =~ /(...)/;
-  $str = "def";
-  print "not " if $1 ne "abc";
-  print "ok 241\n";
-}
+    {
+        # used to be a test for $*
+        ok "ab\ncd\n" =~ /^cd/m, qq ["ab\ncd\n" =~ /^cd/m];
+    }
 
-# The 242 and 243 go with the 244 and 245.
-# The trick is that in EBCDIC the explicit numeric range should match
-# (as also in non-EBCDIC) but the explicit alphabetic range should not match.
+    {
+        our %XXX = map {($_ => $_)} 123, 234, 345;
+
+        our @XXX = ('ok 1','not ok 1', 'ok 2','not ok 2','not ok 3');
+        while ($_ = shift(@XXX)) {
+            my $f = index ($_, 'not') >= 0 ? \&nok : \&ok;
+            my $r = ?(.*)?;
+            &$f ($r, "?(.*)?");
+            /not/ && reset;
+            if (/not ok 2/) {
+                if ($^O eq 'VMS') {
+                    $_ = shift(@XXX);
+                }
+                else {
+                    reset 'X';
+                }
+            }
+        }
 
-if ("\x8e" =~ /[\x89-\x91]/) {
-  print "ok 242\n";
-} else {
-  print "not ok 242\n";
-}
+        SKIP: {
+            if ($^O eq 'VMS') {
+                skip "Reset 'X'", 1;
+            }
+            ok !keys %XXX, "%XXX is empty";
+        }
 
-if ("\xce" =~ /[\xc9-\xd1]/) {
-  print "ok 243\n";
-} else {
-  print "not ok 243\n";
-}
+    }
 
-# In most places these tests would succeed since \x8e does not
-# in most character sets match 'i' or 'j' nor would \xce match
-# 'I' or 'J', but strictly speaking these tests are here for
-# the good of EBCDIC, so let's test these only there.
-if (ord('i') == 0x89 && ord('J') == 0xd1) { # EBCDIC
-  if ("\x8e" !~ /[i-j]/) {
-    print "ok 244\n";
-  } else {
-    print "not ok 244\n";
-  }
-  if ("\xce" !~ /[I-J]/) {
-    print "ok 245\n";
-  } else {
-    print "not ok 245\n";
-  }
-} else {
-  for (244..245) {
-    print "ok $_ # Skip: only in EBCDIC\n";
-  }
-}
+    {
+        local $Message = "Test empty pattern";
+        my $xyz = 'xyz';
+        my $cde = 'cde';
+
+        $cde =~ /[^ab]*/;
+        $xyz =~ //;
+        iseq $&, $xyz;
+
+        my $foo = '[^ab]*';
+        $cde =~ /$foo/;
+        $xyz =~ //;
+        iseq $&, $xyz;
+
+        $cde =~ /$foo/;
+        my $null;
+        no warnings 'uninitialized';
+        $xyz =~ /$null/;
+        iseq $&, $xyz;
+
+        $null = "";
+        $xyz =~ /$null/;
+        iseq $&, $xyz;
+    }
 
-print "not " unless "\x{ab}" =~ /\x{ab}/;
-print "ok 246\n";
+    {
+        local $Message = q !Check $`, $&, $'!;
+        $_ = 'abcdefghi';
+        /def/;		# optimized up to cmd
+        iseq "$`:$&:$'", 'abc:def:ghi';
 
-print "not " unless "\x{abcd}" =~ /\x{abcd}/;
-print "ok 247\n";
+        no warnings 'void';
+        /cde/ + 0;	# optimized only to spat
+        iseq "$`:$&:$'", 'ab:cde:fghi';
 
-{
-    # bug id 20001008.001
+        /[d][e][f]/;	# not optimized
+        iseq "$`:$&:$'", 'abc:def:ghi';
+    }
 
-    $test = 248;
-    my @x = ("stra\337e 138","stra\337e 138");
-    for (@x) {
-	s/(\d+)\s*([\w\-]+)/$1 . uc $2/e;
-	my($latin) = /^(.+)(?:\s+\d)/;
-	print $latin eq "stra\337e" ? "ok $test\n" :	# 248,249
-	    "#latin[$latin]\nnot ok $test\n";
-	$test++;
-	$latin =~ s/stra\337e/straße/; # \303\237 after the 2nd a
-	use utf8; # needed for the raw UTF-8
-	$latin =~ s!(s)tr(?:aß|s+e)!$1tr.!; # \303\237 after the a
+    {
+        $_ = 'now is the {time for all} good men to come to.';
+        / {([^}]*)}/;
+        iseq $1, 'time for all', "Match braces";
     }
-}
 
-{
-    print "not " unless "ba\xd4c" =~ /([a\xd4]+)/ && $1 eq "a\xd4";
-    print "ok 250\n";
+    {
+        local $Message = "{N,M} quantifier";
+        $_ = 'xxx {3,4}  yyy   zzz';
+        ok /( {3,4})/;
+        iseq $1, '   ';
+        ok !/( {4,})/;
+        ok /( {2,3}.)/;
+        iseq $1, '  y';
+        ok /(y{2,3}.)/;
+        iseq $1, 'yyy ';
+        ok !/x {3,4}/;
+        ok !/^xxx {3,4}/;
+    }
 
-    print "not " unless "ba\xd4c" =~ /([a\xd4]+)/ && $1 eq "a\x{d4}";
-    print "ok 251\n";
+    {
+        local $Message = "Test /g";
+        local $" = ":";
+        $_ = "now is the time for all good men to come to.";
+        my @words = /(\w+)/g;
+        my $exp   = "now:is:the:time:for:all:good:men:to:come:to";
 
-    print "not " unless "ba\x{d4}c" =~ /([a\xd4]+)/ && $1 eq "a\x{d4}";
-    print "ok 252\n";
+        iseq "@words", $exp;
 
-    print "not " unless "ba\x{d4}c" =~ /([a\xd4]+)/ && $1 eq "a\xd4";
-    print "ok 253\n";
+        @words = ();
+        while (/\w+/g) {
+            push (@words, $&);
+        }
+        iseq "@words", $exp;
 
-    print "not " unless "ba\xd4c" =~ /([a\x{d4}]+)/ && $1 eq "a\xd4";
-    print "ok 254\n";
+        @words = ();
+        pos = 0;
+        while (/to/g) {
+            push(@words, $&);
+        }
+        iseq "@words", "to:to";
 
-    print "not " unless "ba\xd4c" =~ /([a\x{d4}]+)/ && $1 eq "a\x{d4}";
-    print "ok 255\n";
+        pos $_ = 0;
+        @words = /to/g;
+        iseq "@words", "to:to";
+    }
 
-    print "not " unless "ba\x{d4}c" =~ /([a\x{d4}]+)/ && $1 eq "a\x{d4}";
-    print "ok 256\n";
+    {
+        $_ = "abcdefghi";
+
+        my $pat1 = 'def';
+        my $pat2 = '^def';
+        my $pat3 = '.def.';
+        my $pat4 = 'abc';
+        my $pat5 = '^abc';
+        my $pat6 = 'abc$';
+        my $pat7 = 'ghi';
+        my $pat8 = '\w*ghi';
+        my $pat9 = 'ghi$';
+
+        my $t1 = my $t2 = my $t3 = my $t4 = my $t5 =
+        my $t6 = my $t7 = my $t8 = my $t9 = 0;
+
+        for my $iter (1 .. 5) {
+            $t1++ if /$pat1/o;
+            $t2++ if /$pat2/o;
+            $t3++ if /$pat3/o;
+            $t4++ if /$pat4/o;
+            $t5++ if /$pat5/o;
+            $t6++ if /$pat6/o;
+            $t7++ if /$pat7/o;
+            $t8++ if /$pat8/o;
+            $t9++ if /$pat9/o;
+        }
+        my $x = "$t1$t2$t3$t4$t5$t6$t7$t8$t9";
+        iseq $x, '505550555', "Test /o";
+    }
 
-    print "not " unless "ba\x{d4}c" =~ /([a\x{d4}]+)/ && $1 eq "a\xd4";
-    print "ok 257\n";
-}
 
-{
-    # the first half of 20001028.003
+    SKIP: {
+        my $xyz = 'xyz';
+        ok "abc" =~ /^abc$|$xyz/, "| after \$";
 
-    my $X = chr(1448);
-    my ($Y) = $X =~ /(.*)/;
-    print "not " unless $Y eq v1448 && length($Y) == 1;
-    print "ok 258\n";
-}
+        # perl 4.009 says "unmatched ()"
+        local $Message = '$ inside ()';
 
-{
-    # 20001108.001
+        my $result;
+        eval '"abc" =~ /a(bc$)|$xyz/; $result = "$&:$1"';
+        iseq $@, "" or skip "eval failed", 1;
+        iseq $result, "abc:bc";
+    }
 
-    my $X = "Szab\x{f3},Bal\x{e1}zs";
-    my $Y = $X;
-    $Y =~ s/(B)/$1/ for 0..3;
-    print "not " unless $Y eq $X && $X eq "Szab\x{f3},Bal\x{e1}zs";
-    print "ok 259\n";
-}
 
-{
-    # the second half of 20001028.003
+    {
+        local $Message = "Scalar /g";
+        $_ = "abcfooabcbar";
+
+        ok  /abc/g && $` eq "";
+        ok  /abc/g && $` eq "abcfoo";
+        ok !/abc/g;
+
+        local $Message = "Scalar /gi";
+        pos = 0;
+        ok  /ABC/gi && $` eq "";
+        ok  /ABC/gi && $` eq "abcfoo";
+        ok !/ABC/gi;
+
+        local $Message = "Scalar /g";
+        pos = 0;
+        ok  /abc/g && $' eq "fooabcbar";
+        ok  /abc/g && $' eq "bar";
+
+        $_ .= '';
+        my @x = /abc/g;
+        iseq @x, 2, "/g reset after assignment";
+    }
 
-    my $X = '';
-    $X =~ s/^/chr(1488)/e;
-    print "not " unless length $X == 1 && ord($X) == 1488;
-    print "ok 260\n";
-}
+    {
+        local $Message = '/g, \G and pos';
+        $_ = "abdc";
+        pos $_ = 2;
+        /\Gc/gc;
+        iseq pos $_, 2;
+        /\Gc/g;
+        ok !defined pos $_;
+    }
 
-{
-    # 20000517.001
+    {
+        local $Message = '(?{ })';
+        our $out = 1;
+        'abc' =~ m'a(?{ $out = 2 })b';
+        iseq $out, 2;
+
+        $out = 1;
+        'abc' =~ m'a(?{ $out = 3 })c';
+        iseq $out, 1;
+    }
 
-    my $x = "\x{100}A";
 
-    $x =~ s/A/B/;
+    {
+        $_ = 'foobar1 bar2 foobar3 barfoobar5 foobar6';
+        my @out = /(?<!foo)bar./g;
+        iseq "@out", 'bar2 barf', "Negative lookbehind";
+    }
 
-    print "not " unless $x eq "\x{100}B" && length($x) == 2;
-    print "ok 261\n";
-}
+    {
+        local $Message = "REG_INFTY tests";
+        # Tests which depend on REG_INFTY
+        $::reg_infty   = $Config {reg_infty} // 32767;
+        $::reg_infty_m = $::reg_infty - 1;
+        $::reg_infty_p = $::reg_infty + 1;
+        $::reg_infty_m = $::reg_infty_m;   # Surpress warning.
+
+        # As well as failing if the pattern matches do unexpected things, the
+        # next three tests will fail if you should have picked up a lower-than-
+        # default value for $reg_infty from Config.pm, but have not.
+
+        eval_ok q (('aaa' =~ /(a{1,$::reg_infty_m})/)[0] eq 'aaa');
+        eval_ok q (('a' x $::reg_infty_m) =~ /a{$::reg_infty_m}/);
+        eval_ok q (('a' x ($::reg_infty_m - 1)) !~ /a{$::reg_infty_m}/);
+        eval "'aaa' =~ /a{1,$::reg_infty}/";
+        ok $@ =~ /^\QQuantifier in {,} bigger than/;
+        eval "'aaa' =~ /a{1,$::reg_infty_p}/";
+        ok $@ =~ /^\QQuantifier in {,} bigger than/;
+    }
 
-{
-    # bug id 20001230.002
+    {
+        # Poke a couple more parse failures
+        my $context = 'x' x 256;
+        eval qq("${context}y" =~ /(?<=$context)y/);
+        ok $@ =~ /^\QLookbehind longer than 255 not/, "Lookbehind limit";
+    }
 
-    print "not " unless "École" =~ /^\C\C(.)/ && $1 eq 'c';
-    print "ok 262\n";
+    {
+        # Long Monsters
+        local $Message = "Long monster";
+        for my $l (125, 140, 250, 270, 300000, 30) { # Ordered to free memory
+            my $a = 'a' x $l;
+            local $Error = "length = $l";
+             ok "ba$a=" =~ /a$a=/;
+            nok "b$a="  =~ /a$a=/;
+             ok "b$a="  =~ /ba+=/;
+
+             ok "ba$a=" =~ /b(?:a|b)+=/;
+        }
+    }
 
-    print "not " unless "École" =~ /^\C\C(c)/;
-    print "ok 263\n";
-}
 
-SKIP: {
-    $test = 264; # till 575
-
-    use charnames ":full";
-
-    # This is far from complete testing, there are dozens of character
-    # classes in Unicode.  The mixing of literals and \N{...} is
-    # intentional so that in non-Latin-1 places we test the native
-    # characters, not the Unicode code points.
-
-    my %s = (
-	     "a" 				=> 'Ll',
-	     "\N{CYRILLIC SMALL LETTER A}"	=> 'Ll',
-	     "A" 				=> 'Lu',
-	     "\N{GREEK CAPITAL LETTER ALPHA}"	=> 'Lu',
-	     "\N{HIRAGANA LETTER SMALL A}"	=> 'Lo',
-	     "\N{COMBINING GRAVE ACCENT}"	=> 'Mn',
-	     "0"				=> 'Nd',
-	     "\N{ARABIC-INDIC DIGIT ZERO}"	=> 'Nd',
-	     "_"				=> 'N',
-	     "!"				=> 'P',
-	     " "				=> 'Zs',
-	     "\0"				=> 'Cc',
-	     );
-	
-    for my $char (map { s/^\S+ //; $_ }
-                    sort map { sprintf("%06x", ord($_))." $_" } keys %s) {
-	my $class = $s{$char};
-	my $code  = sprintf("%06x", ord($char));
-	printf "#\n# 0x$code\n#\n";
-	print "# IsAlpha\n";
-	if ($class =~ /^[LM]/) {
-	    print "not " unless $char =~ /\p{IsAlpha}/;
-	    print "ok $test\n"; $test++;
-	    print "not " if     $char =~ /\P{IsAlpha}/;
-	    print "ok $test\n"; $test++;
-	} else {
-	    print "not " if     $char =~ /\p{IsAlpha}/;
-	    print "ok $test\n"; $test++;
-	    print "not " unless $char =~ /\P{IsAlpha}/;
-	    print "ok $test\n"; $test++;
-	}
-	print "# IsAlnum\n";
-	if ($class =~ /^[LMN]/ && $char ne "_") {
-	    print "not " unless $char =~ /\p{IsAlnum}/;
-	    print "ok $test\n"; $test++;
-	    print "not " if     $char =~ /\P{IsAlnum}/;
-	    print "ok $test\n"; $test++;
-	} else {
-	    print "not " if     $char =~ /\p{IsAlnum}/;
-	    print "ok $test\n"; $test++;
-	    print "not " unless $char =~ /\P{IsAlnum}/;
-	    print "ok $test\n"; $test++;
-	}
-	print "# IsASCII\n";
-	if (ord("A") == 193) {
-	    print "ok $test # Skip: in EBCDIC\n"; $test++;
-	    print "ok $test # Skip: in EBCDIC\n"; $test++;
-	} else {
-	    if ($code le '00007f') {
-		print "not " unless $char =~ /\p{IsASCII}/;
-		print "ok $test\n"; $test++;
-		print "not " if     $char =~ /\P{IsASCII}/;
-		print "ok $test\n"; $test++;
-	    } else {
-		print "not " if     $char =~ /\p{IsASCII}/;
-		print "ok $test\n"; $test++;
-		print "not " unless $char =~ /\P{IsASCII}/;
-		print "ok $test\n"; $test++;
-	    }
-	}
-	print "# IsCntrl\n";
-	if ($class =~ /^C/) {
-	    print "not " unless $char =~ /\p{IsCntrl}/;
-	    print "ok $test\n"; $test++;
-	    print "not " if     $char =~ /\P{IsCntrl}/;
-	    print "ok $test\n"; $test++;
-	} else {
-	    print "not " if     $char =~ /\p{IsCntrl}/;
-	    print "ok $test\n"; $test++;
-	    print "not " unless $char =~ /\P{IsCntrl}/;
-	    print "ok $test\n"; $test++;
-	}
-	print "# IsBlank\n";
-	if ($class =~ /^Z[lp]/ || $char eq " ") {
-	    print "not " unless $char =~ /\p{IsBlank}/;
-	    print "ok $test\n"; $test++;
-	    print "not " if     $char =~ /\P{IsBlank}/;
-	    print "ok $test\n"; $test++;
-	} else {
-	    print "not " if     $char =~ /\p{IsBlank}/;
-	    print "ok $test\n"; $test++;
-	    print "not " unless $char =~ /\P{IsBlank}/;
-	    print "ok $test\n"; $test++;
-	}
-	print "# IsDigit\n";
-	if ($class =~ /^Nd$/) {
-	    print "not " unless $char =~ /\p{IsDigit}/;
-	    print "ok $test\n"; $test++;
-	    print "not " if     $char =~ /\P{IsDigit}/;
-	    print "ok $test\n"; $test++;
-	} else {
-	    print "not " if     $char =~ /\p{IsDigit}/;
-	    print "ok $test\n"; $test++;
-	    print "not " unless $char =~ /\P{IsDigit}/;
-	    print "ok $test\n"; $test++;
-	}
-	print "# IsGraph\n";
-	if ($class =~ /^([LMNPS])|Co/) {
-	    print "not " unless $char =~ /\p{IsGraph}/;
-	    print "ok $test\n"; $test++;
-	    print "not " if     $char =~ /\P{IsGraph}/;
-	    print "ok $test\n"; $test++;
-	} else {
-	    print "not " if     $char =~ /\p{IsGraph}/;
-	    print "ok $test\n"; $test++;
-	    print "not " unless $char =~ /\P{IsGraph}/;
-	    print "ok $test\n"; $test++;
-	}
-	print "# IsLower\n";
-	if ($class =~ /^Ll$/) {
-	    print "not " unless $char =~ /\p{IsLower}/;
-	    print "ok $test\n"; $test++;
-	    print "not " if     $char =~ /\P{IsLower}/;
-	    print "ok $test\n"; $test++;
-	} else {
-	    print "not " if     $char =~ /\p{IsLower}/;
-	    print "ok $test\n"; $test++;
-	    print "not " unless $char =~ /\P{IsLower}/;
-	    print "ok $test\n"; $test++;
-	}
-	print "# IsPrint\n";
-	if ($class =~ /^([LMNPS])|Co|Zs/) {
-	    print "not " unless $char =~ /\p{IsPrint}/;
-	    print "ok $test\n"; $test++;
-	    print "not " if     $char =~ /\P{IsPrint}/;
-	    print "ok $test\n"; $test++;
-	} else {
-	    print "not " if     $char =~ /\p{IsPrint}/;
-	    print "ok $test\n"; $test++;
-	    print "not " unless $char =~ /\P{IsPrint}/;
-	    print "ok $test\n"; $test++;
-	}
-	print "# IsPunct\n";
-	if ($class =~ /^P/ || $char eq "_") {
-	    print "not " unless $char =~ /\p{IsPunct}/;
-	    print "ok $test\n"; $test++;
-	    print "not " if     $char =~ /\P{IsPunct}/;
-	    print "ok $test\n"; $test++;
-	} else {
-	    print "not " if     $char =~ /\p{IsPunct}/;
-	    print "ok $test\n"; $test++;
-	    print "not " unless $char =~ /\P{IsPunct}/;
-	    print "ok $test\n"; $test++;
-	}
-	print "# IsSpace\n";
-	if ($class =~ /^Z/ || ($code =~ /^(0009|000A|000B|000C|000D)$/)) {
-	    print "not " unless $char =~ /\p{IsSpace}/;
-	    print "ok $test\n"; $test++;
-	    print "not " if     $char =~ /\P{IsSpace}/;
-	    print "ok $test\n"; $test++;
-	} else {
-	    print "not " if     $char =~ /\p{IsSpace}/;
-	    print "ok $test\n"; $test++;
-	    print "not " unless $char =~ /\P{IsSpace}/;
-	    print "ok $test\n"; $test++;
-	}
-	print "# IsUpper\n";
-	if ($class =~ /^L[ut]/) {
-	    print "not " unless $char =~ /\p{IsUpper}/;
-	    print "ok $test\n"; $test++;
-	    print "not " if     $char =~ /\P{IsUpper}/;
-	    print "ok $test\n"; $test++;
-	} else {
-	    print "not " if     $char =~ /\p{IsUpper}/;
-	    print "ok $test\n"; $test++;
-	    print "not " unless $char =~ /\P{IsUpper}/;
-	    print "ok $test\n"; $test++;
-	}
-	print "# IsWord\n";
-	if ($class =~ /^[LMN]/ || $char eq "_") {
-	    print "not " unless $char =~ /\p{IsWord}/;
-	    print "ok $test\n"; $test++;
-	    print "not " if     $char =~ /\P{IsWord}/;
-	    print "ok $test\n"; $test++;
-	} else {
-	    print "not " if     $char =~ /\p{IsWord}/;
-	    print "ok $test\n"; $test++;
-	    print "not " unless $char =~ /\P{IsWord}/;
-	    print "ok $test\n"; $test++;
-	}
+    {
+        # 20000 nodes, each taking 3 words per string, and 1 per branch
+        my $long_constant_len = join '|', 12120 .. 32645;
+        my $long_var_len = join '|', 8120 .. 28645;
+        my %ans = ( 'ax13876y25677lbc' => 1,
+                    'ax13876y25677mcb' => 0, # not b.
+                    'ax13876y35677nbc' => 0, # Num too big
+                    'ax13876y25677y21378obc' => 1,
+                    'ax13876y25677y21378zbc' => 0,	# Not followed by [k-o]
+                    'ax13876y25677y21378y21378kbc' => 1,
+                    'ax13876y25677y21378y21378kcb' => 0, # Not b.
+                    'ax13876y25677y21378y21378y21378kbc' => 0, # 5 runs
+                  );
+
+        local $Message = "20000 nodes";
+        for (keys %ans) {
+            local $Error = "const-len '$_'";
+            ok !($ans{$_} xor /a(?=([yx]($long_constant_len)){2,4}[k-o]).*b./o);
+
+            local $Error = "var-len '$_'";
+            ok !($ans{$_} xor /a(?=([yx]($long_var_len)){2,4}[k-o]).*b./o);
+        }
     }
-}
 
-{
-    $_ = "abc\x{100}\x{200}\x{300}\x{380}\x{400}defg";
+    {
+        local $Message = "Complicated backtracking";
+        $_ = " a (bla()) and x(y b((l)u((e))) and b(l(e)e)e";
+        my $expect = "(bla()) ((l)u((e))) (l(e)e)";
+
+        use vars '$c';
+        sub matchit {
+          m/
+             (
+               \(
+               (?{ $c = 1 })	# Initialize
+               (?:
+                 (?(?{ $c == 0 })   # PREVIOUS iteration was OK, stop the loop
+                   (?!
+                   )		# Fail: will unwind one iteration back
+                 )	
+                 (?:
+                   [^()]+		# Match a big chunk
+                   (?=
+                     [()]
+                   )		# Do not try to match subchunks
+                 |
+                   \(
+                   (?{ ++$c })
+                 |
+                   \)
+                   (?{ --$c })
+                 )
+               )+		# This may not match with different subblocks
+             )
+             (?(?{ $c != 0 })
+               (?!
+               )		# Fail
+             )			# Otherwise the chunk 1 may succeed with $c>0
+           /xg;
+        }
+
+        my @ans = ();
+        my $res;
+        push @ans, $res while $res = matchit;
+        iseq "@ans", "1 1 1";
+
+        @ans = matchit;
+        iseq "@ans", $expect;
 
-    if (/(.\x{300})./) {
-	print "ok 576\n";
+        local $Message = "Recursion with (??{ })";
+        our $matched;
+        $matched = qr/\((?:(?>[^()]+)|(??{$matched}))*\)/;
 
-	print "not " unless $` eq "abc\x{100}" && length($`) == 4;
-	print "ok 577\n";
+        @ans = my @ans1 = ();
+        push (@ans, $res), push (@ans1, $&) while $res = m/$matched/g;
 
-	print "not " unless $& eq "\x{200}\x{300}\x{380}" && length($&) == 3;
-	print "ok 578\n";
+        iseq "@ans", "1 1 1";
+        iseq "@ans1", $expect;
 
-	print "not " unless $' eq "\x{400}defg" && length($') == 5;
-	print "ok 579\n";
+        @ans = m/$matched/g;
+        iseq "@ans", $expect;
 
-	print "not " unless $1 eq "\x{200}\x{300}" && length($1) == 2;
-	print "ok 580\n";
-    } else {
-	for (576..580) { print "not ok $_\n" }
     }
-}
 
-{
-    # bug id 20010306.008
+    {
+        ok "abc" =~ /^(??{"a"})b/, '"abc" =~ /^(??{"a"})b/';
+    }
 
-    $a = "a\x{1234}";
-    # The original bug report had 'no utf8' here but that was irrelevant.
-    $a =~ m/\w/; # used to core dump
+    {
+        my @ans = ('a/b' =~ m%(.*/)?(.*)%);	# Stack may be bad
+        iseq "@ans", 'a/ b', "Stack may be bad";
+    }
 
-    print "ok 581\n";
-}
+    {
+        local $Message = "Eval-group not allowed at runtime";
+        my $code = '{$blah = 45}';
+        our $blah = 12;
+        eval { /(?$code)/ };
+        ok $@ && $@ =~ /not allowed at runtime/ && $blah == 12;
+
+        for $code ('{$blah = 45}','=xx') {
+            $blah = 12;
+            my $res = eval { "xx" =~ /(?$code)/o };
+            no warnings 'uninitialized';
+            local $Error = "'$@', '$res', '$blah'";
+            if ($code eq '=xx') {
+                ok !$@ && $res;
+            }
+            else {
+                ok $@ && $@ =~ /not allowed at runtime/ && $blah == 12;
+            }
+        }
 
-{
-    $test = 582;
+        $code = '{$blah = 45}';
+        $blah = 12;
+        eval "/(?$code)/";
+        iseq $blah, 45;
+
+        $blah = 12;
+        /(?{$blah = 45})/;
+        iseq $blah, 45;
+    }
 
-    # bugid 20010410.006
-    for my $rx (
-		'/(.*?)\{(.*?)\}/csg',
-		'/(.*?)\{(.*?)\}/cg',
-		'/(.*?)\{(.*?)\}/sg',
-		'/(.*?)\{(.*?)\}/g',
-		'/(.+?)\{(.+?)\}/csg',
-	       )
     {
-	my($input, $i);
+        local $Message = "Pos checks";
+        my $x = 'banana';
+        $x =~ /.a/g;
+        iseq pos ($x), 2;
 
-	$i = 0;
-	$input = "a{b}c{d}";
-        eval <<EOT;
-	while (eval \$input =~ $rx) {
-	    print "# \\\$1 = '\$1' \\\$2 = '\$2'\n";
-	    ++\$i;
-	}
-EOT
-	print "not " unless $i == 2;
-	print "ok " . $test++ . "\n";
+        $x =~ /.z/gc;
+        iseq pos ($x), 2;
+
+        sub f {
+            my $p = $_[0];
+            return $p;
+        }
+
+        $x =~ /.a/g;
+        iseq f (pos ($x)), 4;
     }
-}
 
-{
-    # from Robin Houston
+    {
+        local $Message = 'Checking $^R';
+        our $x = $^R = 67;
+        'foot' =~ /foo(?{$x = 12; 75})[t]/;
+        iseq $^R, 75;
+
+        $x = $^R = 67;
+        'foot' =~ /foo(?{$x = 12; 75})[xy]/;
+        ok $^R eq '67' && $x eq '12';
+
+        $x = $^R = 67;
+        'foot' =~ /foo(?{ $^R + 12 })((?{ $x = 12; $^R + 17 })[xy])?/;
+        ok $^R eq '79' && $x eq '12';
+    }
 
-    my $x = "\x{10FFFD}";
-    $x =~ s/(.)/$1/g;
-    print "not " unless ord($x) == 0x10FFFD && length($x) == 1;
-    print "ok 587\n";
-}
+    {
+        iseq qr/\b\v$/i,    '(?i-xsm:\b\v$)', 'qr/\b\v$/i';
+        iseq qr/\b\v$/s,    '(?s-xim:\b\v$)', 'qr/\b\v$/s';
+        iseq qr/\b\v$/m,    '(?m-xis:\b\v$)', 'qr/\b\v$/m';
+        iseq qr/\b\v$/x,    '(?x-ism:\b\v$)', 'qr/\b\v$/x';
+        iseq qr/\b\v$/xism, '(?msix:\b\v$)',  'qr/\b\v$/xism';
+        iseq qr/\b\v$/,     '(?-xism:\b\v$)', 'qr/\b\v$/';
+    }
 
-{
-    my $x = "\x7f";
 
-    print "not " if     $x =~ /[\x80-\xff]/;
-    print "ok 588\n";
+    {
+        local $Message = "Look around";
+        $_ = 'xabcx';
+      SKIP:
+        foreach my $ans ('', 'c') {
+            ok /(?<=(?=a)..)((?=c)|.)/g or skip "Match failed", 1;
+            iseq $1, $ans;
+        }
+    }
 
-    print "not " if     $x =~ /[\x80-\x{100}]/;
-    print "ok 589\n";
+    {
+        local $Message = "Empty clause";
+        $_ = 'a';
+        foreach my $ans ('', 'a', '') {
+            ok /^|a|$/g or skip "Match failed", 1;
+            iseq $&, $ans;
+        }
+    }
 
-    print "not " if     $x =~ /[\x{100}]/;
-    print "ok 590\n";
+    {
+        local $Message = "Prefixify";
+        sub prefixify {
+            SKIP: {
+                my ($v, $a, $b, $res) = @_;
+                ok $v =~ s/\Q$a\E/$b/ or skip "Match failed", 1;
+                iseq $v, $res;
+            }
+        }
 
-    print "not " if     $x =~ /\p{InLatin1Supplement}/;
-    print "ok 591\n";
+        prefixify ('/a/b/lib/arch', "/a/b/lib", 'X/lib', 'X/lib/arch');
+        prefixify ('/a/b/man/arch', "/a/b/man", 'X/man', 'X/man/arch');
+    }
 
-    print "not " unless $x =~ /\P{InLatin1Supplement}/;
-    print "ok 592\n";
+    {
+        $_ = 'var="foo"';
+        /(\")/;
+        ok $1 && /$1/, "Capture a quote";
+    }
 
-    print "not " if     $x =~ /\p{InLatinExtendedA}/;
-    print "ok 593\n";
+    {
+        local $Message =  "Call code from qr //";
+        $a = qr/(?{++$b})/;
+        $b = 7;
+        ok /$a$a/ && $b eq '9';
+
+        $c="$a";
+        ok /$a$a/ && $b eq '11';
+
+        undef $@;
+        eval {/$c/};
+        ok $@ && $@ =~ /not allowed at runtime/;
+
+        use re "eval";
+        /$a$c$a/;
+        iseq $b, '14';
+
+        our $lex_a = 43;
+        our $lex_b = 17;
+        our $lex_c = 27;
+        my $lex_res = ($lex_b =~ qr/$lex_b(?{ $lex_c = $lex_a++ })/);
+
+        iseq $lex_res, 1;
+        iseq $lex_a, 44;
+        iseq $lex_c, 43;
+
+        no re "eval";
+        undef $@;
+        my $match = eval { /$a$c$a/ };
+        ok $@ && $@ =~ /Eval-group not allowed/ && !$match;
+        iseq $b, '14';
+     
+        $lex_a = 2;
+        $lex_a = 43;
+        $lex_b = 17;
+        $lex_c = 27;
+        $lex_res = ($lex_b =~ qr/17(?{ $lex_c = $lex_a++ })/);
+
+        iseq $lex_res, 1;
+        iseq $lex_a, 44;
+        iseq $lex_c, 43;
 
-    print "not " unless $x =~ /\P{InLatinExtendedA}/;
-    print "ok 594\n";
-}
+    }
 
-{
-    my $x = "\x80";
 
-    print "not " unless $x =~ /[\x80-\xff]/;
-    print "ok 595\n";
+    {
+        no warnings 'closure';
+        local $Message = '(?{ $var } refers to package vars';
+        package aa;
+        our $c = 2;
+        $::c = 3;
+        '' =~ /(?{ $c = 4 })/;
+        main::iseq $c, 4;
+        main::iseq $::c, 3;
+    }
 
-    print "not " unless $x =~ /[\x80-\x{100}]/;
-    print "ok 596\n";
 
-    print "not " if     $x =~ /[\x{100}]/;
-    print "ok 597\n";
+    {
+        must_die 'q(a:[b]:) =~ /[x[:foo:]]/',
+                 'POSIX class \[:[^:]+:\] unknown in regex',
+                 'POSIX class [: :] must have valid name';
+
+        for my $d (qw [= .]) {
+            must_die "/[[${d}foo${d}]]/",
+                     "\QPOSIX syntax [$d $d] is reserved for future extensions",
+                     "POSIX syntax [[$d $d]] is an error";
+        }
+    }
 
-    print "not " unless $x =~ /\p{InLatin1Supplement}/;
-    print "ok 598\n";
 
-    print "not " if    $x =~ /\P{InLatin1Supplement}/;
-    print "ok 599\n";
+    {
+        # test if failure of patterns returns empty list
+        local $Message = "Failed pattern returns empty list";
+        $_ = 'aaa';
+        @_ = /bbb/;
+        iseq "@_", "";
 
-    print "not " if     $x =~ /\p{InLatinExtendedA}/;
-    print "ok 600\n";
+        @_ = /bbb/g;
+        iseq "@_", "";
 
-    print "not " unless $x =~ /\P{InLatinExtendedA}/;
-    print "ok 601\n";
-}
+        @_ = /(bbb)/;
+        iseq "@_", "";
 
-{
-    my $x = "\xff";
+        @_ = /(bbb)/g;
+        iseq "@_", "";
+    }
 
-    print "not " unless $x =~ /[\x80-\xff]/;
-    print "ok 602\n";
+    
+    {
+        local $Message = '@- and @+ tests';
+
+        /a(?=.$)/;
+        iseq $#+, 0;
+        iseq $#-, 0;
+        iseq $+ [0], 2;
+        iseq $- [0], 1;
+        ok !defined $+ [1] && !defined $- [1] &&
+           !defined $+ [2] && !defined $- [2];
+
+        /a(a)(a)/;
+        iseq $#+, 2;
+        iseq $#-, 2;
+        iseq $+ [0], 3;
+        iseq $- [0], 0;
+        iseq $+ [1], 2;
+        iseq $- [1], 1;
+        iseq $+ [2], 3;
+        iseq $- [2], 2;
+        ok !defined $+ [3] && !defined $- [3] &&
+           !defined $+ [4] && !defined $- [4];
+
+
+        /.(a)(b)?(a)/;
+        iseq $#+, 3;
+        iseq $#-, 3;
+        iseq $+ [1], 2;
+        iseq $- [1], 1;
+        iseq $+ [3], 3;
+        iseq $- [3], 2;
+        ok !defined $+ [2] && !defined $- [2] &&
+           !defined $+ [4] && !defined $- [4];
+
+
+        /.(a)/;
+        iseq $#+, 1;
+        iseq $#-, 1;
+        iseq $+ [0], 2;
+        iseq $- [0], 0;
+        iseq $+ [1], 2;
+        iseq $- [1], 1;
+        ok !defined $+ [2] && !defined $- [2] &&
+           !defined $+ [3] && !defined $- [3];
+
+        /.(a)(ba*)?/;
+        iseq $#+, 2;
+        iseq $#-, 1;
+    }
 
-    print "not " unless $x =~ /[\x80-\x{100}]/;
-    print "ok 603\n";
 
-    print "not " if     $x =~ /[\x{100}]/;
-    print "ok 604\n";
+    {
+        local $DiePattern = '^Modification of a read-only value attempted';
+        local $Message    = 'Elements of @- and @+ are read-only';
+        must_die '$+[0] = 13';
+        must_die '$-[0] = 13';
+        must_die '@+ = (7, 6, 5)';
+        must_die '@- = qw (foo bar)';
+    }
 
-    # the next two tests must be ignored on EBCDIC
-    print "not " unless $x =~ /\p{InLatin1Supplement}/ or ord("A") == 193;
-    print "ok 605\n";
 
-    print "not " if     $x =~ /\P{InLatin1Supplement}/ and ord("A") != 193;
-    print "ok 606\n";
+    {
+        local $Message = '\G testing';
+        $_ = 'aaa';
+        pos = 1;
+        my @a = /\Ga/g;
+        iseq "@a", "a a";
+
+        my $str = 'abcde';
+        pos $str = 2;
+        ok $str !~ /^\G/;
+        ok $str !~ /^.\G/;
+        ok $str =~ /^..\G/;
+        ok $str !~ /^...\G/;
+        ok $str =~ /\G../ && $& eq 'cd';
+
+        local $TODO = $running_as_thread;
+        ok $str =~ /.\G./ && $& eq 'bc';
+    }
 
-    print "not " if     $x =~ /\p{InLatinExtendedA}/;
-    print "ok 607\n";
 
-    print "not " unless $x =~ /\P{InLatinExtendedA}/;
-    print "ok 608\n";
-}
+    {
+        local $Message = 'pos inside (?{ })';
+        my $str = 'abcde';
+        our ($foo, $bar);
+        ok $str =~ /b(?{$foo = $_; $bar = pos})c/;
+        iseq $foo, $str;
+        iseq $bar, 2;
+        ok !defined pos ($str);
+
+        undef $foo;
+        undef $bar;
+        pos $str = undef;
+        ok $str =~ /b(?{$foo = $_; $bar = pos})c/g;
+        iseq $foo, $str;
+        iseq $bar, 2;
+        iseq pos ($str), 3;
+
+        $_ = $str;
+        undef $foo;
+        undef $bar;
+        ok /b(?{$foo = $_; $bar = pos})c/;
+        iseq $foo, $str;
+        iseq $bar, 2;
+
+        undef $foo;
+        undef $bar;
+        ok /b(?{$foo = $_; $bar = pos})c/g;
+        iseq $foo, $str;
+        iseq $bar, 2;
+        iseq pos, 3;
+
+        undef $foo;
+        undef $bar;
+        pos = undef;
+        1 while /b(?{$foo = $_; $bar = pos})c/g;
+        iseq $foo, $str;
+        iseq $bar, 2;
+        ok !defined pos;
+
+        undef $foo;
+        undef $bar;
+        $_ = 'abcde|abcde';
+        ok s/b(?{$foo = $_; $bar = pos})c/x/g;
+        iseq $foo, 'abcde|abcde';
+        iseq $bar, 8;
+        iseq $_, 'axde|axde';
+
+        # List context:
+        $_ = 'abcde|abcde';
+        our @res;
+        () = /([ace]).(?{push @res, $1,$2})([ce])(?{push @res, $1,$2})/g;
+        @res = map {defined $_ ? "'$_'" : 'undef'} @res;
+        iseq "@res", "'a' undef 'a' 'c' 'e' undef 'a' undef 'a' 'c'";
+
+        @res = ();
+        () = /([ace]).(?{push @res, $`,$&,$'})([ce])(?{push @res, $`,$&,$'})/g;
+        @res = map {defined $_ ? "'$_'" : 'undef'} @res;
+        iseq "@res", "'' 'ab' 'cde|abcde' " .
+                     "'' 'abc' 'de|abcde' " .
+                     "'abcd' 'e|' 'abcde' " .
+                     "'abcde|' 'ab' 'cde' " .
+                     "'abcde|' 'abc' 'de'" ;
+    }
 
-{
-    my $x = "\x{100}";
 
-    print "not " if     $x =~ /[\x80-\xff]/;
-    print "ok 609\n";
+    {
+        local $Message = '\G anchor checks';
+        my $foo = 'aabbccddeeffgg';
+        pos ($foo) = 1;
+        {
+            local $TODO = $running_as_thread;
+            no warnings 'uninitialized';
+            ok $foo =~ /.\G(..)/g;
+            iseq $1, 'ab';
 
-    print "not " unless $x =~ /[\x80-\x{100}]/;
-    print "ok 610\n";
+            pos ($foo) += 1;
+            ok $foo =~ /.\G(..)/g;
+            iseq $1, 'cc';
 
-    print "not " unless $x =~ /[\x{100}]/;
-    print "ok 611\n";
+            pos ($foo) += 1;
+            ok $foo =~ /.\G(..)/g;
+            iseq $1, 'de';
 
-    print "not " if     $x =~ /\p{InLatin1Supplement}/;
-    print "ok 612\n";
+            ok $foo =~ /\Gef/g;
+        }
 
-    print "not " unless $x =~ /\P{InLatin1Supplement}/;
-    print "ok 613\n";
+        undef pos $foo;
+        ok $foo =~ /\G(..)/g;
+        iseq $1, 'aa';
 
-    print "not " unless $x =~ /\p{InLatinExtendedA}/;
-    print "ok 614\n";
+        ok $foo =~ /\G(..)/g;
+        iseq $1, 'bb';
 
-    print "not " if     $x =~ /\P{InLatinExtendedA}/;
-    print "ok 615\n";
-}
+        pos ($foo) = 5;
+        ok $foo =~ /\G(..)/g;
+        iseq $1, 'cd';
+    }
 
-{
-    # from japhy
-    my $w;
-    use warnings;    
-    local $SIG{__WARN__} = sub { $w .= shift };
-
-    $w = "";
-    eval 'qr/(?c)/';
-    print "not " if $w !~ /^Useless \(\?c\)/;
-    print "ok 616\n";
-
-    $w = "";
-    eval 'qr/(?-c)/';
-    print "not " if $w !~ /^Useless \(\?-c\)/;
-    print "ok 617\n";
-
-    $w = "";
-    eval 'qr/(?g)/';
-    print "not " if $w !~ /^Useless \(\?g\)/;
-    print "ok 618\n";
-
-    $w = "";
-    eval 'qr/(?-g)/';
-    print "not " if $w !~ /^Useless \(\?-g\)/;
-    print "ok 619\n";
-
-    $w = "";
-    eval 'qr/(?o)/';
-    print "not " if $w !~ /^Useless \(\?o\)/;
-    print "ok 620\n";
-
-    $w = "";
-    eval 'qr/(?-o)/';
-    print "not " if $w !~ /^Useless \(\?-o\)/;
-    print "ok 621\n";
-
-    # now test multi-error regexes
-
-    $w = "";
-    eval 'qr/(?g-o)/';
-    print "not " if $w !~ /^Useless \(\?g\).*\nUseless \(\?-o\)/;
-    print "ok 622\n";
-
-    $w = "";
-    eval 'qr/(?g-c)/';
-    print "not " if $w !~ /^Useless \(\?g\).*\nUseless \(\?-c\)/;
-    print "ok 623\n";
-
-    $w = "";
-    eval 'qr/(?o-cg)/';  # (?c) means (?g) error won't be thrown
-    print "not " if $w !~ /^Useless \(\?o\).*\nUseless \(\?-c\)/;
-    print "ok 624\n";
-
-    $w = "";
-    eval 'qr/(?ogc)/';
-    print "not " if $w !~ /^Useless \(\?o\).*\nUseless \(\?g\).*\nUseless \(\?c\)/;
-    print "ok 625\n";
-}
 
-# More Unicode "class" tests
+    {
+        $_ = '123x123';
+        my @res = /(\d*|x)/g;
+        local $" = '|';
+        iseq "@res", "123||x|123|", "0 match in alternation";
+    }
 
-{
-    use charnames ':full';
 
-    print "not " unless "\N{LATIN CAPITAL LETTER A}" =~ /\p{InBasicLatin}/;
-    print "ok 626\n";
+    {
+        local $Message = "Match against temporaries (created via pp_helem())" .
+                         " is safe";
+        ok {foo => "bar\n" . $^X} -> {foo} =~ /^(.*)\n/g;
+        iseq $1, "bar";
+    }
 
-    print "not " unless "\N{LATIN CAPITAL LETTER A WITH GRAVE}" =~ /\p{InLatin1Supplement}/;
-    print "ok 627\n";
 
-    print "not " unless "\N{LATIN CAPITAL LETTER A WITH MACRON}" =~ /\p{InLatinExtendedA}/;
-    print "ok 628\n";
+    {
+        local $Message = 'package $i inside (?{ }), ' .
+                         'saved substrings and changing $_';
+        our @a = qw [foo bar];
+        our @b = ();
+        s/(\w)(?{push @b, $1})/,$1,/g for @a;
+        iseq "@b", "f o o b a r";
+        iseq "@a", ",f,,o,,o, ,b,,a,,r,";
+
+        local $Message = 'lexical $i inside (?{ }), ' .
+                         'saved substrings and changing $_';
+        no warnings 'closure';
+        my @c = qw [foo bar];
+        my @d = ();
+        s/(\w)(?{push @d, $1})/,$1,/g for @c;
+        iseq "@d", "f o o b a r";
+        iseq "@c", ",f,,o,,o, ,b,,a,,r,";
+    }
 
-    print "not " unless "\N{LATIN SMALL LETTER B WITH STROKE}" =~ /\p{InLatinExtendedB}/;
-    print "ok 629\n";
 
-    print "not " unless "\N{KATAKANA LETTER SMALL A}" =~ /\p{InKatakana}/;
-    print "ok 630\n";
-}
+    {
+        local $Message = 'Brackets';
+        our $brackets;
+        $brackets = qr {
+            {  (?> [^{}]+ | (??{ $brackets }) )* }
+        }x;
+
+        ok "{{}" =~ $brackets;
+        iseq $&, "{}";
+        ok "something { long { and } hairy" =~ $brackets;
+        iseq $&, "{ and }";
+        ok "something { long { and } hairy" =~ m/((??{ $brackets }))/;
+        iseq $&, "{ and }";
+    }
 
-$_ = "foo";
-
-eval <<"EOT"; die if $@;
-  /f
-   o\r
-   o
-   \$
-  /x && print "ok 631\n";
-EOT
-
-eval <<"EOT"; die if $@;
-  /f
-   o
-   o
-   \$\r
-  /x && print "ok 632\n";
-EOT
-
-#test /o feature
-sub test_o { $_[0] =~/$_[1]/o; return $1}
-if(test_o('abc','(.)..') eq 'a') {
-    print "ok 633\n";
-} else {
-    print "not ok 633\n";
-}
-if(test_o('abc','..(.)') eq 'a') {
-    print "ok 634\n";
-} else {
-    print "not ok 634\n";
-}
 
-# 635..639: ID 20010619.003 (only the space character is
-# supposed to be [:print:], not the whole isprint()).
-
-print "not " if "\n"     =~ /[[:print:]]/;
-print "ok 635\n";
-
-print "not " if "\t"     =~ /[[:print:]]/;
-print "ok 636\n";
-
-# Amazingly vertical tabulator is the same in ASCII and EBCDIC.
-print "not " if "\014"  =~ /[[:print:]]/;
-print "ok 637\n";
-
-print "not " if "\r"    =~ /[[:print:]]/;
-print "ok 638\n";
-
-print "not " unless " " =~ /[[:print:]]/;
-print "ok 639\n";
-
-##
-## Test basic $^N usage outside of a regex
-##
-$x = "abcdef";
-$T="ok 640\n";if ($x =~ /cde/ and not defined $^N)         {print $T} else {print "not $T"};
-$T="ok 641\n";if ($x =~ /(cde)/          and $^N eq "cde") {print $T} else {print "not $T"};
-$T="ok 642\n";if ($x =~ /(c)(d)(e)/      and $^N eq   "e") {print $T} else {print "not $T"};
-$T="ok 643\n";if ($x =~ /(c(d)e)/        and $^N eq "cde") {print $T} else {print "not $T"};
-$T="ok 644\n";if ($x =~ /(foo)|(c(d)e)/  and $^N eq "cde") {print $T} else {print "not $T"};
-$T="ok 645\n";if ($x =~ /(c(d)e)|(foo)/  and $^N eq "cde") {print $T} else {print "not $T"};
-$T="ok 646\n";if ($x =~ /(c(d)e)|(abc)/  and $^N eq "abc") {print $T} else {print "not $T"};
-$T="ok 647\n";if ($x =~ /(c(d)e)|(abc)x/ and $^N eq "cde") {print $T} else {print "not $T"};
-$T="ok 648\n";if ($x =~ /(c(d)e)(abc)?/  and $^N eq "cde") {print $T} else {print "not $T"};
-$T="ok 649\n";if ($x =~ /(?:c(d)e)/      and $^N eq  "d" ) {print $T} else {print "not $T"};
-$T="ok 650\n";if ($x =~ /(?:c(d)e)(?:f)/ and $^N eq  "d" ) {print $T} else {print "not $T"};
-$T="ok 651\n";if ($x =~ /(?:([abc])|([def]))*/ and $^N eq  "f" ){print $T} else {print "not $T"};
-$T="ok 652\n";if ($x =~ /(?:([ace])|([bdf]))*/ and $^N eq  "f" ){print $T} else {print "not $T"};
-$T="ok 653\n";if ($x =~ /(([ace])|([bd]))*/    and $^N eq  "e" ){print $T} else {print "not $T"};
-{
- $T="ok 654\n";if($x =~ /(([ace])|([bdf]))*/   and $^N eq  "f" ){print $T} else {print "not $T"};
-}
-## test to see if $^N is automatically localized -- it should now
-## have the value set in test 653
-$T="ok 655\n";if ($^N eq  "e" ){print $T} else {print "not $T"};
-
-##
-## Now test inside (?{...})
-##
-$T="ok 656\n";if ($x =~ /a([abc])(?{$y=$^N})c/      and $y eq "b" ){print $T} else {print "not $T"};
-$T="ok 657\n";if ($x =~ /a([abc]+)(?{$y=$^N})d/     and $y eq "bc"){print $T} else {print "not $T"};
-$T="ok 658\n";if ($x =~ /a([abcdefg]+)(?{$y=$^N})d/ and $y eq "bc"){print $T} else {print "not $T"};
-$T="ok 659\n";if ($x =~ /(a([abcdefg]+)(?{$y=$^N})d)(?{$z=$^N})e/ and $y eq "bc" and $z eq "abcd")
-              {print $T} else {print "not $T"};
-$T="ok 660\n";if ($x =~ /(a([abcdefg]+)(?{$y=$^N})de)(?{$z=$^N})/ and $y eq "bc" and $z eq "abcde")
-              {print $T} else {print "not $T"};
-
-# Test the Unicode script classes
-
-print "not " unless chr(0x100) =~ /\p{IsLatin}/; # outside Latin-1
-print "ok 661\n";
-
-print "not " unless chr(0x212b) =~ /\p{IsLatin}/; # Angstrom sign, very outside
-print "ok 662\n";
-
-print "not " unless chr(0x5d0) =~ /\p{IsHebrew}/; # inside InHebrew
-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";
-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";
-
-print "not " unless chr(0x386) =~ /\p{IsGreek}/; # singleton
-print "ok 667\n";
-
-print "not " unless chr(0x387) =~ /\P{IsGreek}/; # not there
-print "ok 668\n";
-
-print "not " unless chr(0x388) =~ /\p{IsGreek}/; # range
-print "ok 669\n";
-
-print "not " unless chr(0x38a) =~ /\p{IsGreek}/; # range
-print "ok 670\n";
-
-print "not " unless chr(0x38b) =~ /\P{IsGreek}/; # not there
-print "ok 671\n";
-
-print "not " unless chr(0x38c) =~ /\p{IsGreek}/; # singleton
-print "ok 672\n";
-
-if (ord("A") == 65) {
-##
-## Test [:cntrl:]...
-##
-## Should probably put in tests for all the POSIX stuff, but not sure how to
-## guarantee a specific locale......
-##
-    $AllBytes = join('', map { chr($_) } 0..255);
-    ($x = $AllBytes) =~ s/[[:cntrl:]]//g;
-    if ($x ne join('', map { chr($_) } 0x20..0x7E, 0x80..0xFF)) {
-	print "not ";
-    }
-    print "ok 673\n";
-
-    ($x = $AllBytes) =~ s/[^[:cntrl:]]//g;
-    if ($x ne join('', map { chr($_) } 0..0x1F, 0x7F)) { print "not " }
-    print "ok 674\n";
-} else {
-    print "ok $_ # Skip: EBCDIC\n" for 673..674;
-}
+    {
+        $_ = "a-a\nxbb";
+        pos = 1;
+        nok m/^-.*bb/mg, '$_ = "a-a\nxbb"; m/^-.*bb/mg';
+    }
 
-# With /s modifier UTF8 chars were interpreted as bytes
-{
-    my $a = "Hello \x{263A} World";
-    
-    my @a = ($a =~ /./gs);
-    
-    print "not " unless $#a == 12;
-    print "ok 675\n";
-}
 
-@a = ("foo\nbar" =~ /./g);
-print "ok 676\n" if @a == 6 && "@a" eq "f o o b a r";
+    {
+        local $Message = '\G anchor checks';
+        my $text = "aaXbXcc";
+        pos ($text) = 0;
+        ok $text !~ /\GXb*X/g;
+    }
 
-@a = ("foo\nbar" =~ /./gs);
-print "ok 677\n" if @a == 7 && "@a" eq "f o o \n b a r";
 
-@a = ("foo\nbar" =~ /\C/g);
-print "ok 678\n" if @a == 7 && "@a" eq "f o o \n b a r";
+    {
+        $_ = "xA\n" x 500;
+        nok /^\s*A/m, '$_ = "xA\n" x 500; /^\s*A/m"';
 
-@a = ("foo\nbar" =~ /\C/gs);
-print "ok 679\n" if @a == 7 && "@a" eq "f o o \n b a r";
+        my $text = "abc dbf";
+        my @res = ($text =~ /.*?(b).*?\b/g);
+        iseq "@res", "b b", '\b is not special';
+    }
 
-@a = ("foo\n\x{100}bar" =~ /./g);
-print "ok 680\n" if @a == 7 && "@a" eq "f o o \x{100} b a r";
 
-@a = ("foo\n\x{100}bar" =~ /./gs);
-print "ok 681\n" if @a == 8 && "@a" eq "f o o \n \x{100} b a r";
+    {
+        local $Message = '\S, [\S], \s, [\s]';
+        my @a = map chr, 0 .. 255;
+        my @b = grep /\S/, @a;
+        my @c = grep /[^\s]/, @a;
+        iseq "@b", "@c";
+
+        @b = grep /\S/, @a;
+        @c = grep /[\S]/, @a;
+        iseq "@b", "@c";
+
+        @b = grep /\s/, @a;
+        @c = grep /[^\S]/, @a;
+        iseq "@b", "@c";
+
+        @b = grep /\s/, @a;
+        @c = grep /[\s]/, @a;
+        iseq "@b", "@c";
+    }
+    {
+        local $Message = '\D, [\D], \d, [\d]';
+        my @a = map chr, 0 .. 255;
+        my @b = grep /\D/, @a;
+        my @c = grep /[^\d]/, @a;
+        iseq "@b", "@c";
+
+        @b = grep /\D/, @a;
+        @c = grep /[\D]/, @a;
+        iseq "@b", "@c";
+
+        @b = grep /\d/, @a;
+        @c = grep /[^\D]/, @a;
+        iseq "@b", "@c";
+
+        @b = grep /\d/, @a;
+        @c = grep /[\d]/, @a;
+        iseq "@b", "@c";
+    }
+    {
+        local $Message = '\W, [\W], \w, [\w]';
+        my @a = map chr, 0 .. 255;
+        my @b = grep /\W/, @a;
+        my @c = grep /[^\w]/, @a;
+        iseq "@b", "@c";
+
+        @b = grep /\W/, @a;
+        @c = grep /[\W]/, @a;
+        iseq "@b", "@c";
+
+        @b = grep /\w/, @a;
+        @c = grep /[^\W]/, @a;
+        iseq "@b", "@c";
+
+        @b = grep /\w/, @a;
+        @c = grep /[\w]/, @a;
+        iseq "@b", "@c";
+    }
 
-($a, $b) = map { chr } ord('A') == 65 ? (0xc4, 0x80) : (0x8c, 0x41);
 
-@a = ("foo\n\x{100}bar" =~ /\C/g);
-print "ok 682\n" if @a == 9 && "@a" eq "f o o \n $a $b b a r";
+    {
+        # see if backtracking optimization works correctly
+        local $Message = 'Backtrack optimization';
+        ok "\n\n" =~ /\n   $ \n/x;
+        ok "\n\n" =~ /\n*  $ \n/x;
+        ok "\n\n" =~ /\n+  $ \n/x;
+        ok "\n\n" =~ /\n?  $ \n/x;
+        ok "\n\n" =~ /\n*? $ \n/x;
+        ok "\n\n" =~ /\n+? $ \n/x;
+        ok "\n\n" =~ /\n?? $ \n/x;
+        ok "\n\n" !~ /\n*+ $ \n/x;
+        ok "\n\n" !~ /\n++ $ \n/x;
+        ok "\n\n" =~ /\n?+ $ \n/x;
+    }
 
-@a = ("foo\n\x{100}bar" =~ /\C/gs);
-print "ok 683\n" if @a == 9 && "@a" eq "f o o \n $a $b b a r";
 
-{
-    # [ID 20010814.004] pos() doesn't work when using =~m// in list context
-    $_ = "ababacadaea";
-    $a = join ":", /b./gc;
-    $b = join ":", /a./gc;
-    $c = pos;
-    print "$a $b $c" eq 'ba:ba ad:ae 10' ? "ok 684\n" : "not ok 684\t# $a $b $c\n";
-}
+    {
+        package S;
+        use overload '""' => sub {'Object S'};
+        sub new {bless []}
+     
+        local $Message  = "Ref stringification";
+      ::ok do { \my $v} =~ /^SCALAR/,   "Scalar ref stringification";
+      ::ok do {\\my $v} =~ /^REF/,      "Ref ref stringification";
+      ::ok []           =~ /^ARRAY/,    "Array ref stringification";
+      ::ok {}           =~ /^HASH/,     "Hash ref stringification";
+      ::ok 'S' -> new   =~ /^Object S/, "Object stringification";
+    }
+
 
-{
-    # [ID 20010407.006] matching utf8 return values from functions does not work
+    {
+        local $Message = "Test result of match used as match";
+        ok 'a1b' =~ ('xyz' =~ /y/);
+        iseq $`, 'a';
+        ok 'a1b' =~ ('xyz' =~ /t/);
+        iseq $`, 'a';
+    }
 
-    package ID_20010407_006;
 
-    sub x {
-	"a\x{1234}";
+    {
+        local $Message = '"1" is not \s';
+        may_not_warn sub {ok ("1\n" x 102) !~ /^\s*\n/m};
     }
 
-    my $x = x;
-    my $y;
 
-    $x =~ /(..)/; $y = $1;
-    print "not " unless length($y) == 2 && $y eq $x;
-    print "ok 685\n";
+    {
+        local $Message = '\s, [[:space:]] and [[:blank:]]';
+        my %space = (spc   => " ",
+                     tab   => "\t",
+                     cr    => "\r",
+                     lf    => "\n",
+                     ff    => "\f",
+        # There's no \v but the vertical tabulator seems miraculously
+        # be 11 both in ASCII and EBCDIC.
+                     vt    => chr(11),
+                     false => "space");
+
+        my @space0 = sort grep {$space {$_} =~ /\s/         } keys %space;
+        my @space1 = sort grep {$space {$_} =~ /[[:space:]]/} keys %space;
+        my @space2 = sort grep {$space {$_} =~ /[[:blank:]]/} keys %space;
+
+        iseq "@space0", "cr ff lf spc tab";
+        iseq "@space1", "cr ff lf spc tab vt";
+        iseq "@space2", "spc tab";
+    }
 
-    x  =~ /(..)/; $y = $1;
-    print "not " unless length($y) == 2 && $y eq $x;
-    print "ok 686\n";
-}
 
+    {
+        local $BugId = '20000731.001';
+        ok "A \x{263a} B z C" =~ /A . B (??{ "z" }) C/,
+           "Match UTF-8 char in presense of (??{ })";
+    }
 
-$test = 687;
 
-# Force scalar context on the patern match
-sub ok ($;$) {
-    my($ok, $name) = @_;
+    {
+        local $BugId = '20001021.005';
+        no warnings 'uninitialized';
+        ok undef =~ /^([^\/]*)(.*)$/, "Used to cause a SEGV";
+    }
 
-    printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
-        ($name||$Message)."\tLine ".((caller)[2]);
 
-    printf "# Failed test at line %d\n", (caller)[2] unless $ok;
+  SKIP:
+    {
+        local $Message = '\C matches octet';
+        $_ = "a\x{100}b";
+        ok /(.)(\C)(\C)(.)/ or skip q [\C doesn't match], 4;
+        iseq $1, "a";
+        if ($IS_ASCII) {     # ASCII (or equivalent), should be UTF-8
+            iseq $2, "\xC4";
+            iseq $3, "\x80";
+        }
+        elsif ($IS_EBCDIC) { # EBCDIC (or equivalent), should be UTF-EBCDIC
+            iseq $2, "\x8C";
+            iseq $3, "\x41";
+        }
+        else {
+            SKIP: {
+                ok 0, "Unexpected platform", "ord ('A') = $ordA";
+                skip "Unexpected platform";
+            }
+        }
+        iseq $4, "b";
+    }
 
-    $test++;
-    return $ok;
-}
 
-{
-    # Check that \x## works. 5.6.1 and 5.005_03 fail some of these.
-    $x = "\x4e" . "E";
-    ok ($x =~ /^\x4EE$/, "Check only 2 bytes of hex are matched.");
+  SKIP:
+    {
+        local $Message = '\C matches octet';
+        $_ = "\x{100}";
+        ok /(\C)/g or skip q [\C doesn't match], 2;
+        if ($IS_ASCII) {
+            iseq $1, "\xC4";
+        }
+        elsif ($IS_EBCDIC) {
+            iseq $1, "\x8C";
+        }
+        else {
+            ok 0, "Unexpected platform", "ord ('A') = $ordA";
+        }
+        ok /(\C)/g or skip q [\C doesn't match];
+        if ($IS_ASCII) {
+            iseq $1, "\x80";
+        }
+        elsif ($IS_EBCDIC) {
+            iseq $1, "\x41";
+        }
+        else {
+            ok 0, "Unexpected platform", "ord ('A') = $ordA";
+        }
+    }
 
-    $x = "\x4e" . "i";
-    ok ($x =~ /^\x4Ei$/, "Check that invalid hex digit stops it (2)");
 
-    $x = "\x4" . "j";
-    ok ($x =~ /^\x4j$/,  "Check that invalid hex digit stops it (1)");
+    {
+        # Japhy -- added 03/03/2001
+        () = (my $str = "abc") =~ /(...)/;
+        $str = "def";
+        iseq $1, "abc", 'Changing subject does not modify $1';
+    }
 
-    $x = "\x0" . "k";
-    ok ($x =~ /^\xk$/,   "Check that invalid hex digit stops it (0)");
 
-    $x = "\x0" . "x";
-    ok ($x =~ /^\xx$/, "\\xx isn't to be treated as \\0");
+  SKIP:
+    {
+        # The trick is that in EBCDIC the explicit numeric range should
+        # match (as also in non-EBCDIC) but the explicit alphabetic range
+        # should not match.
+        ok "\x8e" =~ /[\x89-\x91]/, '"\x8e" =~ /[\x89-\x91]/';
+        ok "\xce" =~ /[\xc9-\xd1]/, '"\xce" =~ /[\xc9-\xd1]/';
+
+        skip "Not an EBCDIC platform", 2 unless ord ('i') == 0x89 &&
+                                                ord ('J') == 0xd1;
+
+        # In most places these tests would succeed since \x8e does not
+        # in most character sets match 'i' or 'j' nor would \xce match
+        # 'I' or 'J', but strictly speaking these tests are here for
+        # the good of EBCDIC, so let's test these only there.
+        nok "\x8e" !~ /[i-j]/, '"\x8e" !~ /[i-j]/';
+        nok "\xce" !~ /[I-J]/, '"\xce" !~ /[I-J]/';
+    }
 
-    $x = "\x0" . "xa";
-    ok ($x =~ /^\xxa$/, "\\xxa isn't to be treated as \\xa");
 
-    $x = "\x9" . "_b";
-    ok ($x =~ /^\x9_b$/, "\\x9_b isn't to be treated as \\x9b");
+    {
+        ok "\x{ab}"   =~ /\x{ab}/,   '"\x{ab}"   =~ /\x{ab}/  ';
+        ok "\x{abcd}" =~ /\x{abcd}/, '"\x{abcd}" =~ /\x{abcd}/';
+    }
 
-    print "# and now again in [] ranges\n";
 
-    $x = "\x4e" . "E";
-    ok ($x =~ /^[\x4EE]{2}$/, "Check only 2 bytes of hex are matched.");
+    {
+        local $Message = 'bug id 20001008.001';
+
+        my @x = ("stra\337e 138", "stra\337e 138");
+        for (@x) {
+            ok s/(\d+)\s*([\w\-]+)/$1 . uc $2/e;
+            ok my ($latin) = /^(.+)(?:\s+\d)/;
+            iseq $latin, "stra\337e";
+	    ok $latin =~ s/stra\337e/straße/;
+            #
+            # Previous code follows, but outcommented - there were no tests.
+            #
+            # $latin =~ s/stra\337e/straße/; # \303\237 after the 2nd a
+            # use utf8; # needed for the raw UTF-8
+            # $latin =~ s!(s)tr(?:aß|s+e)!$1tr.!; # \303\237 after the a
+        }
+    }
 
-    $x = "\x4e" . "i";
-    ok ($x =~ /^[\x4Ei]{2}$/, "Check that invalid hex digit stops it (2)");
 
-    $x = "\x4" . "j";
-    ok ($x =~ /^[\x4j]{2}$/,  "Check that invalid hex digit stops it (1)");
+    {
+        local $Message = 'Test \x escapes';
+        ok "ba\xd4c" =~ /([a\xd4]+)/ && $1 eq "a\xd4";
+        ok "ba\xd4c" =~ /([a\xd4]+)/ && $1 eq "a\x{d4}";
+        ok "ba\x{d4}c" =~ /([a\xd4]+)/ && $1 eq "a\x{d4}";
+        ok "ba\x{d4}c" =~ /([a\xd4]+)/ && $1 eq "a\xd4";
+        ok "ba\xd4c" =~ /([a\x{d4}]+)/ && $1 eq "a\xd4";
+        ok "ba\xd4c" =~ /([a\x{d4}]+)/ && $1 eq "a\x{d4}";
+        ok "ba\x{d4}c" =~ /([a\x{d4}]+)/ && $1 eq "a\x{d4}";
+        ok "ba\x{d4}c" =~ /([a\x{d4}]+)/ && $1 eq "a\xd4";
+    }
 
-    $x = "\x0" . "k";
-    ok ($x =~ /^[\xk]{2}$/,   "Check that invalid hex digit stops it (0)");
 
-    $x = "\x0" . "x";
-    ok ($x =~ /^[\xx]{2}$/, "\\xx isn't to be treated as \\0");
+    {
+        local $BugId   = '20001028.003';
+
+        # Fist half of the bug.
+        local $Message = 'HEBREW ACCENT QADMA matched by .*';
+        my $X = chr (1448);
+        ok my ($Y) = $X =~ /(.*)/;
+        iseq $Y, v1448;
+        iseq length ($Y), 1;
+
+        # Second half of the bug.
+        $Message = 'HEBREW ACCENT QADMA in replacement';
+        $X = '';
+        $X =~ s/^/chr(1488)/e;
+        iseq length $X, 1;
+        iseq ord ($X), 1488;
+    }
 
-    $x = "\x0" . "xa";
-    ok ($x =~ /^[\xxa]{3}$/, "\\xxa isn't to be treated as \\xa");
 
-    $x = "\x9" . "_b";
-    ok ($x =~ /^[\x9_b]{3}$/, "\\x9_b isn't to be treated as \\x9b");
+    {   
+        local $BugId   = '20001108.001';
+        local $Message = 'Repeated s///';
+        my $X = "Szab\x{f3},Bal\x{e1}zs";
+        my $Y = $X;
+        $Y =~ s/(B)/$1/ for 0 .. 3;
+        iseq $Y, $X;
+        iseq $X, "Szab\x{f3},Bal\x{e1}zs";
+    }
 
-}
 
-{
-    # Check that \x{##} works. 5.6.1 fails quite a few of these.
+    {
+        local $BugId   = '20000517.001';
+        local $Message = 's/// on UTF-8 string';
+        my $x = "\x{100}A";
+        $x =~ s/A/B/;
+        iseq $x, "\x{100}B";
+        iseq length $x, 2;
+    }
 
-    $x = "\x9b";
-    ok ($x =~ /^\x{9_b}$/, "\\x{9_b} is to be treated as \\x9b");
 
-    $x = "\x9b" . "y";
-    ok ($x =~ /^\x{9_b}y$/, "\\x{9_b} is to be treated as \\x9b (again)");
+    {
+        local $BugId   = '20001230.002';
+        local $Message = '\C and É';
+        ok "École" =~ /^\C\C(.)/ && $1 eq 'c';
+        ok "École" =~ /^\C\C(c)/;
+    }
 
-    $x = "\x9b" . "y";
-    ok ($x =~ /^\x{9b_}y$/, "\\x{9b_} is to be treated as \\x9b");
 
-    $x = "\x9b" . "y";
-    ok ($x =~ /^\x{9_bq}y$/, "\\x{9_bc} is to be treated as \\x9b");
+  SKIP:
+    {
+        local $Message = 'Match code points > 255';
+        $_ = "abc\x{100}\x{200}\x{300}\x{380}\x{400}defg";
+        ok /(.\x{300})./ or skip "No match", 4;
+        ok $` eq "abc\x{100}"            && length ($`) == 4;
+        ok $& eq "\x{200}\x{300}\x{380}" && length ($&) == 3;
+        ok $' eq "\x{400}defg"           && length ($') == 5;
+        ok $1 eq "\x{200}\x{300}"        && length ($1) == 2;
+    }
 
-    $x = "\x0" . "y";
-    ok ($x =~ /^\x{x9b}y$/, "\\x{x9b} is to be treated as \\x0");
 
-    $x = "\x0" . "y";
-    ok ($x =~ /^\x{0x9b}y$/, "\\x{0x9b} is to be treated as \\x0");
+    {
+        # The original bug report had 'no utf8' here but that was irrelevant.
+        local $BugId   = '20010306.008';
+        local $Message = "Don't dump core";
+        my $a = "a\x{1234}";
+        ok $a =~ m/\w/;  # used to core dump.
+    }
 
-    $x = "\x9b" . "y";
-    ok ($x =~ /^\x{09b}y$/, "\\x{09b} is to be treated as \\x9b");
 
-    print "# and now again in [] ranges\n";
+    {
+        local $BugId = '20010410.006';
+        local $Message = '/g in scalar context';
+        for my $rx ('/(.*?)\{(.*?)\}/csg',
+		    '/(.*?)\{(.*?)\}/cg',
+		    '/(.*?)\{(.*?)\}/sg',
+		    '/(.*?)\{(.*?)\}/g',
+		    '/(.+?)\{(.+?)\}/csg',) {
+            my $i = 0;
+            my $input = "a{b}c{d}";
+            eval <<"            --";
+                while (eval \$input =~ $rx) {
+                    \$i ++;
+                }
+            --
+            iseq $i, 2;
+        }
+    }
 
-    $x = "\x9b";
-    ok ($x =~ /^[\x{9_b}]$/, "\\x{9_b} is to be treated as \\x9b");
 
-    $x = "\x9b" . "y";
-    ok ($x =~ /^[\x{9_b}y]{2}$/, "\\x{9_b} is to be treated as \\x9b (again)");
+    {
+        my $x = "\x{10FFFD}";
+        $x =~ s/(.)/$1/g;
+        ok ord($x) == 0x10FFFD && length($x) == 1, "From Robin Houston";
+    }
 
-    $x = "\x9b" . "y";
-    ok ($x =~ /^[\x{9b_}y]{2}$/, "\\x{9b_} is to be treated as \\x9b");
 
-    $x = "\x9b" . "y";
-    ok ($x =~ /^[\x{9_bq}y]{2}$/, "\\x{9_bc} is to be treated as \\x9b");
+    {
+        my %d = (
+            "7f" => [0, 0, 0],
+            "80" => [1, 1, 0],
+            "ff" => [1, 1, 0],
+           "100" => [0, 1, 1],
+        );
+      SKIP:
+        while (my ($code, $match) = each %d) {
+            local $Message = "Properties of \\x$code";
+            my $char = eval qq ["\\x{$code}"];
+            my $i = 0;
+            ok (($char =~ /[\x80-\xff]/)            xor !$$match [$i ++]);
+            ok (($char =~ /[\x80-\x{100}]/)         xor !$$match [$i ++]);
+            ok (($char =~ /[\x{100}]/)              xor !$$match [$i ++]);
+        }
+    }
 
-    $x = "\x0" . "y";
-    ok ($x =~ /^[\x{x9b}y]{2}$/, "\\x{x9b} is to be treated as \\x0");
 
-    $x = "\x0" . "y";
-    ok ($x =~ /^[\x{0x9b}y]{2}$/, "\\x{0x9b} is to be treated as \\x0");
+    {
+        # From Japhy
+        local $Message;
+        must_warn 'qr/(?c)/',    '^Useless \(\?c\)';
+        must_warn 'qr/(?-c)/',   '^Useless \(\?-c\)';
+        must_warn 'qr/(?g)/',    '^Useless \(\?g\)';
+        must_warn 'qr/(?-g)/',   '^Useless \(\?-g\)';
+        must_warn 'qr/(?o)/',    '^Useless \(\?o\)';
+        must_warn 'qr/(?-o)/',   '^Useless \(\?-o\)';
+
+        # Now test multi-error regexes
+        must_warn 'qr/(?g-o)/',  '^Useless \(\?g\).*\nUseless \(\?-o\)';
+        must_warn 'qr/(?g-c)/',  '^Useless \(\?g\).*\nUseless \(\?-c\)';
+        # (?c) means (?g) error won't be thrown
+        must_warn 'qr/(?o-cg)/', '^Useless \(\?o\).*\nUseless \(\?-c\)';
+        must_warn 'qr/(?ogc)/',  '^Useless \(\?o\).*\nUseless \(\?g\).*\n' .
+                                  'Useless \(\?c\)';
+    }
 
-    $x = "\x9b" . "y";
-    ok ($x =~ /^[\x{09b}y]{2}$/, "\\x{09b} is to be treated as \\x9b");
-}
 
-{
-    # high bit bug -- japhy
-    my $x = "ab\200d";
-    $x =~ /.*?\200/ or print "not ";
-    print "ok 715\n";
-}
+    {
+        local $Message = "/x tests";
+        $_ = "foo";
+        eval_ok <<"        --";
+          /f
+           o\r
+           o
+           \$
+          /x
+        --
+        eval_ok <<"        --";
+          /f
+           o
+           o
+           \$\r
+          /x
+        --
+    }
 
-print "# some Unicode properties\n";
 
-{
-    # Dashes, underbars, case.
-    print "not " unless "\x80" =~ /\p{in-latin1_SUPPLEMENT}/;
-    print "ok 716\n";
+    {
+        local $Message = "/o feature";
+        sub test_o {$_ [0] =~ /$_[1]/o; return $1}
+        iseq test_o ('abc', '(.)..'), 'a';
+        iseq test_o ('abc', '..(.)'), 'a';
+    }
 
-    # Complement, leading and trailing whitespace.
-    print "not " unless "\x80" =~ /\P{  ^  In Latin 1 Supplement  }/;
-    print "ok 717\n";
 
-    # No ^In, dashes, case, dash, any intervening (word-break) whitespace.
-    # (well, newlines don't work...)
-    print "not " unless "\x80" =~ /\p{latin-1   supplement}/;
-    print "ok 718\n";
-}
+    {
+        local $BugId = "20010619.003";
+        # Amazingly vertical tabulator is the same in ASCII and EBCDIC.
+        for ("\n", "\t", "\014", "\r") {
+            ok !/[[:print:]]/, "'$_' not in [[:print:]]";
+        }
+        for (" ") {
+            ok  /[[:print:]]/, "'$_' in [[:print:]]";
+        }
+    }
 
-{
-    print "not " unless "a" =~ /\pL/;
-    print "ok 719\n";
 
-    print "not " unless "a" =~ /\p{IsLl}/;
-    print "ok 720\n";
+    {
+        # Test basic $^N usage outside of a regex
+        local $Message = '$^N usage outside of a regex';
+        my $x = "abcdef";
+        ok ($x =~ /cde/                  and !defined $^N);
+        ok ($x =~ /(cde)/                and $^N eq "cde");
+        ok ($x =~ /(c)(d)(e)/            and $^N eq   "e");
+        ok ($x =~ /(c(d)e)/              and $^N eq "cde");
+        ok ($x =~ /(foo)|(c(d)e)/        and $^N eq "cde");
+        ok ($x =~ /(c(d)e)|(foo)/        and $^N eq "cde");
+        ok ($x =~ /(c(d)e)|(abc)/        and $^N eq "abc");
+        ok ($x =~ /(c(d)e)|(abc)x/       and $^N eq "cde");
+        ok ($x =~ /(c(d)e)(abc)?/        and $^N eq "cde");
+        ok ($x =~ /(?:c(d)e)/            and $^N eq   "d");
+        ok ($x =~ /(?:c(d)e)(?:f)/       and $^N eq   "d");
+        ok ($x =~ /(?:([abc])|([def]))*/ and $^N eq   "f");
+        ok ($x =~ /(?:([ace])|([bdf]))*/ and $^N eq   "f");
+        ok ($x =~ /(([ace])|([bd]))*/    and $^N eq   "e");
+       {ok ($x =~ /(([ace])|([bdf]))*/   and $^N eq   "f");}
+        ## Test to see if $^N is automatically localized -- it should now
+        ## have the value set in the previous test.
+        iseq $^N, "e", '$^N is automatically localized';
+
+        # Now test inside (?{ ... })
+        local $Message = '$^N usage inside (?{ ... })';
+        our ($y, $z);
+        ok ($x =~ /a([abc])(?{$y=$^N})c/                    and $y eq  "b");
+        ok ($x =~ /a([abc]+)(?{$y=$^N})d/                   and $y eq  "bc");
+        ok ($x =~ /a([abcdefg]+)(?{$y=$^N})d/               and $y eq  "bc");
+        ok ($x =~ /(a([abcdefg]+)(?{$y=$^N})d)(?{$z=$^N})e/ and $y eq  "bc"
+                                                            and $z eq "abcd");
+        ok ($x =~ /(a([abcdefg]+)(?{$y=$^N})de)(?{$z=$^N})/ and $y eq  "bc"
+                                                            and $z eq "abcde");
 
-    print "not " if     "a" =~ /\p{IsLu}/;
-    print "ok 721\n";
+    }
 
-    print "not " unless "a" =~ /\p{Ll}/;
-    print "ok 722\n";
 
-    print "not " if     "a" =~ /\p{Lu}/;
-    print "ok 723\n";
+  SKIP:
+    {
+        ## Should probably put in tests for all the POSIX stuff,
+        ## but not sure how to guarantee a specific locale......
 
-    print "not " unless "A" =~ /\pL/;
-    print "ok 724\n";
+        skip "Not an ASCII platform", 2 unless $IS_ASCII;
+        local $Message = 'Test [[:cntrl:]]';
+        my $AllBytes = join "" => map {chr} 0 .. 255;
+        (my $x = $AllBytes) =~ s/[[:cntrl:]]//g;
+        iseq $x, join "", map {chr} 0x20 .. 0x7E, 0x80 .. 0xFF;
 
-    print "not " unless "A" =~ /\p{IsLu}/;
-    print "ok 725\n";
+        ($x = $AllBytes) =~ s/[^[:cntrl:]]//g;
+        iseq $x, join "", map {chr} 0x00 .. 0x1F, 0x7F;
+    }
 
-    print "not " if     "A" =~ /\p{IsLl}/;
-    print "ok 726\n";
 
-    print "not " unless "A" =~ /\p{Lu}/;
-    print "ok 727\n";
+    {
+        # With /s modifier UTF8 chars were interpreted as bytes
+        local $Message = "UTF-8 chars aren't bytes";
+        my $a = "Hello \x{263A} World";
+        my @a = ($a =~ /./gs);
+        iseq $#a, 12;
+    }
 
-    print "not " if     "A" =~ /\p{Ll}/;
-    print "ok 728\n";
 
-    print "not " if     "a" =~ /\PL/;
-    print "ok 729\n";
+    {
+        local $Message = '. matches \n with /s';
+        my $str1 = "foo\nbar";
+        my $str2 = "foo\n\x{100}bar";
+        my ($a, $b) = map {chr} $IS_ASCII ? (0xc4, 0x80) : (0x8c, 0x41);
+        my @a;
+        @a = $str1 =~ /./g;   iseq @a, 6; iseq "@a", "f o o b a r";
+        @a = $str1 =~ /./gs;  iseq @a, 7; iseq "@a", "f o o \n b a r";
+        @a = $str1 =~ /\C/g;  iseq @a, 7; iseq "@a", "f o o \n b a r";
+        @a = $str1 =~ /\C/gs; iseq @a, 7; iseq "@a", "f o o \n b a r";
+        @a = $str2 =~ /./g;   iseq @a, 7; iseq "@a", "f o o \x{100} b a r";
+        @a = $str2 =~ /./gs;  iseq @a, 8; iseq "@a", "f o o \n \x{100} b a r";
+        @a = $str2 =~ /\C/g;  iseq @a, 9; iseq "@a", "f o o \n $a $b b a r";
+        @a = $str2 =~ /\C/gs; iseq @a, 9; iseq "@a", "f o o \n $a $b b a r";
+    }
 
-    print "not " if     "a" =~ /\P{IsLl}/;
-    print "ok 730\n";
 
-    print "not " unless "a" =~ /\P{IsLu}/;
-    print "ok 731\n";
+    {
+        # [ID 20010814.004] pos() doesn't work when using =~m// in list context
+        local $BugId = '20010814.004';
+        $_ = "ababacadaea";
+        my $a = join ":", /b./gc;
+        my $b = join ":", /a./gc;
+        my $c = pos;
+        iseq "$a $b $c", 'ba:ba ad:ae 10', "pos() works with () = m//";
+    }
 
-    print "not " if     "a" =~ /\P{Ll}/;
-    print "ok 732\n";
 
-    print "not " unless "a" =~ /\P{Lu}/;
-    print "ok 733\n";
+    {
+        # [ID 20010407.006] matching utf8 return values from
+        # functions does not work
+        local $BugId   = '20010407.006';
+        local $Message = 'UTF-8 return values from functions';
+        package ID_20010407_006;
+        sub x {"a\x{1234}"}
+        my $x = x;
+        my $y;
+      ::ok $x =~ /(..)/;
+        $y = $1;
+      ::ok length ($y) == 2 && $y eq $x;
+      ::ok x =~ /(..)/;
+        $y = $1;
+      ::ok length ($y) == 2 && $y eq $x;
+    }
 
-    print "not " if     "A" =~ /\PL/;
-    print "ok 734\n";
 
-    print "not " if     "A" =~ /\P{IsLu}/;
-    print "ok 735\n";
+    {
+        no warnings 'digit';
+        # Check that \x## works. 5.6.1 and 5.005_03 fail some of these.
+        my $x;
+        $x = "\x4e" . "E";
+        ok ($x =~ /^\x4EE$/, "Check only 2 bytes of hex are matched.");
 
-    print "not " unless "A" =~ /\P{IsLl}/;
-    print "ok 736\n";
+        $x = "\x4e" . "i";
+        ok ($x =~ /^\x4Ei$/, "Check that invalid hex digit stops it (2)");
 
-    print "not " if     "A" =~ /\P{Lu}/;
-    print "ok 737\n";
+        $x = "\x4" . "j";
+        ok ($x =~ /^\x4j$/,  "Check that invalid hex digit stops it (1)");
 
-    print "not " unless "A" =~ /\P{Ll}/;
-    print "ok 738\n";
+        $x = "\x0" . "k";
+        ok ($x =~ /^\xk$/,   "Check that invalid hex digit stops it (0)");
 
-}
+        $x = "\x0" . "x";
+        ok ($x =~ /^\xx$/, "\\xx isn't to be treated as \\0");
 
-{
-    print "not " if     "a" =~ /\p{Common}/;
-    print "ok 739\n";
+        $x = "\x0" . "xa";
+        ok ($x =~ /^\xxa$/, "\\xxa isn't to be treated as \\xa");
 
-    print "not " unless "1" =~ /\p{Common}/;
-    print "ok 740\n";
-}
+        $x = "\x9" . "_b";
+        ok ($x =~ /^\x9_b$/, "\\x9_b isn't to be treated as \\x9b");
 
-{
-    print "not " if     "a"       =~ /\p{Inherited}/;
-    print "ok 741\n";
+        # and now again in [] ranges
 
-    print "not " unless "\x{300}" =~ /\p{Inherited}/;
-    print "ok 742\n";
-}
+        $x = "\x4e" . "E";
+        ok ($x =~ /^[\x4EE]{2}$/, "Check only 2 bytes of hex are matched.");
 
-{
-    # L& and LC are the same
-    print "not " unless "a" =~ /\p{LC}/ and "a" =~ /\p{L&}/;
-    print "ok 743\n";
+        $x = "\x4e" . "i";
+        ok ($x =~ /^[\x4Ei]{2}$/, "Check that invalid hex digit stops it (2)");
 
-    print "not " if     "1" =~ /\p{LC}/ or "1" =~ /\p{L&}/;
-    print "ok 744\n";
-}
+        $x = "\x4" . "j";
+        ok ($x =~ /^[\x4j]{2}$/,  "Check that invalid hex digit stops it (1)");
 
-{
-    print "not " unless "a" =~ /\p{Lowercase Letter}/;
-    print "ok 745\n";
+        $x = "\x0" . "k";
+        ok ($x =~ /^[\xk]{2}$/,   "Check that invalid hex digit stops it (0)");
 
-    print "not " if     "A" =~ /\p{lowercaseletter}/;
-    print "ok 746\n";
-}
+        $x = "\x0" . "x";
+        ok ($x =~ /^[\xx]{2}$/, "\\xx isn't to be treated as \\0");
 
-{
-    print "not " unless "\x{AC00}" =~ /\p{HangulSyllables}/;
-    print "ok 747\n";
-}
+        $x = "\x0" . "xa";
+        ok ($x =~ /^[\xxa]{3}$/, "\\xxa isn't to be treated as \\xa");
 
-{
-    # Script=, Block=, Category=
+        $x = "\x9" . "_b";
+        ok ($x =~ /^[\x9_b]{3}$/, "\\x9_b isn't to be treated as \\x9b");
 
-    print "not " unless "\x{0100}" =~ /\p{Script=Latin}/;
-    print "ok 748\n";
+        # Check that \x{##} works. 5.6.1 fails quite a few of these.
 
-    print "not " unless "\x{0100}" =~ /\p{Block=LatinExtendedA}/;
-    print "ok 749\n";
+        $x = "\x9b";
+        ok ($x =~ /^\x{9_b}$/, "\\x{9_b} is to be treated as \\x9b");
 
-    print "not " unless "\x{0100}" =~ /\p{Category=UppercaseLetter}/;
-    print "ok 750\n";
-}
+        $x = "\x9b" . "y";
+        ok ($x =~ /^\x{9_b}y$/, "\\x{9_b} is to be treated as \\x9b (again)");
 
-{
-    print "# the basic character classes and Unicode \n";
+        $x = "\x9b" . "y";
+        ok ($x =~ /^\x{9b_}y$/, "\\x{9b_} is to be treated as \\x9b");
 
-    # 0100;LATIN CAPITAL LETTER A WITH MACRON;Lu;0;L;0041 0304;;;;N;LATIN CAPITAL LETTER A MACRON;;;0101;
-    print "not " unless "\x{0100}" =~ /\w/;
-    print "ok 751\n";
+        $x = "\x9b" . "y";
+        ok ($x =~ /^\x{9_bq}y$/, "\\x{9_bc} is to be treated as \\x9b");
 
-    # 0660;ARABIC-INDIC DIGIT ZERO;Nd;0;AN;;0;0;0;N;;;;;
-    print "not " unless "\x{0660}" =~ /\d/;
-    print "ok 752\n";
+        $x = "\x0" . "y";
+        ok ($x =~ /^\x{x9b}y$/, "\\x{x9b} is to be treated as \\x0");
 
-    # 1680;OGHAM SPACE MARK;Zs;0;WS;;;;;N;;;;;
-    print "not " unless "\x{1680}" =~ /\s/;
-    print "ok 753\n";
-}
+        $x = "\x0" . "y";
+        ok ($x =~ /^\x{0x9b}y$/, "\\x{0x9b} is to be treated as \\x0");
 
-{
-    print "# folding matches and Unicode\n";
+        $x = "\x9b" . "y";
+        ok ($x =~ /^\x{09b}y$/, "\\x{09b} is to be treated as \\x9b");
 
-    print "not " unless "a\x{100}" =~ /A/i;
-    print "ok 754\n";
+        $x = "\x9b";
+        ok ($x =~ /^[\x{9_b}]$/, "\\x{9_b} is to be treated as \\x9b");
 
-    print "not " unless "A\x{100}" =~ /a/i;
-    print "ok 755\n";
+        $x = "\x9b" . "y";
+        ok ($x =~ /^[\x{9_b}y]{2}$/,
+                                 "\\x{9_b} is to be treated as \\x9b (again)");
 
-    print "not " unless "a\x{100}" =~ /a/i;
-    print "ok 756\n";
+        $x = "\x9b" . "y";
+        ok ($x =~ /^[\x{9b_}y]{2}$/, "\\x{9b_} is to be treated as \\x9b");
 
-    print "not " unless "A\x{100}" =~ /A/i;
-    print "ok 757\n";
+        $x = "\x9b" . "y";
+        ok ($x =~ /^[\x{9_bq}y]{2}$/, "\\x{9_bc} is to be treated as \\x9b");
 
-    print "not " unless "\x{101}a" =~ /\x{100}/i;
-    print "ok 758\n";
+        $x = "\x0" . "y";
+        ok ($x =~ /^[\x{x9b}y]{2}$/, "\\x{x9b} is to be treated as \\x0");
 
-    print "not " unless "\x{100}a" =~ /\x{100}/i;
-    print "ok 759\n";
+        $x = "\x0" . "y";
+        ok ($x =~ /^[\x{0x9b}y]{2}$/, "\\x{0x9b} is to be treated as \\x0");
 
-    print "not " unless "\x{101}a" =~ /\x{101}/i;
-    print "ok 760\n";
+        $x = "\x9b" . "y";
+        ok ($x =~ /^[\x{09b}y]{2}$/, "\\x{09b} is to be treated as \\x9b");
 
-    print "not " unless "\x{100}a" =~ /\x{101}/i;
-    print "ok 761\n";
+    }
 
-    print "not " unless "a\x{100}" =~ /A\x{100}/i;
-    print "ok 762\n";
 
-    print "not " unless "A\x{100}" =~ /a\x{100}/i;
-    print "ok 763\n";
+    {
+        # High bit bug -- japhy
+        my $x = "ab\200d";
+        ok $x =~ /.*?\200/, "High bit fine";
+    }
 
-    print "not " unless "a\x{100}" =~ /a\x{100}/i;
-    print "ok 764\n";
 
-    print "not " unless "A\x{100}" =~ /A\x{100}/i;
-    print "ok 765\n";
+    {
+        # The basic character classes and Unicode
+        ok "\x{0100}" =~ /\w/, 'LATIN CAPITAL LETTER A WITH MACRON in /\w/';
+        ok "\x{0660}" =~ /\d/, 'ARABIC-INDIC DIGIT ZERO in /\d/';
+        ok "\x{1680}" =~ /\s/, 'OGHAM SPACE MARK in /\s/';
+    }
 
-    print "not " unless "a\x{100}" =~ /[A]/i;
-    print "ok 766\n";
 
-    print "not " unless "A\x{100}" =~ /[a]/i;
-    print "ok 767\n";
+    {
+        local $Message = "Folding matches and Unicode";
+        ok "a\x{100}" =~ /A/i;
+        ok "A\x{100}" =~ /a/i;
+        ok "a\x{100}" =~ /a/i;
+        ok "A\x{100}" =~ /A/i;
+        ok "\x{101}a" =~ /\x{100}/i;
+        ok "\x{100}a" =~ /\x{100}/i;
+        ok "\x{101}a" =~ /\x{101}/i;
+        ok "\x{100}a" =~ /\x{101}/i;
+        ok "a\x{100}" =~ /A\x{100}/i;
+        ok "A\x{100}" =~ /a\x{100}/i;
+        ok "a\x{100}" =~ /a\x{100}/i;
+        ok "A\x{100}" =~ /A\x{100}/i;
+        ok "a\x{100}" =~ /[A]/i;
+        ok "A\x{100}" =~ /[a]/i;
+        ok "a\x{100}" =~ /[a]/i;
+        ok "A\x{100}" =~ /[A]/i;
+        ok "\x{101}a" =~ /[\x{100}]/i;
+        ok "\x{100}a" =~ /[\x{100}]/i;
+        ok "\x{101}a" =~ /[\x{101}]/i;
+        ok "\x{100}a" =~ /[\x{101}]/i;
+    }
 
-    print "not " unless "a\x{100}" =~ /[a]/i;
-    print "ok 768\n";
 
-    print "not " unless "A\x{100}" =~ /[A]/i;
-    print "ok 769\n";
+    {
+        use charnames ':full';
+        local $Message = "Folding 'LATIN LETTER A WITH GRAVE'";
 
-    print "not " unless "\x{101}a" =~ /[\x{100}]/i;
-    print "ok 770\n";
+        my $lower = "\N{LATIN SMALL LETTER A WITH GRAVE}";
+        my $UPPER = "\N{LATIN CAPITAL LETTER A WITH GRAVE}";
+        
+        ok $lower =~ m/$UPPER/i;
+        ok $UPPER =~ m/$lower/i;
+        ok $lower =~ m/[$UPPER]/i;
+        ok $UPPER =~ m/[$lower]/i;
 
-    print "not " unless "\x{100}a" =~ /[\x{100}]/i;
-    print "ok 771\n";
+        local $Message = "Folding 'GREEK LETTER ALPHA WITH VRACHY'";
 
-    print "not " unless "\x{101}a" =~ /[\x{101}]/i;
-    print "ok 772\n";
+        $lower = "\N{GREEK CAPITAL LETTER ALPHA WITH VRACHY}";
+        $UPPER = "\N{GREEK SMALL LETTER ALPHA WITH VRACHY}";
 
-    print "not " unless "\x{100}a" =~ /[\x{101}]/i;
-    print "ok 773\n";
+        ok $lower =~ m/$UPPER/i;
+        ok $UPPER =~ m/$lower/i;
+        ok $lower =~ m/[$UPPER]/i;
+        ok $UPPER =~ m/[$lower]/i;
 
-}
+        local $Message = "Folding 'LATIN LETTER Y WITH DIAERESIS'";
 
-{
-    use charnames ':full';
+        $lower = "\N{LATIN SMALL LETTER Y WITH DIAERESIS}";
+        $UPPER = "\N{LATIN CAPITAL LETTER Y WITH DIAERESIS}";
 
-    print "# LATIN LETTER A WITH GRAVE\n";
-    my $lower = "\N{LATIN SMALL LETTER A WITH GRAVE}";
-    my $UPPER = "\N{LATIN CAPITAL LETTER A WITH GRAVE}";
+        ok $lower =~ m/$UPPER/i;
+        ok $UPPER =~ m/$lower/i;
+        ok $lower =~ m/[$UPPER]/i;
+        ok $UPPER =~ m/[$lower]/i;
+    }
 
-    print $lower =~ m/$UPPER/i   ? "ok 774\n" : "not ok 774\n";
-    print $UPPER =~ m/$lower/i   ? "ok 775\n" : "not ok 775\n";
-    print $lower =~ m/[$UPPER]/i ? "ok 776\n" : "not ok 776\n";
-    print $UPPER =~ m/[$lower]/i ? "ok 777\n" : "not ok 777\n";
 
-    print "# GREEK LETTER ALPHA WITH VRACHY\n";
+    {
+        use charnames ':full';
+        local $PatchId = "13843";
+        local $Message = "GREEK CAPITAL LETTER SIGMA vs " .
+                         "COMBINING GREEK PERISPOMENI";
 
-    $lower = "\N{GREEK CAPITAL LETTER ALPHA WITH VRACHY}";
-    $UPPER = "\N{GREEK SMALL LETTER ALPHA WITH VRACHY}";
+        my $SIGMA = "\N{GREEK CAPITAL LETTER SIGMA}";
+        my $char  = "\N{COMBINING GREEK PERISPOMENI}";
 
-    print $lower =~ m/$UPPER/i   ? "ok 778\n" : "not ok 778\n";
-    print $UPPER =~ m/$lower/i   ? "ok 779\n" : "not ok 779\n";
-    print $lower =~ m/[$UPPER]/i ? "ok 780\n" : "not ok 780\n";
-    print $UPPER =~ m/[$lower]/i ? "ok 781\n" : "not ok 781\n";
+        may_not_warn sub {ok "_:$char:_" !~ m/_:$SIGMA:_/i};
+    }
 
-    print "# LATIN LETTER Y WITH DIAERESIS\n";
 
-    $lower = "\N{LATIN CAPITAL LETTER Y WITH DIAERESIS}";
-    $UPPER = "\N{LATIN SMALL LETTER Y WITH DIAERESIS}";
-    print $lower =~ m/$UPPER/i   ? "ok 782\n" : "not ok 782\n";
-    print $UPPER =~ m/$lower/i   ? "ok 783\n" : "not ok 783\n";
-    print $lower =~ m/[$UPPER]/i ? "ok 784\n" : "not ok 784\n";
-    print $UPPER =~ m/[$lower]/i ? "ok 785\n" : "not ok 785\n";
-}
+    {
+        local $Message = '\X';
+        use charnames ':full';
+
+        ok "a!"                          =~ /^(\X)!/ && $1 eq "a";
+        ok "\xDF!"                       =~ /^(\X)!/ && $1 eq "\xDF";
+        ok "\x{100}!"                    =~ /^(\X)!/ && $1 eq "\x{100}";
+        ok "\x{100}\x{300}!"             =~ /^(\X)!/ && $1 eq "\x{100}\x{300}";
+        ok "\N{LATIN CAPITAL LETTER E}!" =~ /^(\X)!/ &&
+               $1 eq "\N{LATIN CAPITAL LETTER E}";
+        ok "\N{LATIN CAPITAL LETTER E}\N{COMBINING GRAVE ACCENT}!"
+                                         =~ /^(\X)!/ &&
+               $1 eq "\N{LATIN CAPITAL LETTER E}\N{COMBINING GRAVE ACCENT}";
+
+        local $Message = '\C and \X';
+        ok "!abc!" =~ /a\Cc/;
+        ok "!abc!" =~ /a\Xc/;
+    }
 
-{
-    use warnings;
-    use charnames ':full';
-    
-    print "# GREEK CAPITAL LETTER SIGMA vs COMBINING GREEK PERISPOMENI\n";
 
-    my $SIGMA = "\N{GREEK CAPITAL LETTER SIGMA}";
-    my $char  = "\N{COMBINING GREEK PERISPOMENI}";
+    {
+        local $Message = "Final Sigma";
 
-    # Before #13843 this was failing by matching falsely.
-    print "_:$char:_" =~ m/_:$SIGMA:_/i ? "not ok 786\n" : "ok 786\n";
-}
+        my $SIGMA = "\x{03A3}"; # CAPITAL
+        my $Sigma = "\x{03C2}"; # SMALL FINAL
+        my $sigma = "\x{03C3}"; # SMALL
 
-{
-    print "# \\X\n";
-
-    use charnames ':full';
-
-    print "a!"              =~ /^(\X)!/ && $1 eq "a" ?
-	"ok 787\n" : "not ok 787 # $1\n";
-    print "\xDF!"           =~ /^(\X)!/ && $1 eq "\xDF" ?
-	"ok 788\n" : "not ok 788 # $1\n";
-    print "\x{100}!"        =~ /^(\X)!/ && $1 eq "\x{100}" ?
-	"ok 789\n" : "not ok 789 # $1\n";
-    print "\x{100}\x{300}!" =~ /^(\X)!/ && $1 eq "\x{100}\x{300}" ?
-	"ok 790\n" : "not ok 790 # $1\n";
-    print "\N{LATIN CAPITAL LETTER E}!" =~ /^(\X)!/ &&
-	$1 eq "\N{LATIN CAPITAL LETTER E}" ?
-	"ok 791\n" : "not ok 791 # $1\n";
-    print "\N{LATIN CAPITAL LETTER E}\N{COMBINING GRAVE ACCENT}!" =~
-	/^(\X)!/ &&
-	$1 eq "\N{LATIN CAPITAL LETTER E}\N{COMBINING GRAVE ACCENT}" ?
-	"ok 792\n" : "not ok 792 # $1\n";
-}
+        ok $SIGMA =~ /$SIGMA/i;
+        ok $SIGMA =~ /$Sigma/i;
+        ok $SIGMA =~ /$sigma/i;
 
-{
-    print "#\\C and \\X\n";
+        ok $Sigma =~ /$SIGMA/i;
+        ok $Sigma =~ /$Sigma/i;
+        ok $Sigma =~ /$sigma/i;
 
-    print "!abc!" =~ /a\Cc/ ? "ok 793\n" : "not ok 793\n";
-    print "!abc!" =~ /a\Xc/ ? "ok 794\n" : "not ok 794\n";
-}
+        ok $sigma =~ /$SIGMA/i;
+        ok $sigma =~ /$Sigma/i;
+        ok $sigma =~ /$sigma/i;
+        
+        ok $SIGMA =~ /[$SIGMA]/i;
+        ok $SIGMA =~ /[$Sigma]/i;
+        ok $SIGMA =~ /[$sigma]/i;
 
-{
-    print "# FINAL SIGMA\n";
+        ok $Sigma =~ /[$SIGMA]/i;
+        ok $Sigma =~ /[$Sigma]/i;
+        ok $Sigma =~ /[$sigma]/i;
 
-    my $SIGMA = "\x{03A3}"; # CAPITAL
-    my $Sigma = "\x{03C2}"; # SMALL FINAL
-    my $sigma = "\x{03C3}"; # SMALL
+        ok $sigma =~ /[$SIGMA]/i;
+        ok $sigma =~ /[$Sigma]/i;
+        ok $sigma =~ /[$sigma]/i;
 
-    print $SIGMA =~ /$SIGMA/i ? "ok 795\n" : "not ok 795\n";
-    print $SIGMA =~ /$Sigma/i ? "ok 796\n" : "not ok 796\n";
-    print $SIGMA =~ /$sigma/i ? "ok 797\n" : "not ok 797\n";
+        local $Message = "More final Sigma";
 
-    print $Sigma =~ /$SIGMA/i ? "ok 798\n" : "not ok 798\n";
-    print $Sigma =~ /$Sigma/i ? "ok 799\n" : "not ok 799\n";
-    print $Sigma =~ /$sigma/i ? "ok 800\n" : "not ok 800\n";
+        my $S3 = "$SIGMA$Sigma$sigma";
 
-    print $sigma =~ /$SIGMA/i ? "ok 801\n" : "not ok 801\n";
-    print $sigma =~ /$Sigma/i ? "ok 802\n" : "not ok 802\n";
-    print $sigma =~ /$sigma/i ? "ok 803\n" : "not ok 803\n";
-    
-    print $SIGMA =~ /[$SIGMA]/i ? "ok 804\n" : "not ok 804\n";
-    print $SIGMA =~ /[$Sigma]/i ? "ok 805\n" : "not ok 805\n";
-    print $SIGMA =~ /[$sigma]/i ? "ok 806\n" : "not ok 806\n";
+        ok ":$S3:" =~ /:(($SIGMA)+):/i   && $1 eq $S3 && $2 eq $sigma;
+        ok ":$S3:" =~ /:(($Sigma)+):/i   && $1 eq $S3 && $2 eq $sigma;
+        ok ":$S3:" =~ /:(($sigma)+):/i   && $1 eq $S3 && $2 eq $sigma;
 
-    print $Sigma =~ /[$SIGMA]/i ? "ok 807\n" : "not ok 807\n";
-    print $Sigma =~ /[$Sigma]/i ? "ok 808\n" : "not ok 808\n";
-    print $Sigma =~ /[$sigma]/i ? "ok 809\n" : "not ok 809\n";
+        ok ":$S3:" =~ /:(([$SIGMA])+):/i && $1 eq $S3 && $2 eq $sigma;
+        ok ":$S3:" =~ /:(([$Sigma])+):/i && $1 eq $S3 && $2 eq $sigma;
+        ok ":$S3:" =~ /:(([$sigma])+):/i && $1 eq $S3 && $2 eq $sigma;
+    }
 
-    print $sigma =~ /[$SIGMA]/i ? "ok 810\n" : "not ok 810\n";
-    print $sigma =~ /[$Sigma]/i ? "ok 811\n" : "not ok 811\n";
-    print $sigma =~ /[$sigma]/i ? "ok 812\n" : "not ok 812\n";
-}
 
-{
-    print "# parlez-vous?\n";
-
-    use charnames ':full';
-
-    print "fran\N{LATIN SMALL LETTER C}ais" =~
-	  /fran.ais/ &&
-	$& eq "francais" ?
-	"ok 813\n" : "not ok 813\n";
-
-    print "fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais" =~
-	  /fran.ais/ &&
-	$& eq "fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais" ?
-	"ok 814\n" : "not ok 814\n";
-
-    print "fran\N{LATIN SMALL LETTER C}ais" =~
-	   /fran\Cais/ &&
-        $& eq "francais" ?
-	"ok 815\n" : "not ok 815\n";
-
-    print "franc\N{COMBINING CEDILLA}ais" =~
-	  /franc\C\Cais/ ? # COMBINING CEDILLA is two bytes when encoded
-	"ok 816\n" : "not ok 816\n";
-
-    print "fran\N{LATIN SMALL LETTER C}ais" =~
-	  /fran\Xais/ &&
-	$& eq "francais" ?
-	"ok 817\n" : "not ok 817\n";
-
-    print "fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais" =~
-	  /fran\Xais/  &&
-        $& eq "fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais" ?
-	"ok 818\n" : "not ok 818\n";
-
-    print "franc\N{COMBINING CEDILLA}ais" =~
-	  /fran\Xais/ &&
-         $& eq "franc\N{COMBINING CEDILLA}ais" ?
-	 "ok 819\n" : "not ok 819\n";
-
-    print "fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais" =~
-	  /fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais/  &&
-        $& eq "fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais" ?
-	"ok 820\n" : "not ok 820\n";
-
-    print "franc\N{COMBINING CEDILLA}ais" =~
-	  /franc\N{COMBINING CEDILLA}ais/  &&
-        $& eq "franc\N{COMBINING CEDILLA}ais" ?
-	"ok 821\n" : "not ok 821\n";
-
-    print "fran\N{LATIN SMALL LETTER C}ais" =~
-	  /fran(?:c\N{COMBINING CEDILLA}?|\N{LATIN SMALL LETTER C WITH CEDILLA})ais/ &&
-	$& eq "francais" ?
-	"ok 822\n" : "not ok 822\n";
-
-    print "fran\N{LATIN SMALL LETTER C}ais" =~
-	  /fran(?:c\N{COMBINING CEDILLA}?|\N{LATIN SMALL LETTER C WITH CEDILLA})ais/ &&
-	$& eq "francais" ?
-	"ok 823\n" : "not ok 823\n";
-
-    print "fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais" =~
-	  /fran(?:c\N{COMBINING CEDILLA}?|\N{LATIN SMALL LETTER C WITH CEDILLA})ais/ &&
-	$& eq "fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais" ?
-	"ok 824\n" : "not ok 824\n";
-
-    print "franc\N{COMBINING CEDILLA}ais" =~
-	  /fran(?:c\N{COMBINING CEDILLA}?|\N{LATIN SMALL LETTER C WITH CEDILLA})ais/ &&
-	$& eq "franc\N{COMBINING CEDILLA}ais" ?
-	"ok 825\n" : "not ok 825\n";
-}
+    {
+        use charnames ':full';
+        local $Message = "Parlez-Vous " .
+                         "Fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais?";
+
+        ok "Fran\N{LATIN SMALL LETTER C}ais" =~ /Fran.ais/ &&
+            $& eq "Francais";
+        ok "Fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais" =~ /Fran.ais/ &&
+            $& eq "Fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais";
+        ok "Fran\N{LATIN SMALL LETTER C}ais" =~ /Fran\Cais/ &&
+            $& eq "Francais";
+        # COMBINING CEDILLA is two bytes when encoded
+        ok "Franc\N{COMBINING CEDILLA}ais" =~ /Franc\C\Cais/;
+        ok "Fran\N{LATIN SMALL LETTER C}ais" =~ /Fran\Xais/ &&
+            $& eq "Francais";
+        ok "Fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais" =~ /Fran\Xais/  &&
+            $& eq "Fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais";
+        ok "Franc\N{COMBINING CEDILLA}ais" =~ /Fran\Xais/ &&
+            $& eq "Franc\N{COMBINING CEDILLA}ais";
+        ok "Fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais" =~
+           /Fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais/  &&
+            $& eq "Fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais";
+        ok "Franc\N{COMBINING CEDILLA}ais" =~ /Franc\N{COMBINING CEDILLA}ais/ &&
+            $& eq "Franc\N{COMBINING CEDILLA}ais";
+
+        my @f = (
+            ["Fran\N{LATIN SMALL LETTER C}ais",                    "Francais"],
+            ["Fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais",
+                               "Fran\N{LATIN SMALL LETTER C WITH CEDILLA}ais"],
+            ["Franc\N{COMBINING CEDILLA}ais", "Franc\N{COMBINING CEDILLA}ais"],
+        );
+        foreach my $entry (@f) {
+            my ($subject, $match) = @$entry;
+            ok $subject =~ /Fran(?:c\N{COMBINING CEDILLA}?|
+                    \N{LATIN SMALL LETTER C WITH CEDILLA})ais/x &&
+               $& eq $match;
+        }
+    }
 
-{
-    print "# Does lingering (and useless) UTF8 flag mess up /i matching?\n";
 
     {
-	my $regex  = "ABcde";
-	my $string = "abcDE\x{100}";
-	chop($string);
-	if ($string =~ m/$regex/i) {
-	    print "ok 826\n";
-	} else {
-	    print "not ok 826\n";
-	}
+        local $Message = "Lingering (and useless) UTF8 flag doesn't mess up /i";
+        my $pat = "ABcde";
+        my $str = "abcDE\x{100}";
+        chop $str;
+        ok $str =~ /$pat/i;
+
+        $pat = "ABcde\x{100}";
+        $str = "abcDE";
+        chop $pat;
+        ok $str =~ /$pat/i;
+
+        $pat = "ABcde\x{100}";
+        $str = "abcDE\x{100}";
+        chop $pat;
+        chop $str;
+        ok $str =~ /$pat/i;
     }
 
+
     {
-	my $regex  = "ABcde\x{100}";
-	my $string = "abcDE";
-	chop($regex);
-	if ($string =~ m/$regex/i) {
-	    print "ok 827\n";
-	} else {
-	    print "not ok 827\n";
-	}
+        use charnames ':full';
+        local $Message = "LATIN SMALL LETTER SHARP S " .
+                         "(\N{LATIN SMALL LETTER SHARP S})";
+
+        ok "\N{LATIN SMALL LETTER SHARP S}" =~
+                                            /\N{LATIN SMALL LETTER SHARP S}/;
+        ok "\N{LATIN SMALL LETTER SHARP S}" =~
+                                            /\N{LATIN SMALL LETTER SHARP S}/i;
+        ok "\N{LATIN SMALL LETTER SHARP S}" =~
+                                           /[\N{LATIN SMALL LETTER SHARP S}]/;
+        ok "\N{LATIN SMALL LETTER SHARP S}" =~
+                                           /[\N{LATIN SMALL LETTER SHARP S}]/i;
+
+        ok "ss" =~  /\N{LATIN SMALL LETTER SHARP S}/i;
+        ok "SS" =~  /\N{LATIN SMALL LETTER SHARP S}/i;
+        ok "ss" =~ /[\N{LATIN SMALL LETTER SHARP S}]/i;
+        ok "SS" =~ /[\N{LATIN SMALL LETTER SHARP S}]/i;
+
+        ok "\N{LATIN SMALL LETTER SHARP S}" =~ /ss/i;
+        ok "\N{LATIN SMALL LETTER SHARP S}" =~ /SS/i;
+ 
+        local $Message = "Unoptimized named sequence in class";
+        ok "ss" =~ /[\N{LATIN SMALL LETTER SHARP S}x]/i;
+        ok "SS" =~ /[\N{LATIN SMALL LETTER SHARP S}x]/i;
+        ok "\N{LATIN SMALL LETTER SHARP S}" =~
+          /[\N{LATIN SMALL LETTER SHARP S}x]/;
+        ok "\N{LATIN SMALL LETTER SHARP S}" =~
+          /[\N{LATIN SMALL LETTER SHARP S}x]/i;
     }
 
+
     {
-	my $regex  = "ABcde\x{100}";
-	my $string = "abcDE\x{100}";
-	chop($regex);
-	chop($string);
-	if ($string =~ m/$regex/i) {
-	    print "ok 828\n";
-	} else {
-	    print "not ok 828\n";
-	}
+        # More whitespace: U+0085, U+2028, U+2029\n";
+
+        # U+0085, U+00A0 need to be forced to be Unicode, the \x{100} does that.
+      SKIP: {
+          skip "EBCDIC platform", 4 if $IS_EBCDIC;
+          # Do \x{0015} and \x{0041} match \s in EBCDIC?
+          ok "<\x{100}\x{0085}>" =~ /<\x{100}\s>/, '\x{0085} in \s';
+          ok        "<\x{0085}>" =~        /<\v>/, '\x{0085} in \v';
+          ok "<\x{100}\x{00A0}>" =~ /<\x{100}\s>/, '\x{00A0} in \s';
+          ok        "<\x{00A0}>" =~        /<\h>/, '\x{00A0} in \h';
+        }
+        my @h = map {sprintf "%05x" => $_} 0x01680, 0x0180E, 0x02000 .. 0x0200A,
+                                           0x0202F, 0x0205F, 0x03000;
+        my @v = map {sprintf "%05x" => $_} 0x02028, 0x02029;
+
+        my @H = map {sprintf "%05x" => $_} 0x01361,   0x0200B, 0x02408, 0x02420,
+                                           0x0303F,   0xE0020;
+        my @V = map {sprintf "%05x" => $_} 0x0008A .. 0x0008D, 0x00348, 0x10100,
+                                           0xE005F,   0xE007C;
+
+        for my $hex (@h) {
+            my $str = eval qq ["<\\x{$hex}>"];
+            ok $str =~ /<\s>/, "\\x{$hex} in \\s";
+            ok $str =~ /<\h>/, "\\x{$hex} in \\h";
+            ok $str !~ /<\v>/, "\\x{$hex} not in \\v";
+        }
+
+        for my $hex (@v) {
+            my $str = eval qq ["<\\x{$hex}>"];
+            ok $str =~ /<\s>/, "\\x{$hex} in \\s";
+            ok $str =~ /<\v>/, "\\x{$hex} in \\v";
+            ok $str !~ /<\h>/, "\\x{$hex} not in \\h";
+        }
+
+        for my $hex (@H) {
+            my $str = eval qq ["<\\x{$hex}>"];
+            ok $str =~ /<\S>/, "\\x{$hex} in \\S";
+            ok $str =~ /<\H>/, "\\x{$hex} in \\H";
+        }
+
+        for my $hex (@V) {
+            my $str = eval qq ["<\\x{$hex}>"];
+            ok $str =~ /<\S>/, "\\x{$hex} in \\S";
+            ok $str =~ /<\V>/, "\\x{$hex} in \\V";
+        }
     }
-}
 
-{
-    print "# more SIGMAs\n";
 
-    my $SIGMA = "\x{03A3}"; # CAPITAL
-    my $Sigma = "\x{03C2}"; # SMALL FINAL
-    my $sigma = "\x{03C3}"; # SMALL
+    {
+        # . with /s should work on characters, as opposed to bytes
+        local $Message = ". with /s works on characters, not bytes";
 
-    my $S3 = "$SIGMA$Sigma$sigma";
+        my $s = "\x{e4}\x{100}";
+        # This is not expected to match: the point is that
+        # neither should we get "Malformed UTF-8" warnings.
+        may_not_warn sub {$s =~ /\G(.+?)\n/gcs}, "No 'Malformed UTF-8' warning";
 
-    print ":$S3:" =~ /:(($SIGMA)+):/i   && $1 eq $S3 && $2 eq $sigma ?
-	"ok 829\n" : "not ok 829\n";
-    print ":$S3:" =~ /:(($Sigma)+):/i   && $1 eq $S3 && $2 eq $sigma ?
-	"ok 830\n" : "not ok 830\n";
-    print ":$S3:" =~ /:(($sigma)+):/i   && $1 eq $S3 && $2 eq $sigma ?
-	"ok 831\n" : "not ok 831\n";
+        my @c;
+        push @c => $1 while $s =~ /\G(.)/gs;
 
-    print ":$S3:" =~ /:(([$SIGMA])+):/i && $1 eq $S3 && $2 eq $sigma ?
-	"ok 832\n" : "not ok 832\n";
-    print ":$S3:" =~ /:(([$Sigma])+):/i && $1 eq $S3 && $2 eq $sigma ?
-	"ok 833\n" : "not ok 833\n";
-    print ":$S3:" =~ /:(([$sigma])+):/i && $1 eq $S3 && $2 eq $sigma ?
-	"ok 834\n" : "not ok 834\n";
-}
+        local $" = "";
+        iseq "@c", $s;
 
-{
-    print "# LATIN SMALL LETTER SHARP S\n";
+        # Test only chars < 256
+        my $t1 = "Q003\n\n\x{e4}\x{f6}\n\nQ004\n\n\x{e7}";
+        my $r1 = "";
+        while ($t1 =~ / \G ( .+? ) \n\s+ ( .+? ) ( $ | \n\s+ ) /xgcs) {
+	    $r1 .= $1 . $2;
+        }
 
-    use charnames ':full';
+        my $t2 = $t1 . "\x{100}"; # Repeat with a larger char
+        my $r2 = "";
+        while ($t2 =~ / \G ( .+? ) \n\s+ ( .+? ) ( $ | \n\s+ ) /xgcs) {
+	    $r2 .= $1 . $2;
+        }
+        $r2 =~ s/\x{100}//;
 
-    $test= 835;
+        iseq $r1, $r2;
+    }
 
-    ok("\N{LATIN SMALL LETTER SHARP S}" =~ /\N{LATIN SMALL LETTER SHARP S}/);
-    ok("\N{LATIN SMALL LETTER SHARP S}" =~ /\N{LATIN SMALL LETTER SHARP S}/i);
 
-    ok("\N{LATIN SMALL LETTER SHARP S}" =~ /[\N{LATIN SMALL LETTER SHARP S}]/);
-    ok("\N{LATIN SMALL LETTER SHARP S}" =~ /[\N{LATIN SMALL LETTER SHARP S}]/i);
+    {
+        local $Message = "Unicode lookbehind";
+        ok "A\x{100}B"        =~ /(?<=A.)B/;
+        ok "A\x{200}\x{300}B" =~ /(?<=A..)B/;
+        ok "\x{400}AB"        =~ /(?<=\x{400}.)B/;
+        ok "\x{500}\x{600}B"  =~ /(?<=\x{500}.)B/;
+
+        # Original code also contained:
+        # ok "\x{500\x{600}}B"  =~ /(?<=\x{500}.)B/;
+        # but that looks like a typo.
+    }
 
-    ok("ss" =~ /\N{LATIN SMALL LETTER SHARP S}/i);
-    ok("SS" =~ /\N{LATIN SMALL LETTER SHARP S}/i);
-    ok("ss" =~ /[\N{LATIN SMALL LETTER SHARP S}]/i);
-    ok("SS" =~ /[\N{LATIN SMALL LETTER SHARP S}]/i);
 
-    ok("\N{LATIN SMALL LETTER SHARP S}" =~ /ss/i);
-    ok("\N{LATIN SMALL LETTER SHARP S}" =~ /SS/i);
-}
+    {
+        local $Message = 'UTF-8 hash keys and /$/';
+        # http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters
+        #                                         /2002-01/msg01327.html
+
+        my $u = "a\x{100}";
+        my $v = substr ($u, 0, 1);
+        my $w = substr ($u, 1, 1);
+        my %u = ($u => $u, $v => $v, $w => $w);
+        for (keys %u) {
+            my $m1 =            /^\w*$/ ? 1 : 0;
+            my $m2 = $u {$_} =~ /^\w*$/ ? 1 : 0;
+            iseq $m1, $m2;
+        }
+    }
 
-{
-    print "# more whitespace: U+0085, U+2028, U+2029\n";
 
-    # U+0085 needs to be forced to be Unicode, the \x{100} does that.
-    if ($ordA == 193) {
-	print "<\x{100}\x{0085}>" =~ /<\x{100}e>/ ? "ok 845\n" : "not ok 845\n";
-    } else {
-	print "<\x{100}\x{0085}>" =~ /<\x{100}\s>/ ? "ok 845\n" : "not ok 845\n";
+    {
+        local $BugId   = "20020124.005";
+        local $PatchId = "14795";
+        local $Message = "s///eg";
+
+        for my $char ("a", "\x{df}", "\x{100}") {
+            my $x = "$char b $char";
+            $x =~ s{($char)}{
+                  "c" =~ /c/;
+                  "x";
+            }ge;
+            iseq substr ($x, 0, 1), substr ($x, -1, 1);
+        }
     }
-    print "<\x{2028}>" =~ /<\s>/ ? "ok 846\n" : "not ok 846\n";
-    print "<\x{2029}>" =~ /<\s>/ ? "ok 847\n" : "not ok 847\n";
-}
 
-{
-    print "# . with /s should work on characters, as opposed to bytes\n";
 
-    my $s = "\x{e4}\x{100}";
+    {
+        local $Message = "No SEGV in s/// and UTF-8";
+        my $s = "s#\x{100}" x 4;
+        ok $s =~ s/[^\w]/ /g;
+        if ($ENV {REAL_POSIX_CC}) {
+            iseq $s, "s  " x 4;
+        }
+        else {
+            iseq $s, "s \x{100}" x 4;
+        }
+    }
+
 
-    # This is not expected to match: the point is that
-    # neither should we get "Malformed UTF-8" warnings.
-    print $s =~ /\G(.+?)\n/gcs ?
-	"not ok 848\n" : "ok 848\n";
+    {
+        local $Message = "UTF-8 bug (maybe already known?)";
+        my $u = "foo";
+        $u =~ s/./\x{100}/g;
+        iseq $u, "\x{100}\x{100}\x{100}";
 
-    my @c;
+        $u = "foobar";
+        $u =~ s/[ao]/\x{100}/g;
+        iseq $u, "f\x{100}\x{100}b\x{100}r";
 
-    while ($s =~ /\G(.)/gs) {
-	push @c, $1;
+        $u =~ s/\x{100}/e/g;
+        iseq $u, "feeber";
     }
 
-    print join("", @c) eq $s ? "ok 849\n" : "not ok 849\n";
 
-    my $t1 = "Q003\n\n\x{e4}\x{f6}\n\nQ004\n\n\x{e7}"; # test only chars < 256
-    my $r1 = "";
-    while ($t1 =~ / \G ( .+? ) \n\s+ ( .+? ) ( $ | \n\s+ ) /xgcs) {
-	$r1 .= $1 . $2;
+    {
+        local $Message = "UTF-8 bug with s///";
+        # check utf8/non-utf8 mixtures
+        # try to force all float/anchored check combinations
+
+        my $c = "\x{100}";
+        my $subst;
+        for my $re ("xx.*$c", "x.*$c$c", "$c.*xx", "$c$c.*x",
+                    "xx.*(?=$c)", "(?=$c).*xx",) {
+            ok "xxx" !~ /$re/;
+            ok +($subst = "xxx") !~ s/$re//;
+        }
+        for my $re ("xx.*$c*", "$c*.*xx") {
+            ok "xxx" =~ /$re/;
+            ok +($subst = "xxx") =~ s/$re//;
+            iseq $subst, "";
+        }
+        for my $re ("xxy*", "y*xx") {
+            ok "xx$c" =~ /$re/;
+            ok +($subst = "xx$c") =~ s/$re//;
+            iseq $subst, $c;
+            ok "xy$c" !~ /$re/;
+            ok +($subst = "xy$c") !~ s/$re//;
+        }
+        for my $re ("xy$c*z", "x$c*yz") {
+            ok "xyz" =~ /$re/;
+            ok +($subst = "xyz") =~ s/$re//;
+            iseq $subst, "";
+        }
     }
 
-    my $t2 = $t1 . "\x{100}"; # repeat with a larger char
-    my $r2 = "";
-    while ($t2 =~ / \G ( .+? ) \n\s+ ( .+? ) ( $ | \n\s+ ) /xgcs) {
-	$r2 .= $1 . $2;
+
+    {
+        local $Message = "qr /.../x";
+        my $R = qr / A B C # D E/x;
+        ok "ABCDE" =~    $R   && $& eq "ABC";
+        ok "ABCDE" =~   /$R/  && $& eq "ABC";
+        ok "ABCDE" =~  m/$R/  && $& eq "ABC";
+        ok "ABCDE" =~  /($R)/ && $1 eq "ABC";
+        ok "ABCDE" =~ m/($R)/ && $1 eq "ABC";
     }
-    $r2 =~ s/\x{100}//;
-    print $r1 eq $r2 ? "ok 850\n" : "not ok 850\n";
-}
 
-{
-    print "# Unicode lookbehind\n";
 
-    print "A\x{100}B"        =~ /(?<=A.)B/  ? "ok 851\n" : "not ok 851\n";
-    print "A\x{200}\x{300}B" =~ /(?<=A..)B/ ? "ok 852\n" : "not ok 852\n";
-    print "\x{400}AB"        =~ /(?<=\x{400}.)B/ ? "ok 853\n" : "not ok 853\n";
-    print "\x{500\x{600}}B"  =~ /(?<=\x{500}.)B/ ? "ok 854\n" : "not ok 854\n";
-}
+    {
+        local $BugId = "20020412.005";
+        local $Message = "Correct pmop flags checked when empty pattern";
+
+        # Requires reuse of last successful pattern.
+        my $num = 123;
+        $num =~ /\d/;
+        for (0 .. 1) {
+            my $match = ?? + 0;
+            ok $match != $_, $Message, 
+                sprintf "'match one' %s on %s iteration" =>
+                               $match ? 'succeeded' : 'failed',
+                               $_     ? 'second'    : 'first';
+        }
+        $num =~ /(\d)/;
+        my $result = join "" => $num =~ //g;
+        iseq $result, $num;
+    }
 
-{
-    print "# UTF-8 hash keys and /\$/\n";
-    # http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2002-01/msg01327.html
-
-    my $u = "a\x{100}";
-    my $v = substr($u,0,1);
-    my $w = substr($u,1,1);
-    my %u = ( $u => $u, $v => $v, $w => $w );
-    my $i = 855; 
-    for (keys %u) {
-	my $m1 = /^\w*$/ ? 1 : 0;
-	my $m2 = $u{$_}=~/^\w*$/ ? 1 : 0;
-	print $m1 == $m2 ? "ok $i\n" : "not ok $i # $m1 $m2\n";
-	$i++;
+
+    {
+        local $BugId   = '20020630.002';
+        local $Message = 'UTF-8 regex matches above 32k';
+        for (['byte', "\x{ff}"], ['utf8', "\x{1ff}"]) {
+            my ($type, $char) = @$_;
+            for my $len (32000, 32768, 33000) {
+                my  $s = $char . "f" x $len;
+                my  $r = $s =~ /$char([f]*)/gc;
+                ok  $r, $Message, "<$type x $len>";
+                ok !$r || pos ($s) == $len + 1, $Message,
+                        "<$type x $len>; pos = @{[pos $s]}";
+            }
+        }
     }
-}
 
-{
-    print "# [ID 20020124.005]\n";
-    # Fixed by #14795.
-    my $i = 858;
-    for my $char ("a", "\x{df}", "\x{100}"){
-	$x = "$char b $char";
-	$x =~ s{($char)}{
-	    "c" =~ /c/;
-	    "x";
-	}ge;
-	print substr($x,0,1) eq substr($x,-1,1) ?
-	    "ok $i\n" : "not ok $i # debug: $x\n";
- 	$i++;
-   }
-}
 
-{
-    print "# SEGV in s/// and UTF-8\n";
-    $s = "s#\x{100}" x 4;
-    $s =~ s/[^\w]/ /g;
-    print $s eq "s \x{100}" x 4 ? "ok 861\n" : "not ok 861\n";
-}
+    {
+        our $a = bless qr /foo/ => 'Foo';
+        ok 'goodfood' =~ $a,     "Reblessed qr // matches";
+        iseq $a, '(?-xism:foo)', "Reblessed qr // stringifies";
+        my $x = "\x{3fe}";
+        my $z = my $y = "\317\276";  # Byte representation of $x
+        $a = qr /$x/;
+        ok $x =~ $a, "UTF-8 interpolation in qr //";
+        ok "a$a" =~ $x, "Stringified qr // preserves UTF-8";
+        ok "a$x" =~ /^a$a\z/, "Interpolated qr // preserves UTF-8";
+        ok "a$x" =~ /^a(??{$a})\z/,
+                        "Postponed interpolation of qr // preserves UTF-8";
+        {
+            local $BugId = '17776';
+            iseq length qr /##/x, 12, "## in qr // doesn't corrupt memory";
+        }
+        {
+            use re 'eval';
+            ok "$x$x" =~ /^$x(??{$x})\z/,
+               "Postponed UTF-8 string in UTF-8 re matches UTF-8";
+            ok "$y$x" =~ /^$y(??{$x})\z/, 
+               "Postponed UTF-8 string in non-UTF-8 re matches UTF-8";
+            ok "$y$x" !~ /^$y(??{$y})\z/,
+               "Postponed non-UTF-8 string in non-UTF-8 re doesn't match UTF-8";
+            ok "$x$x" !~ /^$x(??{$y})\z/,
+               "Postponed non-UTF-8 string in UTF-8 re doesn't match UTF-8";
+            ok "$y$y" =~ /^$y(??{$y})\z/,
+               "Postponed non-UTF-8 string in non-UTF-8 re matches non-UTF8";
+            ok "$x$y" =~ /^$x(??{$y})\z/,
+               "Postponed non-UTF-8 string in UTF-8 re matches non-UTF8";
+
+            $y = $z;  # Reset $y after upgrade.
+            ok "$x$y" !~ /^$x(??{$x})\z/,
+               "Postponed UTF-8 string in UTF-8 re doesn't match non-UTF-8";
+            ok "$y$y" !~ /^$y(??{$x})\z/,
+               "Postponed UTF-8 string in non-UTF-8 re doesn't match non-UTF-8";
+        }
+    }
 
-{
-    print "# UTF-8 bug (maybe alreayd known?)\n";
-    my $u;
 
-    $u = "foo";
-    $u =~ s/./\x{100}/g;
-    print $u eq "\x{100}\x{100}\x{100}" ? "ok 862\n" : "not ok 862\n";
+    {
+        local $PatchId = '18179';
+        my $s = "\x{100}" x 5;
+        my $ok = $s =~ /(\x{100}{4})/;
+        my ($ord, $len) = (ord $1, length $1);
+        ok $ok && $ord == 0x100 && $len == 4, "No panic: end_shift";
+    }
 
-    $u = "foobar";
-    $u =~ s/[ao]/\x{100}/g;
-    print $u eq "f\x{100}\x{100}b\x{100}r" ? "ok 863\n" : "not ok 863\n";
 
-    $u =~ s/\x{100}/e/g;
-    print $u eq "feeber" ? "ok 864\n" : "not ok 864\n";
-}
+    {
+        local $BugId = '15763';
+        our $a = "x\x{100}";
+        chop $a;    # Leaves the UTF-8 flag
+        $a .= "y";  # 1 byte before 'y'.
 
-{
-    print "# UTF-8 bug with s///\n";
-    # check utf8/non-utf8 mixtures
-    # try to force all float/anchored check combinations
-    my $c = "\x{100}";
-    $test = 865;
-    my $subst;
-    for my $re (
-	"xx.*$c", "x.*$c$c", "$c.*xx", "$c$c.*x", "xx.*(?=$c)", "(?=$c).*xx",
-    ) {
-	print "xxx" =~ /$re/ ? "not ok $test\n" : "ok $test\n";
-	++$test;
-	print +($subst = "xxx") =~ s/$re// ? "not ok $test\n" : "ok $test\n";
-	++$test;
-    }
-    for my $re ("xx.*$c*", "$c*.*xx") {
-	print "xxx" =~ /$re/ ? "ok $test\n" : "not ok $test\n";
-	++$test;
-	($subst = "xxx") =~ s/$re//;
-	print $subst eq '' ? "ok $test\n" : "not ok $test\t# $subst\n";
-	++$test;
-    }
-    for my $re ("xxy*", "y*xx") {
-	print "xx$c" =~ /$re/ ? "ok $test\n" : "not ok $test\n";
-	++$test;
-	($subst = "xx$c") =~ s/$re//;
-	print $subst eq $c ? "ok $test\n" : "not ok $test\n";
-	++$test;
-	print "xy$c" =~ /$re/ ? "not ok $test\n" : "ok $test\n";
-	++$test;
-	print +($subst = "xy$c") =~ /$re/ ? "not ok $test\n" : "ok $test\n";
-	++$test;
-    }
-    for my $re ("xy$c*z", "x$c*yz") {
-	print "xyz" =~ /$re/ ? "ok $test\n" : "not ok $test\n";
-	++$test;
-	($subst = "xyz") =~ s/$re//;
-	print $subst eq '' ? "ok $test\n" : "not ok $test\n";
-	++$test;
-    }
-}
+        ok $a =~ /^\C/,        'match one \C on 1-byte UTF-8';
+        ok $a =~ /^\C{1}/,     'match \C{1}';
 
-{
-    print "# qr/.../x\n";
-    $test = 893;
+        ok $a =~ /^\Cy/,       'match \Cy';
+        ok $a =~ /^\C{1}y/,    'match \C{1}y';
 
-    my $R = qr/ A B C # D E/x;
+        ok $a !~ /^\C\Cy/,     q {don't match two \Cy};
+        ok $a !~ /^\C{2}y/,    q {don't match \C{2}y};
 
-    print eval {"ABCDE" =~ $R} ? "ok $test\n" : "not ok $test\n";
-    $test++;
+        $a = "\x{100}y"; # 2 bytes before "y"
 
-    print eval {"ABCDE" =~ m/$R/} ? "ok $test\n" : "not ok $test\n";
-    $test++;
+        ok $a =~ /^\C/,        'match one \C on 2-byte UTF-8';
+        ok $a =~ /^\C{1}/,     'match \C{1}';
+        ok $a =~ /^\C\C/,      'match two \C';
+        ok $a =~ /^\C{2}/,     'match \C{2}';
 
-    print eval {"ABCDE" =~ m/($R)/} ? "ok $test\n" : "not ok $test\n";
-    $test++;
-}
+        ok $a =~ /^\C\C\C/,    'match three \C on 2-byte UTF-8 and a byte';
+        ok $a =~ /^\C{3}/,     'match \C{3}';
 
-{
-    print "# illegal Unicode properties\n";
-    $test = 896;
+        ok $a =~ /^\C\Cy/,     'match two \C';
+        ok $a =~ /^\C{2}y/,    'match \C{2}';
 
-    print eval { "a" =~ /\pq / }      ? "not ok $test\n" : "ok $test\n";
-    $test++;
+        ok $a !~ /^\C\C\Cy/,   q {don't match three \Cy};
+        ok $a !~ /^\C{2}\Cy/,  q {don't match \C{2}\Cy};
+        ok $a !~ /^\C{3}y/,    q {don't match \C{3}y};
 
-    print eval { "a" =~ /\p{qrst} / } ? "not ok $test\n" : "ok $test\n";
-    $test++;
-}
+        $a = "\x{1000}y"; # 3 bytes before "y"
 
-{
-    print "# [ID 20020412.005] wrong pmop flags checked when empty pattern\n";
-    # requires reuse of last successful pattern
-    $test = 898;
-    $test =~ /\d/;
-    for (0 .. 1) {
-	my $match = ?? + 0;
-	if ($match != $_) {
-	    print "ok $test\n";
-	} else {
-	    printf "not ok %s\t# 'match once' %s on %s iteration\n", $test,
-		    $match ? 'succeeded' : 'failed', $_ ? 'second' : 'first';
-	}
-	++$test;
+        ok $a =~ /^\C/,        'match one \C on three-byte UTF-8';
+        ok $a =~ /^\C{1}/,     'match \C{1}';
+        ok $a =~ /^\C\C/,      'match two \C';
+        ok $a =~ /^\C{2}/,     'match \C{2}';
+        ok $a =~ /^\C\C\C/,    'match three \C';
+        ok $a =~ /^\C{3}/,     'match \C{3}';
+
+        ok $a =~ /^\C\C\C\C/,  'match four \C on three-byte UTF-8 and a byte';
+        ok $a =~ /^\C{4}/,     'match \C{4}';
+
+        ok $a =~ /^\C\C\Cy/,   'match three \Cy';
+        ok $a =~ /^\C{3}y/,    'match \C{3}y';
+
+        ok $a !~ /^\C\C\C\Cy/, q {don't match four \Cy};
+        ok $a !~ /^\C{4}y/,    q {don't match \C{4}y};
     }
-    $test =~ /(\d)/;
-    my $result = join '', $test =~ //g;
-    if ($result eq $test) {
-	print "ok $test\n";
-    } else {
-	printf "not ok %s\t# expected '%s', got '%s'\n", $test, $test, $result;
+
+    
+    {
+        local $\;
+        $_ = 'aaaaaaaaaa';
+        utf8::upgrade($_); chop $_; $\="\n";
+        ok /[^\s]+/, 'm/[^\s]/ utf8';
+        ok /[^\d]+/, 'm/[^\d]/ utf8';
+        ok +($a = $_, $_ =~ s/[^\s]+/./g), 's/[^\s]/ utf8';
+        ok +($a = $_, $a =~ s/[^\d]+/./g), 's/[^\s]/ utf8';
     }
-    ++$test;
-}
 
-print "# user-defined character properties\n";
 
-sub InKana1 {
-    return <<'END';
-3040	309F
-30A0	30FF
-END
-}
+    {
+        local $BugId   = '15397';
+        local $Message = 'UTF-8 matching';
+        ok "\x{100}" =~ /\x{100}/;
+        ok "\x{100}" =~ /(\x{100})/;
+        ok "\x{100}" =~ /(\x{100}){1}/;
+        ok "\x{100}\x{100}" =~ /(\x{100}){2}/;
+        ok "\x{100}\x{100}" =~ /(\x{100})(\x{100})/;
+    }
 
-sub InKana2 {
-    return <<'END';
-+utf8::InHiragana
-+utf8::InKatakana
-END
-}
 
-sub InKana3 {
-    return <<'END';
-+utf8::InHiragana
-+utf8::InKatakana
--utf8::IsCn
-END
-}
+    {
+        local $BugId   = '7471';
+        local $Message = 'Neither ()* nor ()*? sets $1 when matched 0 times';
+        local $_       = 'CD';
+        ok /(AB)*?CD/ && !defined $1;
+        ok /(AB)*CD/  && !defined $1;
+    }
 
-sub InNotKana {
-    return <<'END';
-!utf8::InHiragana
--utf8::InKatakana
-+utf8::IsCn
-END
-}
 
-$test = 901;
+    {
+        local $BugId   = '3547';
+        local $Message = "Caching shouldn't prevent match";
+        my $pattern = "^(b+?|a){1,2}c";
+        ok "bac"    =~ /$pattern/ && $1 eq 'a';
+        ok "bbac"   =~ /$pattern/ && $1 eq 'a';
+        ok "bbbac"  =~ /$pattern/ && $1 eq 'a';
+        ok "bbbbac" =~ /$pattern/ && $1 eq 'a';
+    }
 
-print "\x{3040}" =~ /\p{InKana1}/ ? "ok $test\n" : "not ok $test\n"; $test++;
-print "\x{303F}" =~ /\P{InKana1}/ ? "ok $test\n" : "not ok $test\n"; $test++;
 
-print "\x{3040}" =~ /\p{InKana2}/ ? "ok $test\n" : "not ok $test\n"; $test++;
-print "\x{303F}" =~ /\P{InKana2}/ ? "ok $test\n" : "not ok $test\n"; $test++;
 
-print "\x{3041}" =~ /\p{InKana3}/ ? "ok $test\n" : "not ok $test\n"; $test++;
-print "\x{3040}" =~ /\P{InKana3}/ ? "ok $test\n" : "not ok $test\n"; $test++;
+    {
+        local $BugId   = '18232';
+        local $Message = '$1 should keep UTF-8 ness';
+        ok "\x{100}" =~ /(.)/;
+        iseq  $1, "\x{100}",  '$1 is UTF-8';
+        { 'a' =~ /./; }
+        iseq  $1, "\x{100}",  '$1 is still UTF-8';
+        isneq $1, "\xC4\x80", '$1 is not non-UTF-8';
+    }
 
-print "\x{3040}" =~ /\p{InNotKana}/ ? "ok $test\n" : "not ok $test\n"; $test++;
-print "\x{3041}" =~ /\P{InNotKana}/ ? "ok $test\n" : "not ok $test\n"; $test++;
 
-sub InConsonant { # Not EBCDIC-aware.
-    return <<EOF;
-0061	007f
--0061
--0065
--0069
--006f
--0075
-EOF
-}
+    {
+        local $BugId   = '19767';
+        local $Message = "Optimizer doesn't prematurely reject match";
+        use utf8;
 
-print "d" =~ /\p{InConsonant}/ ? "ok $test\n" : "not ok $test\n"; $test++;
-print "e" =~ /\P{InConsonant}/ ? "ok $test\n" : "not ok $test\n"; $test++;
-
-{
-    print "# [ID 20020630.002] utf8 regex only matches 32k\n";
-    $test = 911;
-    for ([ 'byte', "\x{ff}" ], [ 'utf8', "\x{1ff}" ]) {
-	my($type, $char) = @$_;
-	for my $len (32000, 32768, 33000) {
-	    my $s = $char . "f" x $len;
-	    my $r = $s =~ /$char([f]*)/gc;
-	    print $r ? "ok $test\n" : "not ok $test\t# <$type x $len> fail\n";
-	    ++$test;
-	    print +(!$r or pos($s) == $len + 1) ? "ok $test\n"
-		: "not ok $test\t# <$type x $len> pos @{[ pos($s) ]}\n";
-	    ++$test;
-	}
+        my $attr = 'Name-1';
+        my $NormalChar      = qr /[\p{IsDigit}\p{IsLower}\p{IsUpper}]/;
+        my $NormalWord      = qr /${NormalChar}+?/;
+        my $PredNameHyphen  = qr /^${NormalWord}(\-${NormalWord})*?$/;
+
+        $attr =~ /^$/;
+        ok $attr =~ $PredNameHyphen;  # Original test.
+
+        "a" =~ m/[b]/;
+        ok "0" =~ /\p{N}+\z/;         # Variant.
     }
-}
 
-$test = 923;
 
-$a = bless qr/foo/, 'Foo';
-print(('goodfood' =~ $a ? '' : 'not '),
-	"ok $test\t# reblessed qr// matches\n");
-++$test;
+    {
+        local $BugId   = '20683';
+        local $Message = "(??{ }) doesn't return stale values";
+        our $p = 1;
+        foreach (1, 2, 3, 4) {
+            $p ++ if /(??{ $p })/
+        }
+        iseq $p, 5;
 
-print(($a eq '(?-xism:foo)' ? '' : 'not '),
-	"ok $test\t# reblessed qr// stringizes\n");
-++$test;
+        {
+            package P;
+            $a = 1;
+            sub TIESCALAR {bless []}
+            sub FETCH     {$a ++}
+        }
+        tie $p, "P";
+        foreach (1, 2, 3, 4) {
+            /(??{ $p })/
+        }
+        iseq $p, 5;
+    }
 
-$x = "\x{3fe}";
-$z=$y = "\317\276"; # $y is byte representation of $x
 
-$a = qr/$x/;
-print(($x =~ $a ? '' : 'not '), "ok $test - utf8 interpolation in qr//\n");
-++$test;
+    {
+        # Subject: Odd regexp behavior
+        # From: Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk>
+        # Date: Wed, 26 Feb 2003 16:53:12 +0000
+        # Message-Id: <E18o4nw-0008Ly-00@wisbech.cl.cam.ac.uk>
+        # To: perl-unicode@perl.org
 
-print(("a$a" =~ $x ? '' : 'not '),
-      "ok $test - stringifed qr// preserves utf8\n");
-++$test;
+        local $Message = 'Markus Kuhn 2003-02-26';
+    
+        my $x = "\x{2019}\nk";
+        ok $x =~ s/(\S)\n(\S)/$1 $2/sg;
+        ok $x eq "\x{2019} k";
 
-print(("a$x" =~ /^a$a\z/ ? '' : 'not '),
-      "ok $test - interpolated qr// preserves utf8\n");
-++$test;
+        $x = "b\nk";
+        ok $x =~ s/(\S)\n(\S)/$1 $2/sg;
+        ok $x eq "b k";
 
-print(("a$x" =~ /^a(??{$a})\z/ ? '' : 'not '),
-      "ok $test - postponed interpolation of qr// preserves utf8\n");
-++$test;
+        ok "\x{2019}" =~ /\S/;
+    }
 
-print((length(qr/##/x) == 12 ? '' : 'not '),
-      "ok $test - ## in qr// doesn't corrupt memory [perl #17776]\n");
-++$test;
 
-{ use re 'eval';
+    {
+        local $BugId = '21411';
+        local $Message = "(??{ .. }) in split doesn't corrupt its stack";
+        our $i;
+        ok '-1-3-5-' eq join '', split /((??{$i++}))/, '-1-3-5-';
+        no warnings 'deprecated', 'syntax';
+        split /(?{'WOW'})/, 'abc';
+        local $" = "|";
+        iseq "@_", "a|b|c";
+    }
 
-print(("$x$x" =~ /^$x(??{$x})\z/ ? '' : 'not '),
-      "ok $test - postponed utf8 string in utf8 re matches utf8\n");
-++$test;
 
-print(("$y$x" =~ /^$y(??{$x})\z/ ? '' : 'not '),
-      "ok $test - postponed utf8 string in non-utf8 re matches utf8\n");
-++$test;
+    {
+        # XXX DAPM 13-Apr-06. Recursive split is still broken. It's only luck it
+        # hasn't been crashing. Disable this test until it is fixed properly.
+        # XXX also check what it returns rather than just doing ok(1,...)
+        # split /(?{ split "" })/, "abc";
+        local $TODO = "Recursive split is still broken";
+        ok 0, 'cache_re & "(?{": it dumps core in 5.6.1 & 5.8.0';
+    }
 
-print(("$y$x" !~ /^$y(??{$y})\z/ ? '' : 'not '),
-      "ok $test - postponed non-utf8 string in non-utf8 re doesn't match utf8\n");
-++$test;
 
-print(("$x$x" !~ /^$x(??{$y})\z/ ? '' : 'not '),
-      "ok $test - postponed non-utf8 string in utf8 re doesn't match utf8\n");
-++$test;
+    {
+        ok "\x{100}\n" =~ /\x{100}\n$/, "UTF-8 length cache and fbm_compile";
+    }
 
-print(("$y$y" =~ /^$y(??{$y})\z/ ? '' : 'not '),
-      "ok $test - postponed non-utf8 string in non-utf8 re matches non-utf8\n");
-++$test;
 
-print(("$x$y" =~ /^$x(??{$y})\z/ ? '' : 'not '),
-      "ok $test - postponed non-utf8 string in utf8 re matches non-utf8\n");
-++$test;
-$y = $z; # reset $y after upgrade
+    {
+        package Str;
+        use overload q /""/ => sub {${$_ [0]};};
+        sub new {my ($c, $v) = @_; bless \$v, $c;}
 
-print(("$x$y" !~ /^$x(??{$x})\z/ ? '' : 'not '),
-      "ok $test - postponed utf8 string in utf8 re doesn't match non-utf8\n");
-++$test;
-$y = $z; # reset $y after upgrade
+        package main;
+        $_ = Str -> new ("a\x{100}/\x{100}b");
+        ok join (":", /\b(.)\x{100}/g) eq "a:/", "re_intuit_start and PL_bostr";
+    }
 
-print(("$y$y" !~ /^$y(??{$x})\z/ ? '' : 'not '),
-      "ok $test - postponed utf8 string in non-utf8 re doesn't match non-utf8\n");
-++$test;
 
-} # no re 'eval'
+    {
+        local $BugId = '17757';
+        $_ = "code:   'x' { '...' }\n"; study;
+        my @x; push @x, $& while m/'[^\']*'/gx;
+        local $" = ":";
+        iseq "@x", "'x':'...'", "Parse::RecDescent triggered infinite loop";
+    }
 
-print "# more user-defined character properties\n";
 
-sub IsSyriac1 {
-    return <<'END';
-0712	072C
-0730	074A
-END
-}
+    {
+        my $re = qq /^([^X]*)X/;
+        utf8::upgrade ($re);
+        ok "\x{100}X" =~ /$re/, "S_cl_and ANYOF_UNICODE & ANYOF_INVERTED";
+    }
 
-ok("\x{0712}" =~ /\p{IsSyriac1}/, '\x{0712}, \p{IsSyriac1}');
-ok("\x{072F}" =~ /\P{IsSyriac1}/, '\x{072F}, \P{IsSyriac1}');
 
-sub Syriac1 {
-    return <<'END';
-0712	072C
-0730	074A
-END
-}
+    {
+        local $BugId = '22354';
+        sub func ($) {
+            ok "a\nb" !~ /^b/,  "Propagated modifier; $_[0]";
+            ok "a\nb" =~ /^b/m, "Propagated modifier; $_[0] - with /m";
+        }
+        func "standalone";
+        $_ = "x"; s/x/func "in subst"/e;
+        $_ = "x"; s/x/func "in multiline subst"/em;
+
+        #
+        # Next two give 'panic: malloc'.
+        # Outcommented, using two TODOs.
+        #
+        local $TODO    = 'panic: malloc';
+        local $Message = 'Postponed regexp and propaged modifier';
+      # ok 0 for 1 .. 2;
+      SKIP: {
+            skip "panic: malloc", 2;
+            $_ = "x"; /x(?{func "in regexp"})/;
+            $_ = "x"; /x(?{func "in multiline regexp"})/m;
+        }
+    }
 
-ok("\x{0712}" =~ /\p{Syriac1}/, '\x{0712}, \p{Syriac1}');
-ok("\x{072F}" =~ /\P{Syriac1}/, '\x{072F}, \p{Syriac1}');
 
-print "# user-defined character properties may lack \\n at the end\n";
-sub InGreekSmall   { return "03B1\t03C9" }
-sub InGreekCapital { return "0391\t03A9\n-03A2" }
+    {
+        local $BugId = '19049';
+        $_    = "abcdef\n";
+        my @x = m/./g;
+        iseq "abcde", $`, 'Global match sets $`';
+    }
 
-ok("\x{03C0}" =~ /\p{InGreekSmall}/,   "Small pi");
-ok("\x{03C2}" =~ /\p{InGreekSmall}/,   "Final sigma");
-ok("\x{03A0}" =~ /\p{InGreekCapital}/, "Capital PI");
-ok("\x{03A2}" =~ /\P{InGreekCapital}/, "Reserved");
 
-sub AsciiHexAndDash {
-    return <<'END';
-+utf8::ASCII_Hex_Digit
-+utf8::Dash
-END
-}
+    {
+        ok "123\x{100}" =~ /^.*1.*23\x{100}$/,
+           'UTF-8 + multiple floating substr';
+    }
 
-ok("-" =~ /\p{Dash}/,            "'-' is Dash");
-ok("A" =~ /\p{ASCII_Hex_Digit}/, "'A' is ASCII_Hex_Digit");
-ok("-" =~ /\p{AsciiHexAndDash}/, "'-' is AsciiHexAndDash");
-ok("A" =~ /\p{AsciiHexAndDash}/, "'A' is AsciiHexAndDash");
-
-{
-    print "# Change #18179\n";
-    # previously failed with "panic: end_shift
-    my $s = "\x{100}" x 5;
-    my $ok = $s =~ /(\x{100}{4})/;
-    my($ord, $len) = (ord $1, length $1);
-    print +($ok && $ord == 0x100 && $len == 4)
-	    ? "ok $test\n" : "not ok $test\t# [#18179] $ok/$ord/$len\n";
-    ++$test;
-}
 
-{
-    print "# [perl #15763]\n";
+    {
+        local $Message = '<20030808193656.5109.1@llama.ni-s.u-net.com>';
+
+        # LATIN SMALL/CAPITAL LETTER A WITH MACRON
+        ok "  \x{101}" =~ qr/\x{100}/i;
 
-    $a = "x\x{100}";
-    chop $a; # but leaves the UTF-8 flag
-    $a .= "y"; # 1 byte before "y"
+        # LATIN SMALL/CAPITAL LETTER A WITH RING BELOW
+        ok "  \x{1E01}" =~ qr/\x{1E00}/i;
 
-    ok($a =~ /^\C/,      'match one \C on 1-byte UTF-8');
-    ok($a =~ /^\C{1}/,   'match \C{1}');
+        # DESERET SMALL/CAPITAL LETTER LONG I
+        ok "  \x{10428}" =~ qr/\x{10400}/i;
 
-    ok($a =~ /^\Cy/,      'match \Cy');
-    ok($a =~ /^\C{1}y/,   'match \C{1}y');
+        # LATIN SMALL/CAPITAL LETTER A WITH RING BELOW + 'X'
+        ok "  \x{1E01}x" =~ qr/\x{1E00}X/i;
+    }
 
-    $a = "\x{100}y"; # 2 bytes before "y"
 
-    ok($a =~ /^\C/,       'match one \C on 2-byte UTF-8');
-    ok($a =~ /^\C{1}/,    'match \C{1}');
-    ok($a =~ /^\C\C/,     'match two \C');
-    ok($a =~ /^\C{2}/,    'match \C{2}');
+    {
+        # [perl #23769] Unicode regex broken on simple example
+        # regrepeat() didn't handle UTF-8 EXACT case right.
+        local $BugId   = '23769';
+        my $Mess       = 'regrepeat() handles UTF-8 EXACT case right';
+        local $Message = $Mess;
 
-    ok($a =~ /^\C\C\C/,    'match three \C on 2-byte UTF-8 and a byte');
-    ok($a =~ /^\C{3}/,     'match \C{3}');
+        my $s = "\x{a0}\x{a0}\x{a0}\x{100}"; chop $s;
 
-    ok($a =~ /^\C\Cy/,     'match two \C');
-    ok($a =~ /^\C{2}y/,    'match \C{2}');
+        ok $s =~ /\x{a0}/;
+        ok $s =~ /\x{a0}+/;
+        ok $s =~ /\x{a0}\x{a0}/;
 
-    ok($a !~ /^\C\C\Cy/,    q{don't match three \Cy});
-    ok($a !~ /^\C{2}\Cy/,   q{don't match \C{3}y});
+        $Message = "$Mess (easy variant)";
+        ok "aaa\x{100}" =~ /(a+)/;
+        iseq $1, "aaa";
 
-    $a = "\x{1000}y"; # 3 bytes before "y"
+        $Message = "$Mess (easy invariant)";
+        ok "aaa\x{100}     " =~ /(a+?)/;
+        iseq $1, "a";
 
-    ok($a =~ /^\C/,         'match one \C on three-byte UTF-8');
-    ok($a =~ /^\C{1}/,      'match \C{1}');
-    ok($a =~ /^\C\C/,       'match two \C');
-    ok($a =~ /^\C{2}/,      'match \C{2}');
-    ok($a =~ /^\C\C\C/,     'match three \C');
-    ok($a =~ /^\C{3}/,      'match \C{3}');
+        $Message = "$Mess (regrepeat variant)";
+        ok "\xa0\xa0\xa0\x{100}    " =~ /(\xa0+?)/;
+        iseq $1, "\xa0";
 
-    ok($a =~ /^\C\C\C\C/,   'match four \C on three-byte UTF-8 and a byte');
-    ok($a =~ /^\C{4}/,      'match \C{4}');
+        $Message = "$Mess (regrepeat invariant)";
+        ok "\xa0\xa0\xa0\x{100}" =~ /(\xa0+)/;
+        iseq $1, "\xa0\xa0\xa0";
 
-    ok($a =~ /^\C\C\Cy/,    'match three \Cy');
-    ok($a =~ /^\C{3}y/,     'match \C{3}y');
+        $Message = "$Mess (hard variant)";
+        ok "\xa0\xa1\xa0\xa1\xa0\xa1\x{100}" =~ /((?:\xa0\xa1)+?)/;
+        iseq $1, "\xa0\xa1";
 
-    ok($a !~ /^\C\C\C\C\y/, q{don't match four \Cy});
-    ok($a !~ /^\C{4}y/,     q{don't match \C{4}y});
-}
+        $Message = "$Mess (hard invariant)";
+        ok "ababab\x{100}  " =~ /((?:ab)+)/;
+        iseq $1, 'ababab';
 
-$_ = 'aaaaaaaaaa';
-utf8::upgrade($_); chop $_; $\="\n";
-ok(/[^\s]+/, "m/[^\s]/ utf8");
-ok(/[^\d]+/, "m/[^\d]/ utf8");
-ok(($a = $_, $_ =~ s/[^\s]+/./g), "s/[^\s]/ utf8");
-ok(($a = $_, $a =~ s/[^\d]+/./g), "s/[^\s]/ utf8");
-
-ok("\x{100}" =~ /\x{100}/, "[perl #15397]");
-ok("\x{100}" =~ /(\x{100})/, "[perl #15397]");
-ok("\x{100}" =~ /(\x{100}){1}/, "[perl #15397]");
-ok("\x{100}\x{100}" =~ /(\x{100}){2}/, "[perl #15397]");
-ok("\x{100}\x{100}" =~ /(\x{100})(\x{100})/, "[perl #15397]");
-
-$x = "CD";
-$x =~ /(AB)*?CD/;
-ok(!defined $1, "[perl #7471]");
-
-$x = "CD";
-$x =~ /(AB)*CD/;
-ok(!defined $1, "[perl #7471]");
-
-$pattern = "^(b+?|a){1,2}c";
-ok("bac"    =~ /$pattern/ && $1 eq 'a', "[perl #3547]");
-ok("bbac"   =~ /$pattern/ && $1 eq 'a', "[perl #3547]");
-ok("bbbac"  =~ /$pattern/ && $1 eq 'a', "[perl #3547]");
-ok("bbbbac" =~ /$pattern/ && $1 eq 'a', "[perl #3547]");
-
-{
-    # [perl #18232]
-    "\x{100}" =~ /(.)/;
-    ok( $1 eq "\x{100}", '$1 is utf-8 [perl #18232]' );
-    { 'a' =~ /./; }
-    ok( $1 eq "\x{100}", '$1 is still utf-8' );
-    ok( $1 ne "\xC4\x80", '$1 is not non-utf-8' );
-}
+        ok "\xa0\xa1\xa0\xa1\xa0\xa1\x{100}" =~ /((?:\xa0\xa1)+)/;
+        iseq $1, "\xa0\xa1\xa0\xa1\xa0\xa1";
 
-{
-    use utf8;
-    my $attr = 'Name-1' ;
+        ok "ababab\x{100}  " =~ /((?:ab)+?)/;
+        iseq $1, "ab";
 
-    my $NormalChar          = qr/[\p{IsDigit}\p{IsLower}\p{IsUpper}]/;
-    my $NormalWord          = qr/${NormalChar}+?/;
-    my $PredNameHyphen      = qr/^${NormalWord}(\-${NormalWord})*?$/;
+        $Message = "Don't match first byte of UTF-8 representation";
+        ok "\xc4\xc4\xc4" !~ /(\x{100}+)/;
+        ok "\xc4\xc4\xc4" !~ /(\x{100}+?)/;
+        ok "\xc4\xc4\xc4" !~ /(\x{100}++)/;
+    }
 
-    $attr =~ /^$/;
-    ok( $attr =~ $PredNameHyphen, "[perl #19767] original test" );
-}
 
-{
-    use utf8;
-    "a" =~ m/[b]/;
-    ok ( "0" =~ /\p{N}+\z/, "[perl #19767] variant test" );
-}
+    {
+        for (120 .. 130) {
+            my $head = 'x' x $_;
+            local $Message = q [Don't misparse \x{...} in regexp ] .
+                             q [near 127 char EXACT limit];
+            for my $tail ('\x{0061}', '\x{1234}', '\x61') {
+                eval_ok qq ["$head$tail" =~ /$head$tail/];
+            }
+            local $Message = q [Don't misparse \N{...} in regexp ] .
+                             q [near 127 char EXACT limit];
+            for my $tail ('\N{SNOWFLAKE}') {
+                eval_ok qq [use charnames ':full';
+                           "$head$tail" =~ /$head$tail/];
+            }
+        }
+    }
 
-{
 
-    $p = 1;
-    foreach (1,2,3,4) {
-	    $p++ if /(??{ $p })/
+    {
+        # perl panic: pp_match start/end pointers
+        local $BugId = '25269';
+        iseq "a-bc", eval {my ($x, $y) = "bca" =~ /^(?=.*(a)).*(bc)/; "$x-$y"},
+             'Captures can move backwards in string';
     }
-    ok ($p == 5, "[perl #20683] (??{ }) returns stale values");
-    { package P; $a=1; sub TIESCALAR { bless[] } sub FETCH { $a++ } }
-    tie $p, P;
-    foreach (1,2,3,4) {
-	    /(??{ $p })/
+
+
+    {
+        local $BugId   = '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';
+        ok "ab" !~ /a\cIb/x, '\cI in pattern';
     }
-    ok ( $p == 5, "(??{ }) returns stale values");
-}
 
-{
-  # Subject: Odd regexp behavior
-  # From: Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk>
-  # Date: Wed, 26 Feb 2003 16:53:12 +0000
-  # Message-Id: <E18o4nw-0008Ly-00@wisbech.cl.cam.ac.uk>
-  # To: perl-unicode@perl.org
-    
-  $x = "\x{2019}\nk"; $x =~ s/(\S)\n(\S)/$1 $2/sg;
-  ok($x eq "\x{2019} k", "Markus Kuhn 2003-02-26");
 
-  $x = "b\nk"; $x =~ s/(\S)\n(\S)/$1 $2/sg;
-  ok($x eq "b k", "Markus Kuhn 2003-02-26");
+    {
+        # perl #28532: optional zero-width match at end of string is ignored
+        local $BugId = '28532';
+        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';
+    }
 
-  ok("\x{2019}" =~ /\S/, "Markus Kuhn 2003-02-26");
-}
 
-{
-    my $i;
-    ok('-1-3-5-' eq join('', split /((??{$i++}))/, '-1-3-5-'),
-	"[perl #21411] (??{ .. }) corrupts split's stack");
-    split /(?{'WOW'})/, 'abc';
-    ok('a|b|c' eq join ('|', @_),
-       "[perl #21411] (?{ .. }) version of the above");
-}
 
-{
-    # XXX DAPM 13-Apr-06. Recursive split is still broken. It's only luck it
-    # hasn't been crashing. Disable this test until it is fixed properly.
-    # XXX also check what it returns rather than just doing ok(1,...)
-    # split /(?{ split "" })/, "abc";
-    ok(1,'cache_re & "(?{": it dumps core in 5.6.1 & 5.8.0');
-}
+    {   # TRIE related
+        our @got = ();
+        "words" =~ /(word|word|word)(?{push @got, $1})s$/;
+        iseq @got, 1, "TRIE optimation";
 
-{
-    ok("\x{100}\n" =~ /\x{100}\n$/, "UTF8 length cache and fbm_compile");  
-}
+        @got = ();
+        "words" =~ /(word|word|word)(?{push @got,$1})s$/i;
+        iseq @got, 1,"TRIEF optimisation";
 
-{
-    package Str;
-    use overload q/""/ => sub { ${$_[0]}; };
-    sub new { my ($c, $v) = @_; bless \$v, $c; }
+        my @nums = map {int rand 1000} 1 .. 100;
+        my $re = "(" . (join "|", @nums) . ")";
+        $re = qr/\b$re\b/;
 
-    package main;
-    $_ = Str->new("a\x{100}/\x{100}b");
-    ok(join(":", /\b(.)\x{100}/g) eq "a:/", "re_intuit_start and PL_bostr");
-}
+        foreach (@nums) {
+            ok $_ =~ /$re/, "Trie nums";
+        }
 
-{
-    $_ = "code:   'x' { '...' }\n"; study;
-    my @x; push @x, $& while m/'[^\']*'/gx;
-    ok(join(":", @x) eq "'x':'...'",
-       "[perl #17757] Parse::RecDescent triggers infinite loop");
-}
+        $_ = join " ", @nums;
+        @got = ();
+        push @got, $1 while /$re/g;
 
-{
-    my $re = qq/^([^X]*)X/;
-    utf8::upgrade($re);
-    ok("\x{100}X" =~ /$re/, "S_cl_and ANYOF_UNICODE & ANYOF_INVERTED");
-}
+        my %count;
+        $count {$_} ++ for @got;
+        my $ok = 1;
+        for (@nums) {
+            $ok = 0 if --$count {$_} < 0;
+        }
+        ok $ok, "Trie min count matches";
+    }
 
-# bug #22354
-sub func ($) {
-    ok( "a\nb" !~ /^b/, $_[0] );
-    ok( "a\nb" =~ /^b/m, "$_[0] - with /m" );
-}
-func "standalone";
-$_ = "x"; s/x/func "in subst"/e;
-$_ = "x"; s/x/func "in multiline subst"/em;
-#$_ = "x"; /x(?{func "in regexp"})/;
-#$_ = "x"; /x(?{func "in multiline regexp"})/m;
 
-# bug RT#19049
-$_="abcdef\n";
-@x = m/./g;
-ok("abcde" eq "$`", 'RT#19049 - global match not setting $`');
+    {
+        # TRIE related
+        # LATIN SMALL/CAPITAL LETTER A WITH MACRON
+        ok "foba  \x{101}foo" =~ qr/(foo|\x{100}foo|bar)/i &&
+           $1 eq "\x{101}foo",
+           "TRIEF + LATIN SMALL/CAPITAL LETTER A WITH MACRON";
+
+        # LATIN SMALL/CAPITAL LETTER A WITH RING BELOW
+        ok "foba  \x{1E01}foo" =~ qr/(foo|\x{1E00}foo|bar)/i &&
+           $1 eq "\x{1E01}foo",
+           "TRIEF + LATIN SMALL/CAPITAL LETTER A WITH RING BELOW";
+
+        # DESERET SMALL/CAPITAL LETTER LONG I
+        ok "foba  \x{10428}foo" =~ qr/(foo|\x{10400}foo|bar)/i &&
+           $1 eq "\x{10428}foo",
+           "TRIEF + DESERET SMALL/CAPITAL LETTER LONG I";
+
+        # LATIN SMALL/CAPITAL LETTER A WITH RING BELOW + 'X'
+        ok "foba  \x{1E01}xfoo" =~ qr/(foo|\x{1E00}Xfoo|bar)/i &&
+           $1 eq "\x{1E01}xfoo",
+           "TRIEF + LATIN SMALL/CAPITAL LETTER A WITH RING BELOW + 'X'";
+
+        use charnames ':full';
+
+        my $s = "\N{LATIN SMALL LETTER SHARP S}";
+        ok "foba  ba$s" =~ qr/(foo|Ba$s|bar)/i &&  $1 eq "ba$s",
+           "TRIEF + LATIN SMALL LETTER SHARP S =~ ss";
+        ok "foba  ba$s" =~ qr/(Ba$s|foo|bar)/i &&  $1 eq "ba$s",
+           "TRIEF + LATIN SMALL LETTER SHARP S =~ ss";
+        ok "foba  ba$s" =~ qr/(foo|bar|Ba$s)/i &&  $1 eq "ba$s",
+           "TRIEF + LATIN SMALL LETTER SHARP S =~ ss";
+
+        ok "foba  ba$s" =~ qr/(foo|Bass|bar)/i &&  $1 eq "ba$s",
+           "TRIEF + LATIN SMALL LETTER SHARP S =~ ss";
+
+        ok "foba  ba$s" =~ qr/(foo|BaSS|bar)/i &&  $1 eq "ba$s",
+           "TRIEF + LATIN SMALL LETTER SHARP S =~ SS";
+
+        ok "foba  ba${s}pxySS$s$s" =~ qr/(b(?:a${s}t|a${s}f|a${s}p)[xy]+$s*)/i
+            &&  $1 eq "ba${s}pxySS$s$s",
+           "COMMON PREFIX TRIEF + LATIN SMALL LETTER SHARP S";
+    }
 
-ok("123\x{100}" =~ /^.*1.*23\x{100}$/, 'uft8 + multiple floating substr');
 
-# LATIN SMALL/CAPITAL LETTER A WITH MACRON
-ok("  \x{101}" =~ qr/\x{100}/i,
-   "<20030808193656.5109.1@llama.ni-s.u-net.com>");
+  SKIP:
+    {
+        print "# Set PERL_SKIP_PSYCHO_TEST to skip this test\n";
+        my @normal = qw [the are some normal words];
 
-# LATIN SMALL/CAPITAL LETTER A WITH RING BELOW
-ok("  \x{1E01}" =~ qr/\x{1E00}/i,
-   "<20030808193656.5109.1@llama.ni-s.u-net.com>");
+        skip "Skipped Psycho", 2 * @normal if $ENV {PERL_SKIP_PSYCHO_TEST};
 
-# DESERET SMALL/CAPITAL LETTER LONG I
-ok("  \x{10428}" =~ qr/\x{10400}/i,
-   "<20030808193656.5109.1@llama.ni-s.u-net.com>");
+        local $" = "|";
 
-# LATIN SMALL/CAPITAL LETTER A WITH RING BELOW + 'X'
-ok("  \x{1E01}x" =~ qr/\x{1E00}X/i,
-   "<20030808193656.5109.1@llama.ni-s.u-net.com>");
+        my @psycho = (@normal, map chr $_, 255 .. 20000);
+        my $psycho1 = "@psycho";
+        for (my $i = @psycho; -- $i;) {
+            my $j = int rand (1 + $i);
+            @psycho [$i, $j] = @psycho [$j, $i];
+        }
+        my $psycho2 = "@psycho";
 
-{
-    # [perl #23769] Unicode regex broken on simple example
-    # regrepeat() didn't handle UTF-8 EXACT case right.
+        foreach my $word (@normal) {
+            ok $word =~ /($psycho1)/ && $1 eq $word, 'Psycho';
+            ok $word =~ /($psycho2)/ && $1 eq $word, 'Psycho';
+        }
+    }
 
-    my $s = "\x{a0}\x{a0}\x{a0}\x{100}"; chop $s;
 
-    ok($s =~ /\x{a0}/,       "[perl #23769]");
-    ok($s =~ /\x{a0}+/,      "[perl #23769]");
-    ok($s =~ /\x{a0}\x{a0}/, "[perl #23769]");
+    {
+        local $BugId = '36207';
+        my $utf8 = "\xe9\x{100}"; chop $utf8;
+        my $latin1 = "\xe9";
+
+        ok $utf8 =~ /\xe9/i, "utf8/latin";
+        ok $utf8 =~ /$latin1/i, "utf8/latin runtime";
+        ok $utf8 =~ /(abc|\xe9)/i, "utf8/latin trie";
+        ok $utf8 =~ /(abc|$latin1)/i, "utf8/latin trie runtime";
+
+        ok "\xe9" =~ /$utf8/i, "latin/utf8";
+        ok "\xe9" =~ /(abc|$utf8)/i, "latin/utf8 trie";
+        ok $latin1 =~ /$utf8/i, "latin/utf8 runtime";
+        ok $latin1 =~ /(abc|$utf8)/i, "latin/utf8 trie runtime";
+    }
 
-    ok("aaa\x{100}" =~ /(a+)/, "[perl #23769] easy invariant");
-    ok($1 eq "aaa", "[perl #23769]");
 
-    ok("\xa0\xa0\xa0\x{100}" =~ /(\xa0+)/, "[perl #23769] regrepeat invariant");
-    ok($1 eq "\xa0\xa0\xa0", "[perl #23769]");
+    {
+        local $BugId = '37038';
+        my $s = "abcd";
+        $s =~ /(..)(..)/g;
+        $s = $1;
+        $s = $2;
+        iseq $2, 'cd',
+             "Assigning to original string does not corrupt match vars";
+    }
 
-    ok("ababab\x{100}  " =~ /((?:ab)+)/, "[perl #23769] hard invariant");
-    ok($1 eq "ababab", "[perl #23769]");
 
-    ok("\xa0\xa1\xa0\xa1\xa0\xa1\x{100}" =~ /((?:\xa0\xa1)+)/, "[perl #23769] hard variant");
-    ok($1 eq "\xa0\xa1\xa0\xa1\xa0\xa1", "[perl #23769]");
+    {
+        {
+            package wooosh;
+            sub gloople {"!"}
+        }
+        my $aeek = bless {} => 'wooosh';
+        eval_ok sub {$aeek -> gloople () =~ /(.)/g},
+               "//g match against return value of sub";
 
-    ok("aaa\x{100}     " =~ /(a+?)/, "[perl #23769] easy invariant");
-    ok($1 eq "a", "[perl #23769]");
+        sub gloople {"!"}
+        eval_ok sub {gloople () =~ /(.)/g},
+               "26410 didn't affect sub calls for some reason";
+    }
 
-    ok("\xa0\xa0\xa0\x{100}    " =~ /(\xa0+?)/, "[perl #23769] regrepeat variant");
-    ok($1 eq "\xa0", "[perl #23769]");
 
-    ok("ababab\x{100}  " =~ /((?:ab)+?)/, "[perl #23769] hard invariant");
-    ok($1 eq "ab", "[perl #23769]");
+    {
+        local $TODO = "See changes 26925-26928, which reverted change 26410";
+        {
+            package lv;
+            our $var = "abc";
+            sub variable : lvalue {$var}
+        }
+        my $o = bless [] => 'lv';
+        my $f = "";
+        my $r = eval {
+            for (1 .. 2) {
+                $f .= $1 if $o -> variable =~ /(.)/g;
+            }
+            1;
+        };
+        if ($r) {
+            iseq $f, "ab", "pos() retained between calls";
+        }
+        else {
+            local $TODO;
+            ok 0, "Code failed: $@";
+        }
 
-    ok("\xa0\xa1\xa0\xa1\xa0\xa1\x{100}" =~ /((?:\xa0\xa1)+?)/, "[perl #23769] hard variant");
-    ok($1 eq "\xa0\xa1", "[perl #23769]");
+        our $var = "abc";
+        sub variable : lvalue {$var}
+        my $g = "";
+        my $s = eval {
+            for (1 .. 2) {
+                $g .= $1 if variable =~ /(.)/g;
+            }
+            1;
+        };
+        if ($s) {
+            iseq $g, "ab", "pos() retained between calls";
+        }
+        else {
+            local $TODO;
+            ok 0, "Code failed: $@";
+        }
+    }
 
-    ok("\xc4\xc4\xc4" !~ /(\x{100}+)/, "[perl #23769] don't match first byte of utf8 representation");
-    ok("\xc4\xc4\xc4" !~ /(\x{100}+?)/, "[perl #23769] don't match first byte of utf8 representation");
-}
 
-for (120 .. 130) {
-    my $head = 'x' x $_;
-    for my $tail ('\x{0061}', '\x{1234}') {
-	ok(
-	    eval qq{ "$head$tail" =~ /$head$tail/ },
-	    '\x{...} misparsed in regexp near 127 char EXACT limit'
-	);
+  SKIP:
+    {
+        local $BugId = '37836';
+        skip "In EBCDIC" if $IS_EBCDIC;
+        no warnings 'utf8';
+        $_ = pack 'U0C2', 0xa2, 0xf8;  # Ill-formed UTF-8
+        my $ret = 0;
+        eval_ok sub {!($ret = s/[\0]+//g)},
+                "Ill-formed UTF-8 doesn't match NUL in class";
     }
-}
 
-# 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');
-ok("ab" !~ /a\cIb/x, '\cI 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');
-
-
-
-{ # TRIE related
-    my @got=();
-    "words"=~/(word|word|word)(?{push @got,$1})s$/;
-    ok(@got==1,"TRIE optimation is working") or warn "# @got";
-    @got=();
-    "words"=~/(word|word|word)(?{push @got,$1})s$/i;
-    ok(@got==1,"TRIEF optimisation is working") or warn "# @got";
-
-    my @nums=map {int rand 1000} 1..100;
-    my $re="(".(join "|",@nums).")";
-    $re=qr/\b$re\b/;
-
-    foreach (@nums) {
-        ok($_=~/$re/,"Trie nums");
-    }
-    $_=join " ", @nums;
-    @got=();
-    push @got,$1 while /$re/g;
-
-    my %count;
-    $count{$_}++ for @got;
-    my $ok=1;
-    for (@nums) {
-        $ok=0 if --$count{$_}<0;
-    }
-    ok($ok,"Trie min count matches");
-}
 
+    {
+        # chr(65535) should be allowed in regexes
+        local $BugId = '38293';
+        no warnings 'utf8'; # To allow non-characters
+        my ($c, $r, $s);
+
+        $c = chr 0xffff;
+        $c =~ s/$c//g;
+        ok $c eq "", "U+FFFF, parsed as atom";
+
+        $c = chr 0xffff;
+        $r = "\\$c";
+        $c =~ s/$r//g;
+        ok $c eq "", "U+FFFF backslashed, parsed as atom";
+
+        $c = chr 0xffff;
+        $c =~ s/[$c]//g;
+        ok $c eq "", "U+FFFF, parsed in class";
+
+        $c = chr 0xffff;
+        $r = "[\\$c]";
+        $c =~ s/$r//g;
+        ok $c eq "", "U+FFFF backslashed, parsed in class";
+
+        $s = "A\x{ffff}B";
+        $s =~ s/\x{ffff}//i;
+        ok $s eq "AB", "U+FFFF, EXACTF";
+
+        $s = "\x{ffff}A";
+        $s =~ s/\bA//;
+        ok $s eq "\x{ffff}", "U+FFFF, BOUND";
+
+        $s = "\x{ffff}!";
+        $s =~ s/\B!//;
+        ok $s eq "\x{ffff}", "U+FFFF, NBOUND";
+    }
 
-# TRIE related
-# LATIN SMALL/CAPITAL LETTER A WITH MACRON
-ok(("foba  \x{101}foo" =~ qr/(foo|\x{100}foo|bar)/i) && $1 eq "\x{101}foo",
-   "TRIEF + LATIN SMALL/CAPITAL LETTER A WITH MACRON");
 
-# LATIN SMALL/CAPITAL LETTER A WITH RING BELOW
-ok(("foba  \x{1E01}foo" =~ qr/(foo|\x{1E00}foo|bar)/i) && $1 eq "\x{1E01}foo",
-   "TRIEF + LATIN SMALL/CAPITAL LETTER A WITH RING BELOW");
+    {
+        local $BugId = '39583';
+        
+        # The printing characters
+        my @chars = ("A" .. "Z");
+        my $delim = ",";
+        my $size = 32771 - 4;
+        my $str = '';
+
+        # Create some random junk. Inefficient, but it works.
+        for (my $i = 0; $i < $size; $ i++) {
+            $str .= $chars [rand @chars];
+        }
 
-# DESERET SMALL/CAPITAL LETTER LONG I
-ok(("foba  \x{10428}foo" =~ qr/(foo|\x{10400}foo|bar)/i) &&  $1 eq "\x{10428}foo",
-   "TRIEF + DESERET SMALL/CAPITAL LETTER LONG I");
+        $str .= ($delim x 4);
+        my $res;
+        my $matched;
+        ok $str =~ s/^(.*?)${delim}{4}//s, "Pattern matches";
+        iseq $str, "", "Empty string";
+        ok defined $1 && length ($1) == $size, '$1 is correct size';
+    }
 
-# LATIN SMALL/CAPITAL LETTER A WITH RING BELOW + 'X'
-ok(("foba  \x{1E01}xfoo" =~ qr/(foo|\x{1E00}Xfoo|bar)/i) &&  $1 eq "\x{1E01}xfoo",
-   "TRIEF + LATIN SMALL/CAPITAL LETTER A WITH RING BELOW + 'X'");
 
-{# TRIE related
+    {
+        local $BugId = '27940';
+        ok "\0-A"  =~ /\c@-A/, '@- should not be interpolated in a pattern';
+        ok "\0\0A" =~ /\c@+A/, '@+ should not be interpolated in a pattern';
+        ok "X\@-A"  =~ /X@-A/, '@- should not be interpolated in a pattern';
+        ok "X\@\@A" =~ /X@+A/, '@+ should not be interpolated in a pattern';
+
+        ok "X\0A" =~ /X\c@?A/,  '\c@?';
+        ok "X\0A" =~ /X\c@*A/,  '\c@*';
+        ok "X\0A" =~ /X\c@(A)/, '\c@(';
+        ok "X\0A" =~ /X(\c@)A/, '\c@)';
+        ok "X\0A" =~ /X\c@|ZA/, '\c@|';
+
+        ok "X\@A" =~ /X@?A/,  '@?';
+        ok "X\@A" =~ /X@*A/,  '@*';
+        ok "X\@A" =~ /X@(A)/, '@(';
+        ok "X\@A" =~ /X(@)A/, '@)';
+        ok "X\@A" =~ /X@|ZA/, '@|';
+
+        local $" = ','; # non-whitespace and non-RE-specific
+        ok 'abc' =~ /(.)(.)(.)/, 'The last successful match is bogus';
+        ok "A@+B"  =~ /A@{+}B/,  'Interpolation of @+ in /@{+}/';
+        ok "A@-B"  =~ /A@{-}B/,  'Interpolation of @- in /@{-}/';
+        ok "A@+B"  =~ /A@{+}B/x, 'Interpolation of @+ in /@{+}/x';
+        ok "A@-B"  =~ /A@{-}B/x, 'Interpolation of @- in /@{-}/x';
+    }
 
-use charnames ':full';
 
-$s="\N{LATIN SMALL LETTER SHARP S}";
-ok(("foba  ba$s" =~ qr/(foo|Ba$s|bar)/i)
-    &&  $1 eq "ba$s",
-   "TRIEF + LATIN SMALL LETTER SHARP S =~ ss");
-ok(("foba  ba$s" =~ qr/(Ba$s|foo|bar)/i)
-    &&  $1 eq "ba$s",
-   "TRIEF + LATIN SMALL LETTER SHARP S =~ ss");
-ok(("foba  ba$s" =~ qr/(foo|bar|Ba$s)/i)
-    &&  $1 eq "ba$s",
-   "TRIEF + LATIN SMALL LETTER SHARP S =~ ss");
+    {
+        use lib 'lib';
+        use Cname;
+        
+        ok 'fooB'  =~ /\N{foo}[\N{B}\N{b}]/, "Passthrough charname";
+        my $test   = 1233;
+        #
+        # Why doesn't must_warn work here?
+        #
+        my $w;
+        local $SIG {__WARN__} = sub {$w .= "@_"};
+        eval 'q(xxWxx) =~ /[\N{WARN}]/';
+        ok $w && $w =~ /^Ignoring excess chars from/,
+                 "Ignoring excess chars warning";
+
+        undef $w;
+        eval q [ok "\0" !~ /[\N{EMPTY-STR}XY]/,
+                   "Zerolength charname in charclass doesn't match \\0"];
+        ok $w && $w =~ /^Ignoring zero length/,
+                 'Ignoring zero length \N{%} in character class warning';
+
+        ok 'AB'  =~ /(\N{EVIL})/ && $1 eq 'A', 'Charname caching $1';
+        ok 'ABC' =~ /(\N{EVIL})/,              'Charname caching $1';
+        ok 'xy'  =~ /x\N{EMPTY-STR}y/,
+                    'Empty string charname produces NOTHING node';
+        ok ''    =~ /\N{EMPTY-STR}/,
+                    'Empty string charname produces NOTHING node';
+            
+    }
 
-ok(("foba  ba$s" =~ qr/(foo|Bass|bar)/i)
-    &&  $1 eq "ba$s",
-   "TRIEF + LATIN SMALL LETTER SHARP S =~ ss");
 
-ok(("foba  ba$s" =~ qr/(foo|BaSS|bar)/i)
-    &&  $1 eq "ba$s",
-   "TRIEF + LATIN SMALL LETTER SHARP S =~ SS");
+    {
+        use charnames ':full';
+
+        ok 'aabc' !~ /a\N{PLUS SIGN}b/, '/a\N{PLUS SIGN}b/ against aabc';
+        ok 'a+bc' =~ /a\N{PLUS SIGN}b/, '/a\N{PLUS SIGN}b/ against a+bc';
+
+        ok ' A B' =~ /\N{SPACE}\N{U+0041}\N{SPACE}\N{U+0042}/,
+            'Intermixed named and unicode escapes';
+        ok "\N{SPACE}\N{U+0041}\N{SPACE}\N{U+0042}" =~
+           /\N{SPACE}\N{U+0041}\N{SPACE}\N{U+0042}/,
+            'Intermixed named and unicode escapes';
+        ok "\N{SPACE}\N{U+0041}\N{SPACE}\N{U+0042}" =~
+           /[\N{SPACE}\N{U+0041}][\N{SPACE}\N{U+0042}]/,
+            'Intermixed named and unicode escapes';     
+    }
 
-ok(("foba  ba${s}pxySS$s$s" =~ qr/(b(?:a${s}t|a${s}f|a${s}p)[xy]+$s*)/i)
-    &&  $1 eq "ba${s}pxySS$s$s",
-   "COMMON PREFIX TRIEF + LATIN SMALL LETTER SHARP S");
 
-   
-}
+    {
+        our $brackets;
+        $brackets = qr{
+            {  (?> [^{}]+ | (??{ $brackets }) )* }
+        }x;
+
+        ok "{b{c}d" !~ m/^((??{ $brackets }))/, "Bracket mismatch";
+
+        SKIP: {
+            our @stack = ();
+            my @expect = qw(
+                stuff1
+                stuff2
+                <stuff1>and<stuff2>
+                right
+                <right>
+                <<right>>
+                <<<right>>>
+                <<stuff1>and<stuff2>><<<<right>>>>
+            );
+
+            local $_ = '<<<stuff1>and<stuff2>><<<<right>>>>>';
+            ok /^(<((?:(?>[^<>]+)|(?1))*)>(?{push @stack, $2 }))$/,
+                "Recursion matches";
+            iseq @stack, @expect, "Right amount of matches"
+                 or skip "Won't test individual results as count isn't equal",
+                          0 + @expect;
+            my $idx = 0;
+            foreach my $expect (@expect) {
+                iseq $stack [$idx], $expect,
+                    "Expecting '$expect' at stack pos #$idx";
+                $idx ++;
+            }
+        }
+    }
 
 
-print "# set PERL_SKIP_PSYCHO_TEST to skip this test\n";
-if (!$ENV{PERL_SKIP_PSYCHO_TEST}){
-    my @normal=qw(these are some normal words);
-    my $psycho=join "|",@normal,map chr $_,255..20000;
-    ok(('these'=~/($psycho)/) && $1 eq 'these','Pyscho');
-} else {
-    ok(1,'Skipped Psycho');
-}
+    {
+        my $s = '123453456';
+        $s =~ s/(?<digits>\d+)\k<digits>/$+{digits}/;
+        ok $s eq '123456', 'Named capture (angle brackets) s///';
+        $s = '123453456';
+        $s =~ s/(?'digits'\d+)\k'digits'/$+{digits}/;
+        ok $s eq '123456', 'Named capture (single quotes) s///';    
+    }
 
-# [perl #36207] mixed utf8 / latin-1 and case folding
 
-{
-    my $utf8 = "\xe9\x{100}"; chop $utf8;
-    my $latin1 = "\xe9";
+    {
+        my @ary = (
+            pack('U', 0x00F1),            # n-tilde
+            '_'.pack('U', 0x00F1),        # _ + n-tilde
+            'c'.pack('U', 0x0327),        # c + cedilla
+            pack('U*', 0x00F1, 0x0327),   # n-tilde + cedilla
+            'a'.pack('U', 0x00B2),        # a + superscript two
+            pack('U', 0x0391),            # ALPHA
+            pack('U', 0x0391).'2',        # ALPHA + 2
+            pack('U', 0x0391).'_',        # ALPHA + _
+        );
+
+        for my $uni (@ary) {
+            my ($r1, $c1, $r2, $c2) = eval qq {
+                use utf8;
+                scalar ("..foo foo.." =~ /(?'${uni}'foo) \\k'${uni}'/),
+                        \$+{${uni}},
+                scalar ("..bar bar.." =~ /(?<${uni}>bar) \\k<${uni}>/),
+                        \$+{${uni}};
+            };
+            ok $r1,                         "Named capture UTF (?'')";
+            ok defined $c1 && $c1 eq 'foo', "Named capture UTF \%+";
+            ok $r2,                         "Named capture UTF (?<>)";
+            ok defined $c2 && $c2 eq 'bar', "Named capture UTF \%+";
+        }
+    }
 
-    ok($utf8 =~ /\xe9/i, "utf8/latin");
-    ok($utf8 =~ /$latin1/i, "utf8/latin runtime");
-    ok($utf8 =~ /(abc|\xe9)/i, "utf8/latin trie");
-    ok($utf8 =~ /(abc|$latin1)/i, "utf8/latin trie runtime");
 
-    ok("\xe9" =~ /$utf8/i, "# latin/utf8");
-    ok("\xe9" =~ /(abc|$utf8)/i, "# latin/utf8 trie");
-    ok($latin1 =~ /$utf8/i, "# latin/utf8 runtime");
-    ok($latin1 =~ /(abc|$utf8)/i, "# latin/utf8 trie runtime");
-}
+    {
+        my $s = 'foo bar baz';
+        my (@k, @v, @fetch, $res);
+        my $count = 0;
+        my @names = qw ($+{A} $+{B} $+{C});
+        if ($s =~ /(?<A>foo)\s+(?<B>bar)?\s+(?<C>baz)/) {
+            while (my ($k, $v) = each (%+)) {
+                $count++;
+            }
+            @k = sort keys   (%+);
+            @v = sort values (%+);
+            $res = 1;
+            push @fetch,
+                ["$+{A}", "$1"],
+                ["$+{B}", "$2"],
+                ["$+{C}", "$3"],
+            ;
+        } 
+        foreach (0 .. 2) {
+            if ($fetch [$_]) {
+                iseq $fetch [$_] [0], $fetch [$_] [1], $names [$_];
+            } else {
+                ok 0, $names[$_];
+            }
+        }
+        iseq $res, 1, "'$s' =~ /(?<A>foo)\\s+(?<B>bar)?\\s+(?<C>baz)/";
+        iseq $count, 3, "Got 3 keys in %+ via each";
+        iseq 0 + @k, 3, 'Got 3 keys in %+ via keys';
+        iseq "@k", "A B C", "Got expected keys";
+        iseq "@v", "bar baz foo", "Got expected values";
+        eval '
+            no warnings "uninitialized";
+            print for $+ {this_key_doesnt_exist};
+        ';
+        ok !$@, 'lvalue $+ {...} should not throw an exception';
+    }
 
-# [perl #37038] Global regular matches generate invalid pointers
 
-{
-    my $s = "abcd";
-    $s =~ /(..)(..)/g;
-    $s = $1;
-    $s = $2;
-    ok($s eq 'cd',
-       "# assigning to original string should not corrupt match vars");
-}
+    {
+        #
+        # Almost the same as the block above, except that the capture is nested.
+        #
+        local $BugId = '50496';
+        my $s = 'foo bar baz';
+        my (@k, @v, @fetch, $res);
+        my $count = 0;
+        my @names = qw ($+{A} $+{B} $+{C} $+{D});
+        if ($s =~ /(?<D>(?<A>foo)\s+(?<B>bar)?\s+(?<C>baz))/) {
+            while (my ($k,$v) = each(%+)) {
+                $count++;
+            }
+            @k = sort keys   (%+);
+            @v = sort values (%+);
+            $res = 1;
+            push @fetch,
+                ["$+{A}", "$2"],
+                ["$+{B}", "$3"],
+                ["$+{C}", "$4"],
+                ["$+{D}", "$1"],
+            ;
+        }
+        foreach (0 .. 3) {
+            if ($fetch [$_]) {
+                iseq $fetch [$_] [0], $fetch [$_] [1], $names [$_];
+            } else {
+                ok 0, $names [$_];
+            }
+        }
+        iseq $res, 1, "'$s' =~ /(?<D>(?<A>foo)\\s+(?<B>bar)?\\s+(?<C>baz))/";
+        iseq $count, 4, "Got 4 keys in %+ via each";
+        iseq @k, 4, 'Got 4 keys in %+ via keys';
+        iseq "@k", "A B C D", "Got expected keys";
+        iseq "@v", "bar baz foo foo bar baz", "Got expected values";
+        eval '
+            no warnings "uninitialized";
+            print for $+ {this_key_doesnt_exist};
+        ';
+        ok !$@,'lvalue $+ {...} should not throw an exception';
+    }
+
 
-{
-    package wooosh;
-    sub gloople {
-      "!";
+    {
+        my $s = 'foo bar baz';
+        my @res;
+        if ('1234' =~ /(?<A>1)(?<B>2)(?<A>3)(?<B>4)/) {
+            foreach my $name (sort keys(%-)) {
+                my $ary = $- {$name};
+                foreach my $idx (0 .. $#$ary) {
+                    push @res, "$name:$idx:$ary->[$idx]";
+                }
+            }
+        }
+        my @expect = qw (A:0:1 A:1:3 B:0:2 B:1:4);
+        iseq "@res", "@expect", "Check %-";
+        eval'
+            no warnings "uninitialized";
+            print for $- {this_key_doesnt_exist};
+        ';
+        ok !$@,'lvalue $- {...} should not throw an exception';
     }
-    package main;
-    
-    my $aeek = bless {}, 'wooosh';
-    eval {$aeek->gloople() =~ /(.)/g;};
-    ok($@ eq "", "//g match against return value of sub") or print "# $@\n";
-}
 
-{
-    sub gloople {
-      "!";
+
+  SKIP:
+    {
+        # stress test CURLYX/WHILEM.
+        #
+        # This test includes varying levels of nesting, and according to
+        # profiling done against build 28905, exercises every code line in the
+        # CURLYX and WHILEM blocks, except those related to LONGJMP, the
+        # super-linear cache and warnings. It executes about 0.5M regexes
+
+        skip "No psycho tests" if $ENV {PERL_SKIP_PSYCHO_TEST};
+        print "# Set PERL_SKIP_PSYCHO_TEST to skip this test\n";
+        my $r = qr/^
+                    (?:
+                        ( (?:a|z+)+ )
+                        (?:
+                            ( (?:b|z+){3,}? )
+                            (
+                                (?:
+                                    (?:
+                                        (?:c|z+){1,1}?z
+                                    )?
+                                    (?:c|z+){1,1}
+                                )*
+                            )
+                            (?:z*){2,}
+                            ( (?:z+|d)+ )
+                            (?:
+                                ( (?:e|z+)+ )
+                            )*
+                            ( (?:f|z+)+ )
+                        )*
+                        ( (?:z+|g)+ )
+                        (?:
+                            ( (?:h|z+)+ )
+                        )*
+                        ( (?:i|z+)+ )
+                    )+
+                    ( (?:j|z+)+ )
+                    (?:
+                        ( (?:k|z+)+ )
+                    )*
+                    ( (?:l|z+)+ )
+              $/x;
+          
+        my $ok = 1;
+        my $msg = "CURLYX stress test";
+        OUTER:
+          for my $a ("x","a","aa") {
+            for my $b ("x","bbb","bbbb") {
+              my $bs = $a.$b;
+              for my $c ("x","c","cc") {
+                my $cs = $bs.$c;
+                for my $d ("x","d","dd") {
+                  my $ds = $cs.$d;
+                  for my $e ("x","e","ee") {
+                    my $es = $ds.$e;
+                    for my $f ("x","f","ff") {
+                      my $fs = $es.$f;
+                      for my $g ("x","g","gg") {
+                        my $gs = $fs.$g;
+                        for my $h ("x","h","hh") {
+                          my $hs = $gs.$h;
+                          for my $i ("x","i","ii") {
+                            my $is = $hs.$i;
+                            for my $j ("x","j","jj") {
+                              my $js = $is.$j;
+                              for my $k ("x","k","kk") {
+                                my $ks = $js.$k;
+                                for my $l ("x","l","ll") {
+                                  my $ls = $ks.$l;
+                                  if ($ls =~ $r) {
+                                    if ($ls =~ /x/) {
+                                      $msg .= ": unexpected match for [$ls]";
+                                      $ok = 0;
+                                      last OUTER;
+                                    }
+                                    my $cap = "$1$2$3$4$5$6$7$8$9$10$11$12";
+                                    unless ($ls eq $cap) {
+                                      $msg .= ": capture: [$ls], got [$cap]";
+                                      $ok = 0;
+                                      last OUTER;
+                                    }
+                                  }
+                                  else {
+                                    unless ($ls =~ /x/) {
+                                      $msg = ": failed for [$ls]";
+                                      $ok = 0;
+                                      last OUTER;
+                                    }
+                                  }
+                                }
+                              }
+                            }
+                          }
+                        }
+                      }
+                    }
+                  }
+                }
+              }
+            }
+        }
+        ok($ok, $msg);
     }
-    eval {gloople() =~ /(.)/g;};
-    ok($@ eq "", "# 26410 didn't affect sub calls for some reason")
-	or print "# $@\n";
-}
 
-{
-    package lv;
-    $var = "abc";
-    sub variable : lvalue { $var }
 
-    package main;
-    my $o = bless [], "lv";
-    my $f = "";
-    eval { for (1..2) { $f .= $1 if $o->variable =~ /(.)/g } };
-    ok($f eq "ab", "pos retained between calls # TODO") or print "# $@\n";
-}
+    {
+        # \, breaks {3,4}
+        ok "xaaay"    !~ /xa{3\,4}y/, '\, in a pattern';
+        ok "xa{3,4}y" =~ /xa{3\,4}y/, '\, in a pattern';
+
+        # \c\ followed by _
+        ok "x\c_y"    !~ /x\c\_y/,    '\_ in a pattern';
+        ok "x\c\_y"   =~ /x\c\_y/,    '\_ in a pattern';
+
+        # \c\ followed by other characters
+        for my $c ("z", "\0", "!", chr(254), chr(256)) {
+            my $targ = "a\034$c";
+            my $reg  = "a\\c\\$c";
+            ok eval ("qq/$targ/ =~ /$reg/"), "\\c\\ in pattern";
+        }
+    }
 
-{
-    $var = "abc";
-    sub variable : lvalue { $var }
 
-    my $f = "";
-    eval { for (1..2) { $f .= $1 if variable() =~ /(.)/g } };
-    ok($f eq "ab", "pos retained between calls # TODO") or print "# $@\n";
-}
+    {
+        local $BugId = '36046';
+        my $str = 'abc'; 
+        my $count = 0;
+        my $mval = 0;
+        my $pval = 0;
+        while ($str =~ /b/g) {$mval = $#-; $pval = $#+; $count ++}
+        iseq $mval,  0, '@- should be empty';
+        iseq $pval,  0, '@+ should be empty';
+        iseq $count, 1, 'Should have matched once only';
+    }
 
-# [perl #37836] Simple Regex causes SEGV when run on specific data
-if ($ordA == 193) {
-    print "ok $test # Skip: in EBCDIC\n"; $test++;
-} else {
-    no warnings 'utf8';
-    $_ = pack('U0C2', 0xa2, 0xf8); # ill-formed UTF-8
-    my $ret = 0;
-    eval { $ret = s/[\0]+//g };
-    ok($ret == 0, "ill-formed UTF-8 doesn't match NUL in class");
-}
 
-{ # [perl #38293] chr(65535) should be allowed in regexes
-    no warnings 'utf8'; # to allow non-characters
-    my($c, $r, $s);
+    {   # Test the (*PRUNE) pattern
+        our $count = 0;
+        'aaab' =~ /a+b?(?{$count++})(*FAIL)/;
+        iseq $count, 9, "Expect 9 for no (*PRUNE)";
+        $count = 0;
+        'aaab' =~ /a+b?(*PRUNE)(?{$count++})(*FAIL)/;
+        iseq $count, 3, "Expect 3 with (*PRUNE)";
+        local $_ = 'aaab';
+        $count = 0;
+        1 while /.(*PRUNE)(?{$count++})(*FAIL)/g;
+        iseq $count, 4, "/.(*PRUNE)/";
+        $count = 0;
+        'aaab' =~ /a+b?(??{'(*PRUNE)'})(?{$count++})(*FAIL)/;
+        iseq $count, 3, "Expect 3 with (*PRUNE)";
+        local $_ = 'aaab';
+        $count = 0;
+        1 while /.(??{'(*PRUNE)'})(?{$count++})(*FAIL)/g;
+        iseq $count, 4, "/.(*PRUNE)/";
+    }
 
-    $c = chr 0xffff;
-    $c =~ s/$c//g;
-    ok($c eq "", "U+FFFF, parsed as atom");
 
-    $c = chr 0xffff;
-    $r = "\\$c";
-    $c =~ s/$r//g;
-    ok($c eq "", "U+FFFF backslashed, parsed as atom");
+    {   # Test the (*SKIP) pattern
+        our $count = 0;
+        'aaab' =~ /a+b?(*SKIP)(?{$count++})(*FAIL)/;
+        iseq $count, 1, "Expect 1 with (*SKIP)";
+        local $_ = 'aaab';
+        $count = 0;
+        1 while /.(*SKIP)(?{$count++})(*FAIL)/g;
+        iseq $count, 4, "/.(*SKIP)/";
+        $_ = 'aaabaaab';
+        $count = 0;
+        our @res = ();
+        1 while /(a+b?)(*SKIP)(?{$count++; push @res,$1})(*FAIL)/g;
+        iseq $count, 2, "Expect 2 with (*SKIP)";
+        iseq "@res", "aaab aaab", "Adjacent (*SKIP) works as expected";
+    }
 
-    $c = chr 0xffff;
-    $c =~ s/[$c]//g;
-    ok($c eq "", "U+FFFF, parsed in class");
 
-    $c = chr 0xffff;
-    $r = "[\\$c]";
-    $c =~ s/$r//g;
-    ok($c eq "", "U+FFFF backslashed, parsed in class");
+    {   # Test the (*SKIP) pattern
+        our $count = 0;
+        'aaab' =~ /a+b?(*MARK:foo)(*SKIP)(?{$count++})(*FAIL)/;
+        iseq $count, 1, "Expect 1 with (*SKIP)";
+        local $_ = 'aaab';
+        $count = 0;
+        1 while /.(*MARK:foo)(*SKIP)(?{$count++})(*FAIL)/g;
+        iseq $count, 4, "/.(*SKIP)/";
+        $_ = 'aaabaaab';
+        $count = 0;
+        our @res = ();
+        1 while /(a+b?)(*MARK:foo)(*SKIP)(?{$count++; push @res,$1})(*FAIL)/g;
+        iseq $count, 2, "Expect 2 with (*SKIP)";
+        iseq "@res", "aaab aaab", "Adjacent (*SKIP) works as expected";
+    }
 
-    $s = "A\x{ffff}B";
-    $s =~ s/\x{ffff}//i;
-    ok($s eq "AB", "U+FFFF, EXACTF");
 
-    $s = "\x{ffff}A";
-    $s =~ s/\bA//;
-    ok($s eq "\x{ffff}", "U+FFFF, BOUND");
+    {   # Test the (*SKIP) pattern
+        our $count = 0;
+        'aaab' =~ /a*(*MARK:a)b?(*MARK:b)(*SKIP:a)(?{$count++})(*FAIL)/;
+        iseq $count, 3, "Expect 3 with *MARK:a)b?(*MARK:b)(*SKIP:a)";
+        local $_ = 'aaabaaab';
+        $count = 0;
+        our @res = ();
+        1 while
+        /(a*(*MARK:a)b?)(*MARK:x)(*SKIP:a)(?{$count++; push @res,$1})(*FAIL)/g;
+        iseq $count, 5, "Expect 5 with (*MARK:a)b?)(*MARK:x)(*SKIP:a)";
+        iseq "@res", "aaab b aaab b ",
+             "Adjacent (*MARK:a)b?)(*MARK:x)(*SKIP:a) works as expected";
+    }
 
-    $s = "\x{ffff}!";
-    $s =~ s/\B!//;
-    ok($s eq "\x{ffff}", "U+FFFF, NBOUND");
-} # non-characters end
 
-{
-    # https://rt.perl.org/rt3/Ticket/Display.html?id=39583
-    
-    # The printing characters
-    my @chars = ("A".."Z");
-    my $delim = ",";
-    my $size = 32771 - 4;
-    my $str = '';
-
-    # create some random junk. Inefficient, but it works.
-    for ($i = 0 ; $i < $size ; $i++) {
-        $str .= $chars[int(rand(@chars))];
-    }
-
-    $str .= ($delim x 4);
-    my $res;
-    my $matched;
-    if ($str =~ s/^(.*?)${delim}{4}//s) {
-        $res = $1;
-        $matched=1;
-    } 
-    ok($matched,'pattern matches');
-    ok(length($str)==0,"Empty string");
-    ok(defined($res) && length($res)==$size,"\$1 is correct size");
-}
+    {   # Test the (*COMMIT) pattern
+        our $count = 0;
+        'aaabaaab' =~ /a+b?(*COMMIT)(?{$count++})(*FAIL)/;
+        iseq $count, 1, "Expect 1 with (*COMMIT)";
+        local $_ = 'aaab';
+        $count = 0;
+        1 while /.(*COMMIT)(?{$count++})(*FAIL)/g;
+        iseq $count, 1, "/.(*COMMIT)/";
+        $_ = 'aaabaaab';
+        $count = 0;
+        our @res = ();
+        1 while /(a+b?)(*COMMIT)(?{$count++; push @res,$1})(*FAIL)/g;
+        iseq $count, 1, "Expect 1 with (*COMMIT)";
+        iseq "@res", "aaab", "Adjacent (*COMMIT) works as expected";
+    }
 
-{ # related to [perl #27940]
-    ok("\0-A"  =~ /\c@-A/, '@- should not be interpolated in a pattern');
-    ok("\0\0A" =~ /\c@+A/, '@+ should not be interpolated in a pattern');
-    ok("X\@-A"  =~ /X@-A/, '@- should not be interpolated in a pattern');
-    ok("X\@\@A" =~ /X@+A/, '@+ should not be interpolated in a pattern');
-
-    ok("X\0A" =~ /X\c@?A/,  '\c@?');
-    ok("X\0A" =~ /X\c@*A/,  '\c@*');
-    ok("X\0A" =~ /X\c@(A)/, '\c@(');
-    ok("X\0A" =~ /X(\c@)A/, '\c@)');
-    ok("X\0A" =~ /X\c@|ZA/, '\c@|');
-
-    ok("X\@A" =~ /X@?A/,  '@?');
-    ok("X\@A" =~ /X@*A/,  '@*');
-    ok("X\@A" =~ /X@(A)/, '@(');
-    ok("X\@A" =~ /X(@)A/, '@)');
-    ok("X\@A" =~ /X@|ZA/, '@|');
-
-    local $" = ','; # non-whitespace and non-RE-specific
-    ok('abc' =~ /(.)(.)(.)/, 'the last successful match is bogus');
-    ok("A@+B"  =~ /A@{+}B/,  'interpolation of @+ in /@{+}/');
-    ok("A@-B"  =~ /A@{-}B/,  'interpolation of @- in /@{-}/');
-    ok("A@+B"  =~ /A@{+}B/x, 'interpolation of @+ in /@{+}/x');
-    ok("A@-B"  =~ /A@{-}B/x, 'interpolation of @- in /@{-}/x');
-}
 
-{
-    use lib 'lib';
-    use Cname;
-    
-    ok('fooB'=~/\N{foo}[\N{B}\N{b}]/,"Passthrough charname");
-    $test=1233; my $handle=make_must_warn('Ignoring excess chars from');
-    $handle->('q(xxWxx) =~ /[\N{WARN}]/');
-    {
-        my $code;
-        my $w="";
-        local $SIG{__WARN__} = sub { $w.=shift };
-        eval($code=<<'EOFTEST') or die "$@\n$code\n";
-        {
-            use warnings;
-            
-            #1234
-            ok("\0" !~ /[\N{EMPTY-STR}XY]/,
-                "Zerolength charname in charclass doesnt match \0");
-            1;
+    {
+        # Test named commits and the $REGERROR var
+        our $REGERROR;
+        for my $name ('', ':foo') {
+            for my $pat ("(*PRUNE$name)",
+                         ($name ? "(*MARK$name)" : "") . "(*SKIP$name)",
+                         "(*COMMIT$name)") {                         
+                for my $suffix ('(*FAIL)', '') {
+                    'aaaab' =~ /a+b$pat$suffix/;
+                    iseq $REGERROR,
+                         ($suffix ? ($name ? 'foo' : "1") : ""),
+                        "Test $pat and \$REGERROR $suffix";
+                }
+            }
         }
-EOFTEST
-        ok($w=~/Ignoring zero length/,
-            "Got expected zero length warning");
-        warn $code;                    
-        
     }
-    $handle= make_must_warn('Ignoring zero length');
-    $handle->('qq(\\0) =~ /[\N{EMPTY-STR}XY]/');
-    ok('AB'=~/(\N{EVIL})/ && $1 eq 'A',"Charname caching $1");
-    ok('ABC'=~/(\N{EVIL})/,"Charname caching $1");    
-    ok('xy'=~/x\N{EMPTY-STR}y/, 'Empty string charname produces NOTHING node');
-    ok(''=~/\N{EMPTY-STR}/, 'Empty string charname produces NOTHING node 2');
-        
-}
-{
-    print "# MORE LATIN SMALL LETTER SHARP S\n";
-
-    use charnames ':full';
-
-    #see also test #835
-    ok("ss" =~ /[\N{LATIN SMALL LETTER SHARP S}x]/i,
-        "unoptimized named sequence in class 1");
-    ok("SS" =~ /[\N{LATIN SMALL LETTER SHARP S}x]/i,
-        "unoptimized named sequence in class 2");        
-    ok("\N{LATIN SMALL LETTER SHARP S}" =~ /[\N{LATIN SMALL LETTER SHARP S}x]/,
-        "unoptimized named sequence in class 3");
-    ok("\N{LATIN SMALL LETTER SHARP S}" =~ /[\N{LATIN SMALL LETTER SHARP S}x]/i,
-        "unoptimized named sequence in class 4");        
-    
-    ok('aabc' !~ /a\N{PLUS SIGN}b/,'/a\N{PLUS SIGN}b/ against aabc');
-    ok('a+bc' =~ /a\N{PLUS SIGN}b/,'/a\N{PLUS SIGN}b/ against a+bc');
-    ok('a+bc' =~ /a\N{PLUS SIGN}b/,'/a\N{PLUS SIGN}b/ against a+bc');
-
-    ok(' A B'=~/\N{SPACE}\N{U+0041}\N{SPACE}\N{U+0042}/,
-        'Intermixed named and unicode escapes 1');
-    ok("\N{SPACE}\N{U+0041}\N{SPACE}\N{U+0042}"=~
-       /\N{SPACE}\N{U+0041}\N{SPACE}\N{U+0042}/,
-        'Intermixed named and unicode escapes 2');
-    ok("\N{SPACE}\N{U+0041}\N{SPACE}\N{U+0042} 3"=~
-       /[\N{SPACE}\N{U+0041}][\N{SPACE}\N{U+0042}]/,
-        'Intermixed named and unicode escapes');     
-}
-$brackets = qr{
-	         {  (?> [^{}]+ | (??{ $brackets }) )* }
-	      }x;
-ok("{b{c}d" !~ m/^((??{ $brackets }))/, "bracket mismatch");
-
-SKIP:{
-    our @stack=();
-    my @expect=qw(
-        stuff1
-        stuff2
-        <stuff1>and<stuff2>
-        right
-        <right>
-        <<right>>
-        <<<right>>>
-        <<stuff1>and<stuff2>><<<<right>>>>
-    );
-
-    local $_='<<<stuff1>and<stuff2>><<<<right>>>>>';
-    ok(/^(<((?:(?>[^<>]+)|(?1))*)>(?{push @stack, $2 }))$/,
-        "Recursion should match");
-    ok(@stack==@expect)
-        or skip("Won't test individual results as count isn't equal",
-                0+@expect);
-    foreach my $idx (@expect) {
-        ok($expect[$idx] eq $stack[$idx], 
-            "Expecting '$expect' at stack pos #$idx");
+
+
+    {
+        # Test named commits and the $REGERROR var
+        package Fnorble;
+        our $REGERROR;
+        for my $name ('', ':foo') {
+            for my $pat ("(*PRUNE$name)",
+                         ($name ? "(*MARK$name)" : "") . "(*SKIP$name)",
+                         "(*COMMIT$name)") {                         
+                for my $suffix ('(*FAIL)','') {
+                    'aaaab' =~ /a+b$pat$suffix/;
+                  ::iseq $REGERROR,
+                         ($suffix ? ($name ? 'foo' : "1") : ""),
+                        "Test $pat and \$REGERROR $suffix";
+                }
+            }
+        }      
+    }    
+
+
+    {
+        # Test named commits and the $REGERROR var
+        local $Message = '$REGERROR';
+        our $REGERROR;
+        for my $word (qw (bar baz bop)) {
+            $REGERROR = "";
+            "aaaaa$word" =~
+              /a+(?:bar(*COMMIT:bar)|baz(*COMMIT:baz)|bop(*COMMIT:bop))(*FAIL)/;
+            iseq $REGERROR, $word;
+        }    
     }
-        
-}
-{
-    my $s='123453456';
-    $s=~s/(?<digits>\d+)\k<digits>/$+{digits}/;
-    ok($s eq '123456','Named capture (angle brackets) s///');
-    $s='123453456';
-    $s=~s/(?'digits'\d+)\k'digits'/$+{digits}/;
-    ok($s eq '123456','Named capture (single quotes) s///');    
-}
 
-{
-    my @ary = (
-	pack('U', 0x00F1),            # n-tilde
-	'_'.pack('U', 0x00F1),        # _ + n-tilde
-	'c'.pack('U', 0x0327),        # c + cedilla
-	pack('U*', 0x00F1, 0x0327),   # n-tilde + cedilla
-	'a'.pack('U', 0x00B2),        # a + superscript two
-	pack('U', 0x0391),            # ALPHA
-	pack('U', 0x0391).'2',        # ALPHA + 2
-	pack('U', 0x0391).'_',        # ALPHA + _
-    );
-    for my $uni (@ary) {
-	my ($r1, $c1, $r2, $c2) = eval qq{
-	    use utf8;
-	    scalar("..foo foo.." =~ /(?'${uni}'foo) \\k'${uni}'/),
-		\$+{${uni}},
-	    scalar("..bar bar.." =~ /(?<${uni}>bar) \\k<${uni}>/),
-		\$+{${uni}};
-	};
-	ok($r1,                         "Named capture UTF (?'')");
-	ok(defined $c1 && $c1 eq 'foo', "Named capture UTF \%+");
-	ok($r2,                         "Named capture UTF (?<>)");
-	ok(defined $c2 && $c2 eq 'bar', "Named capture UTF \%+");
+
+    {
+        local $BugId = '40684';
+        local $Message = '/m in precompiled regexp';
+        my $s = "abc\ndef";
+        my $rex = qr'^abc$'m;
+        ok $s =~ m/$rex/;
+        ok $s =~ m/^abc$/m;
     }
-}
 
-sub iseq($$;$) { 
-    my ( $got, $expect, $name)=@_;
-    
-    $_=defined($_) ? "'$_'" : "undef"
-        for $got, $expect;
-        
-    my $ok=  $got eq $expect;
-        
-    printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
-        ($name||$Message)."\tLine ".((caller)[2]);
 
-    printf "# Failed test at line %d\n".
-           "# expected: %s\n". 
-           "#   result: %s\n", 
-           (caller)[2], $expect, $got
-        unless $ok;
+    {
+        #Mindnumbingly simple test of (*THEN)
+        for ("ABC","BAX") {
+            ok /A (*THEN) X | B (*THEN) C/x, "Simple (*THEN) test";
+        }
+    }
 
-    $test++;
-    return $ok;
-}   
-{
-    my $s='foo bar baz';
-    my (@k,@v,@fetch,$res);
-    my $count= 0;
-    my @names=qw($+{A} $+{B} $+{C});
-    if ($s=~/(?<A>foo)\s+(?<B>bar)?\s+(?<C>baz)/) {
-        while (my ($k,$v)=each(%+)) {
-            $count++;
+
+    {
+        local $Message = "Relative Recursion";
+        my $parens = qr/(\((?:[^()]++|(?-1))*+\))/;
+        local $_ = 'foo((2*3)+4-3) + bar(2*(3+4)-1*(2-3))';
+        my ($all, $one, $two) = ('', '', '');
+        ok /foo $parens \s* \+ \s* bar $parens/x;
+        iseq $1, '((2*3)+4-3)';
+        iseq $2, '(2*(3+4)-1*(2-3))';
+        iseq $&, 'foo((2*3)+4-3) + bar(2*(3+4)-1*(2-3))';
+        iseq $&, $_;
+    }
+
+    {
+        my $spaces="      ";
+        local $_ = join 'bar', $spaces, $spaces;
+        our $count = 0;
+        s/(?>\s+bar)(?{$count++})//g;
+        iseq $_, $spaces, "SUSPEND final string";
+        iseq $count, 1, "Optimiser should have prevented more than one match";
+    }
+
+    {
+        local $BugId   = '36909';
+        local $Message = '(?: ... )? should not lose $^R';
+        $^R = 'Nothing';
+        {
+            local $^R = "Bad";
+            ok 'x foofoo y' =~ m {
+                      (foo) # $^R correctly set
+                      (?{ "last regexp code result" })
+            }x;
+            iseq $^R, 'last regexp code result';
         }
-        @k=sort keys(%+);
-        @v=sort values(%+);
-        $res=1;
-        push @fetch,
-            [ "$+{A}", "$1" ],
-            [ "$+{B}", "$2" ],
-            [ "$+{C}", "$3" ],
-        ;
-    } 
-    foreach (0..2) {
-        if ($fetch[$_]) {
-            iseq($fetch[$_][0],$fetch[$_][1],$names[$_]);
-        } else {
-            ok(0, $names[$_]);
+        iseq $^R, 'Nothing';
+
+        {
+            local $^R = "Bad";
+
+            ok 'x foofoo y' =~ m {
+                      (?:foo|bar)+ # $^R correctly set
+                      (?{ "last regexp code result" })
+            }x;
+            iseq $^R, 'last regexp code result';
+        }
+        iseq $^R, 'Nothing';
+
+        {
+            local $^R = "Bad";
+            ok 'x foofoo y' =~ m {
+                      (foo|bar)\1+ # $^R undefined
+                      (?{ "last regexp code result" })
+            }x;
+            iseq $^R, 'last regexp code result';
+        }
+        iseq $^R, 'Nothing';
+
+        {
+            local $^R = "Bad";
+            ok 'x foofoo y' =~ m {
+                      (foo|bar)\1 # This time without the +
+                      (?{"last regexp code result"})
+            }x;
+            iseq $^R, 'last regexp code result';
         }
+        iseq $^R, 'Nothing';
     }
-    iseq($res,1,"$s~=/(?<A>foo)\s+(?<B>bar)?\s+(?<C>baz)/");
-    iseq($count,3,"Got 3 keys in %+ via each");
-    iseq(0+@k, 3, 'Got 3 keys in %+ via keys');
-    iseq("@k","A B C", "Got expected keys");
-    iseq("@v","bar baz foo", "Got expected values");
-    eval'
-        print for $+{this_key_doesnt_exist};
-    ';
-    ok(!$@,'lvalue $+{...} should not throw an exception');
-}
-{
-    my $s='foo bar baz';
-    my @res;
-    if ('1234'=~/(?<A>1)(?<B>2)(?<A>3)(?<B>4)/) {
-        foreach my $name (sort keys(%-)) {
-            my $ary = $-{$name};
-            foreach my $idx (0..$#$ary) {
-                push @res,"$name:$idx:$ary->[$idx]";
+
+
+    {
+        local $BugId   = '22395';
+        local $Message = 'Match is linear, not quadratic';
+        our $count;
+        for my $l (10, 100, 1000) {
+            $count = 0;
+            ('a' x $l) =~ /(.*)(?{$count++})[bc]/;
+            local $TODO = "Should be L+1 not L*(L+3)/2 (L=$l)";
+            iseq $count, $l + 1;
+        }
+    }
+
+
+    {
+        local $BugId   = '22614';
+        local $Message = '@-/@+ should not have undefined values';
+        local $_ = 'ab';
+        our @len = ();
+        /(.){1,}(?{push @len,0+@-})(.){1,}(?{})^/;
+        iseq "@len", "2 2 2";
+    }
+
+
+    {
+        local $BugId   = '18209';
+        local $Message = '$& set on s///';
+        my $text = ' word1 word2 word3 word4 word5 word6 ';
+
+        my @words = ('word1', 'word3', 'word5');
+        my $count;
+        foreach my $word (@words) {
+            $text =~ s/$word\s//gi; # Leave a space to seperate words
+                                    # in the resultant str.
+            # The following block is not working.
+            if ($&) {
+                $count ++;
             }
+            # End bad block
         }
+        iseq $count, 3;
+        iseq $text, ' word2 word4 word6 ';
     }
-    my @expect=qw(A:0:1 A:1:3 B:0:2 B:1:4);
-    iseq("@res","@expect","Check %-");
-    eval'
-        print for $-{this_key_doesnt_exist};
-    ';
-    ok(!$@,'lvalue $-{...} should not throw an exception');
-}
-# stress test CURLYX/WHILEM.
-#
-# This test includes varying levels of nesting, and according to
-# profiling done against build 28905, exercises every code line in the
-# CURLYX and WHILEM blocks, except those related to LONGJMP, the
-# super-linear cache and warnings. It executes about 0.5M regexes
-
-if ($ENV{PERL_SKIP_PSYCHO_TEST}){
-  printf "ok %d Skip: No psycho tests\n", $test++;
-} else {    
-  print "# set PERL_SKIP_PSYCHO_TEST to skip this test\n";
-  my $r = qr/^
-  	    (?:
-  		( (?:a|z+)+ )
-  		(?:
-  		    ( (?:b|z+){3,}? )
-  		    (
-  			(?:
-  			    (?:
-				(?:c|z+){1,1}?z
-			    )?
-  			    (?:c|z+){1,1}
-  			)*
-  		    )
-  		    (?:z*){2,}
-  		    ( (?:z+|d)+ )
-  		    (?:
-  			( (?:e|z+)+ )
-  		    )*
-  		    ( (?:f|z+)+ )
-  		)*
-  		( (?:z+|g)+ )
-  		(?:
-  		    ( (?:h|z+)+ )
-  		)*
-  		( (?:i|z+)+ )
-  	    )+
-  	    ( (?:j|z+)+ )
-  	    (?:
-  		( (?:k|z+)+ )
-  	    )*
-  	    ( (?:l|z+)+ )
-  	$/x;
-  
-  
-  my $ok = 1;
-  my $msg = "CURLYX stress test";
-  OUTER:
-  for my $a ("x","a","aa") {
-    for my $b ("x","bbb","bbbb") {
-      my $bs = $a.$b;
-      for my $c ("x","c","cc") {
-        my $cs = $bs.$c;
-        for my $d ("x","d","dd") {
-          my $ds = $cs.$d;
-          for my $e ("x","e","ee") {
-            my $es = $ds.$e;
-            for my $f ("x","f","ff") {
-              my $fs = $es.$f;
-              for my $g ("x","g","gg") {
-                my $gs = $fs.$g;
-                for my $h ("x","h","hh") {
-                  my $hs = $gs.$h;
-                  for my $i ("x","i","ii") {
-                    my $is = $hs.$i;
-                    for my $j ("x","j","jj") {
-                      my $js = $is.$j;
-                      for my $k ("x","k","kk") {
-                        my $ks = $js.$k;
-                        for my $l ("x","l","ll") {
-                          my $ls = $ks.$l;
-                          if ($ls =~ $r) {
-                            if ($ls =~ /x/) {
-                              $msg .= ": unexpected match for [$ls]";
-			      $ok = 0;
-                              last OUTER;
-                            }
-                            my $cap = "$1$2$3$4$5$6$7$8$9$10$11$12";
-                            unless ($ls eq $cap) {
-                              $msg .= ": capture: [$ls], got [$cap]";
-			      $ok = 0;
-                              last OUTER;
-                            }
-                          }
-                          else {
-                            unless ($ls =~ /x/) {
-                              $msg = ": failed for [$ls]";
-			      $ok = 0;
-                              last OUTER;
-                            }
-                          }
+
+
+    {
+        # RT#6893
+        local $BugId = '6893';
+        local $_ = qq (A\nB\nC\n); 
+        my @res;
+        while (m#(\G|\n)([^\n]*)\n#gsx) { 
+            push @res, "$2"; 
+            last if @res > 3;
+        }
+        iseq "@res", "A B C", "/g pattern shouldn't infinite loop";
+    }
+
+
+    {
+        # From Message-ID: <877ixs6oa6.fsf@k75.linux.bogus>
+        my $dow_name = "nada";
+        my $parser = "(\$dow_name) = \$time_string =~ /(D\x{e9}\\ " .
+                     "C\x{e9}adaoin|D\x{e9}\\ Sathairn|\\w+|\x{100})/";
+        my $time_string = "D\x{e9} C\x{e9}adaoin";
+        eval $parser;
+        ok !$@, "Test Eval worked";
+        iseq $dow_name, $time_string, "UTF-8 trie common prefix extraction";
+    }
+
+
+    {
+        my $v;
+        ($v = 'bar') =~ /(\w+)/g;
+        $v = 'foo';
+        iseq "$1", 'bar', '$1 is safe after /g - may fail due ' .
+                          'to specialized config in pp_hot.c'
+    }
+
+
+    {
+        local $Message = "http://nntp.perl.org/group/perl.perl5.porters/118663";
+        my $qr_barR1 = qr/(bar)\g-1/;
+        ok "foobarbarxyz" =~ $qr_barR1;
+        ok "foobarbarxyz" =~ qr/foo${qr_barR1}xyz/;
+        ok "foobarbarxyz" =~ qr/(foo)${qr_barR1}xyz/;
+        ok "foobarbarxyz" =~ qr/(foo)(bar)\g{-1}xyz/;
+        ok "foobarbarxyz" =~ qr/(foo${qr_barR1})xyz/;
+        ok "foobarbarxyz" =~ qr/(foo(bar)\g{-1})xyz/;
+    } 
+
+
+    {
+        local $BugId   = '41010';
+        local $Message = 'No optimizer bug';
+        my @tails  = ('', '(?(1))', '(|)', '()?');    
+        my @quants = ('*','+');
+        my $doit = sub {
+            my $pats = shift;
+            for (@_) {
+                for my $pat (@$pats) {
+                    for my $quant (@quants) {
+                        for my $tail (@tails) {
+                            my $re = "($pat$quant\$)$tail";
+                            ok /$re/  && $1 eq $_, "'$_' =~ /$re/";
+                            ok /$re/m && $1 eq $_, "'$_' =~ /$re/m";
                         }
-                      }
                     }
-                  }
                 }
-              }
             }
-          }
+        };    
+        
+        my @dpats = ('\d',
+                     '[1234567890]',
+                     '(1|[23]|4|[56]|[78]|[90])',
+                     '(?:1|[23]|4|[56]|[78]|[90])',
+                     '(1|2|3|4|5|6|7|8|9|0)',
+                     '(?:1|2|3|4|5|6|7|8|9|0)');
+        my @spats = ('[ ]', ' ', '( |\t)', '(?: |\t)', '[ \t]', '\s');
+        my @sstrs = ('  ');
+        my @dstrs = ('12345');
+        $doit -> (\@spats, @sstrs);
+        $doit -> (\@dpats, @dstrs);
+    }
+
+
+    {
+        local $Message = '$REGMARK';
+        our @r = ();
+        our ($REGMARK, $REGERROR);
+        ok 'foofoo' =~ /foo (*MARK:foo) (?{push @r,$REGMARK}) /x;
+        iseq "@r","foo";           
+        iseq $REGMARK, "foo";
+        ok 'foofoo' !~ /foo (*MARK:foo) (*FAIL) /x;
+        ok !$REGMARK;
+        iseq $REGERROR, 'foo';
+    }
+
+
+    {
+        local $Message = '\K test';
+        my $x;
+        $x = "abc.def.ghi.jkl";
+        $x =~ s/.*\K\..*//;
+        iseq $x, "abc.def.ghi";
+        
+        $x = "one two three four";
+        $x =~ s/o+ \Kthree//g;
+        iseq $x, "one two  four";
+        
+        $x = "abcde";
+        $x =~ s/(.)\K/$1/g;
+        iseq $x, "aabbccddee";
+    }
+
+
+    {
+        sub kt {
+            return '4' if $_[0] eq '09028623';
         }
-      }
+        # Nested EVAL using PL_curpm (via $1 or friends)
+        my $re;
+        our $grabit = qr/ ([0-6][0-9]{7}) (??{ kt $1 }) [890] /x;
+        $re = qr/^ ( (??{ $grabit }) ) $ /x;
+        my @res = '0902862349' =~ $re;
+        iseq join ("-", @res), "0902862349",
+            'PL_curpm is set properly on nested eval';
+
+        our $qr = qr/ (o) (??{ $1 }) /x;
+        ok 'boob'=~/( b (??{ $qr }) b )/x && 1, "PL_curpm, nested eval";
     }
-  }
-  ok($ok, $msg);
-}
 
-# \, breaks {3,4}
-ok("xaaay"    !~ /xa{3\,4}y/, "\, in a pattern");
-ok("xa{3,4}y" =~ /xa{3\,4}y/, "\, in a pattern");
 
-# \c\ followed by _
-ok("x\c_y"    !~ /x\c\_y/,    "\_ in a pattern");
-ok("x\c\_y"   =~ /x\c\_y/,    "\_ in a pattern");
+    {
+        use charnames ":full";
+        ok "\N{ROMAN NUMERAL ONE}" =~ /\p{Alphabetic}/, "I =~ Alphabetic";
+        ok "\N{ROMAN NUMERAL ONE}" =~ /\p{Uppercase}/,  "I =~ Uppercase";
+        ok "\N{ROMAN NUMERAL ONE}" !~ /\p{Lowercase}/,  "I !~ Lowercase";
+        ok "\N{ROMAN NUMERAL ONE}" =~ /\p{IDStart}/,    "I =~ ID_Start";
+        ok "\N{ROMAN NUMERAL ONE}" =~ /\p{IDContinue}/, "I =~ ID_Continue";
+        ok "\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{Alphabetic}/, "i =~ Alphabetic";
+        ok "\N{SMALL ROMAN NUMERAL ONE}" !~ /\p{Uppercase}/,  "i !~ Uppercase";
+        ok "\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{Lowercase}/,  "i =~ Lowercase";
+        ok "\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{IDStart}/,    "i =~ ID_Start";
+        ok "\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{IDContinue}/, "i =~ ID_Continue"
+    }
 
-# \c\ followed by other characters
-for my $c ("z", "\0", "!", chr(254), chr(256)) {
-    my $targ = "a\034$c";
-    my $reg  = "a\\c\\$c";
-    ok(eval("qq/$targ/ =~ /$reg/"), "\\c\\ in pattern");
-}
 
-{
-    my $str='abc'; 
-    my $count=0;
-    my $mval=0;
-    my $pval=0;
-    while ($str=~/b/g) { $mval=$#-; $pval=$#+; $count++ }
-    iseq($mval,0,"\@- should be empty [RT#36046]");
-    iseq($pval,0,"\@+ should be empty [RT#36046]");
-    iseq($count,1,"should have matched once only [RT#36046]");
-}
+    {
+        # requirement of Unicode Technical Standard #18, 1.7 Code Points
+        # cf. http://www.unicode.org/reports/tr18/#Supplementary_Characters
+        for my $u (0x7FF, 0x800, 0xFFFF, 0x10000) {
+            no warnings 'utf8'; # oops
+            my $c = chr $u;
+            my $x = sprintf '%04X', $u;
+            ok "A${c}B" =~ /A[\0-\x{10000}]B/, "Unicode range - $x";
+        }
+    }
 
-{   # Test the (*PRUNE) pattern
-    our $count = 0;
-    'aaab'=~/a+b?(?{$count++})(*FAIL)/;
-    iseq($count,9,"expect 9 for no (*PRUNE)");
-    $count = 0;
-    'aaab'=~/a+b?(*PRUNE)(?{$count++})(*FAIL)/;
-    iseq($count,3,"expect 3 with (*PRUNE)");
-    local $_='aaab';
-    $count=0;
-    1 while /.(*PRUNE)(?{$count++})(*FAIL)/g;
-    iseq($count,4,"/.(*PRUNE)/");
-    $count = 0;
-    'aaab'=~/a+b?(??{'(*PRUNE)'})(?{$count++})(*FAIL)/;
-    iseq($count,3,"expect 3 with (*PRUNE)");
-    local $_='aaab';
-    $count=0;
-    1 while /.(??{'(*PRUNE)'})(?{$count++})(*FAIL)/g;
-    iseq($count,4,"/.(*PRUNE)/");
-}
-{   # Test the (*SKIP) pattern
-    our $count = 0;
-    'aaab'=~/a+b?(*SKIP)(?{$count++})(*FAIL)/;
-    iseq($count,1,"expect 1 with (*SKIP)");
-    local $_='aaab';
-    $count=0;
-    1 while /.(*SKIP)(?{$count++})(*FAIL)/g;
-    iseq($count,4,"/.(*SKIP)/");
-    $_='aaabaaab';
-    $count=0;
-    our @res=();
-    1 while /(a+b?)(*SKIP)(?{$count++; push @res,$1})(*FAIL)/g;
-    iseq($count,2,"Expect 2 with (*SKIP)" );
-    iseq("@res","aaab aaab","adjacent (*SKIP) works as expected" );
-}
-{   # Test the (*SKIP) pattern
-    our $count = 0;
-    'aaab'=~/a+b?(*MARK:foo)(*SKIP)(?{$count++})(*FAIL)/;
-    iseq($count,1,"expect 1 with (*SKIP)");
-    local $_='aaab';
-    $count=0;
-    1 while /.(*MARK:foo)(*SKIP)(?{$count++})(*FAIL)/g;
-    iseq($count,4,"/.(*SKIP)/");
-    $_='aaabaaab';
-    $count=0;
-    our @res=();
-    1 while /(a+b?)(*MARK:foo)(*SKIP)(?{$count++; push @res,$1})(*FAIL)/g;
-    iseq($count,2,"Expect 2 with (*SKIP)" );
-    iseq("@res","aaab aaab","adjacent (*SKIP) works as expected" );
-}
-{   # Test the (*SKIP) pattern
-    our $count = 0;
-    'aaab'=~/a*(*MARK:a)b?(*MARK:b)(*SKIP:a)(?{$count++})(*FAIL)/;
-    iseq($count,3,"expect 3 with *MARK:a)b?(*MARK:b)(*SKIP:a)");
-    local $_='aaabaaab';
-    $count=0;
-    our @res=();
-    1 while /(a*(*MARK:a)b?)(*MARK:x)(*SKIP:a)(?{$count++; push @res,$1})(*FAIL)/g;
-    iseq($count,5,"Expect 5 with (*MARK:a)b?)(*MARK:x)(*SKIP:a)" );
-    iseq("@res","aaab b aaab b ","adjacent (*MARK:a)b?)(*MARK:x)(*SKIP:a) works as expected" );
-}
-{   # Test the (*COMMIT) pattern
-    our $count = 0;
-    'aaabaaab'=~/a+b?(*COMMIT)(?{$count++})(*FAIL)/;
-    iseq($count,1,"expect 1 with (*COMMIT)");
-    local $_='aaab';
-    $count=0;
-    1 while /.(*COMMIT)(?{$count++})(*FAIL)/g;
-    iseq($count,1,"/.(*COMMIT)/");
-    $_='aaabaaab';
-    $count=0;
-    our @res=();
-    1 while /(a+b?)(*COMMIT)(?{$count++; push @res,$1})(*FAIL)/g;
-    iseq($count,1,"Expect 1 with (*COMMIT)" );
-    iseq("@res","aaab","adjacent (*COMMIT) works as expected" );
-}
-{
-    # Test named commits and the $REGERROR var
-    our $REGERROR;
-    for my $name ('',':foo') 
-    {
-        for my $pat ("(*PRUNE$name)",
-                     ($name? "(*MARK$name)" : "")
-                     . "(*SKIP$name)",
-                     "(*COMMIT$name)")
-        {                         
-            for my $suffix ('(*FAIL)','') 
-            {
-                'aaaab'=~/a+b$pat$suffix/;
-                iseq(
-                    $REGERROR,
-                    ($suffix ? ($name ? 'foo' : "1") : ""),
-                    "Test $pat and \$REGERROR $suffix"
-                );
-            }
+
+    {
+        my $res="";
+
+        if ('1' =~ /(?|(?<digit>1)|(?<digit>2))/) {
+            $res = "@{$- {digit}}";
         }
-    }      
-}    
-{
-    # Test named commits and the $REGERROR var
-    package Fnorble;
-    our $REGERROR;
-    for my $name ('',':foo') 
-    {
-        for my $pat ("(*PRUNE$name)",
-                     ($name? "(*MARK$name)" : "")
-                     . "(*SKIP$name)",
-                     "(*COMMIT$name)")
-        {                         
-            for my $suffix ('(*FAIL)','') 
-            {
-                'aaaab'=~/a+b$pat$suffix/;
-                ::iseq(
-                    $REGERROR,
-                    ($suffix ? ($name ? 'foo' : "1") : ""),
-                    "Test $pat and \$REGERROR $suffix"
-                );
-            }
+        iseq $res, "1",
+            "Check that (?|...) doesnt cause dupe entries in the names array";
+        
+        $res = "";
+        if ('11' =~ /(?|(?<digit>1)|(?<digit>2))(?&digit)/) {
+            $res = "@{$- {digit}}";
         }
-    }      
-}    
-{
-    # Test named commits and the $REGERROR var
-    local $Message = "\$REGERROR";
-    our $REGERROR;
-    for $word (qw(bar baz bop)) {
-        $REGERROR="";
-        "aaaaa$word"=~/a+(?:bar(*COMMIT:bar)|baz(*COMMIT:baz)|bop(*COMMIT:bop))(*FAIL)/;
-        iseq($REGERROR,$word);
+        iseq $res, "1", "Check that (?&..) to a buffer inside " .
+                        "a (?|...) goes to the leftmost";
+    }
+
+
+    {
+        use warnings;
+        local $Message = "ASCII pattern that really is UTF-8";
+        my @w;
+        local $SIG {__WARN__} = sub {push @w, "@_"};
+        my $c = qq (\x{DF}); 
+        ok $c =~ /${c}|\x{100}/;
+        ok @w == 0;
     }    
-}
-{   #Regression test for perlbug 40684
-    local $Message = "RT#40684 tests:";
-    my $s = "abc\ndef";
-    my $rex = qr'^abc$'m;
-    ok($s =~ m/$rex/);
-    ok($s =~ m/^abc$/m);
-}
-{
-    #Mindnumbingly simple test of (*THEN)
-    for ("ABC","BAX") {
-        ok(/A (*THEN) X | B (*THEN) C/x,"Simple (*THEN) test");
+
+
+    {
+        local $Message = "Corruption of match results of qr// across scopes";
+        my $qr = qr/(fo+)(ba+r)/;
+        'foobar' =~ /$qr/;
+        iseq "$1$2", "foobar";
+        {
+            'foooooobaaaaar' =~ /$qr/;
+            iseq "$1$2", 'foooooobaaaaar';    
+        }
+        iseq "$1$2", "foobar";
     }
-}
 
-{
-    local $Message = "Relative Recursion";
-    my $parens=qr/(\((?:[^()]++|(?-1))*+\))/;
-    local $_='foo((2*3)+4-3) + bar(2*(3+4)-1*(2-3))';
-    my ($all,$one,$two)=('','','');
-    if (/foo $parens \s* \+ \s* bar $parens/x) {
-       $all=$&;
-       $one=$1;
-       $two=$2;
-    }
-    iseq($one, '((2*3)+4-3)');
-    iseq($two, '(2*(3+4)-1*(2-3))');
-    iseq($all, 'foo((2*3)+4-3) + bar(2*(3+4)-1*(2-3))');
-    iseq($all, $_);
-}
-{
-    my $spaces="      ";
-    local $_=join 'bar',$spaces,$spaces;
-    our $count=0;
-    s/(?>\s+bar)(?{$count++})//g;
-    iseq($_,$spaces,"SUSPEND final string");
-    iseq($count,1,"Optimiser should have prevented more than one match");
-}
-{
-    local $Message = "RT#36909 test";
-    $^R = 'Nothing';
+
     {
-        local $^R = "Bad";
-        ok('x foofoo y' =~ m{
-         (foo) # $^R correctly set
-        (?{ "last regexp code result" })
-        }x);
-        iseq($^R,'last regexp code result');
+        local $Message = "HORIZWS";
+        local $_ = "\t \r\n \n \t".chr(11)."\n";
+        s/\H/H/g;
+        s/\h/h/g;
+        iseq $_, "hhHHhHhhHH";
+        $_ = "\t \r\n \n \t" . chr (11) . "\n";
+        utf8::upgrade ($_);
+        s/\H/H/g;
+        s/\h/h/g;
+        iseq $_, "hhHHhHhhHH";
+    }    
+
+
+    {
+        local $Message = "Various whitespace special patterns";
+        my @h = map {chr $_}   0x09,   0x20,   0xa0, 0x1680, 0x180e, 0x2000,
+                             0x2001, 0x2002, 0x2003, 0x2004, 0x2005, 0x2006,
+                             0x2007, 0x2008, 0x2009, 0x200a, 0x202f, 0x205f,
+                             0x3000;
+        my @v = map {chr $_}   0x0a,   0x0b,   0x0c,   0x0d,   0x85, 0x2028,
+                             0x2029;
+        my @lb = ("\x0D\x0A", map {chr $_} 0x0A .. 0x0D, 0x85, 0x2028, 0x2029);
+        foreach my $t ([\@h,  qr/\h/, qr/\h+/],
+                       [\@v,  qr/\v/, qr/\v+/],
+                       [\@lb, qr/\R/, qr/\R+/],) {
+            my $ary = shift @$t;
+            foreach my $pat (@$t) {
+                foreach my $str (@$ary) {
+                    ok $str =~ /($pat)/, $pat;
+                    iseq $1, $str, $pat;
+                    utf8::upgrade ($str);
+                    ok $str =~ /($pat)/, "Upgraded string - $pat";
+                    iseq $1, $str, "Upgraded string - $pat";
+                }
+            }
+        }
     }
-    iseq($^R,'Nothing');
+
+
     {
-        local $^R = "Bad";
+        local $Message = "Check that \\xDF match properly in its various forms";
+        # Test that \xDF matches properly. this is pretty hacky stuff,
+        # but its actually needed. The malarky with '-' is to prevent
+        # compilation caching from playing any role in the test.
+        my @df = (chr (0xDF), '-', chr (0xDF));
+        utf8::upgrade ($df [2]);
+        my @strs = ('ss', 'sS', 'Ss', 'SS', chr (0xDF));
+        my @ss = map {("$_", "$_")} @strs;
+        utf8::upgrade ($ss [$_ * 2 + 1]) for 0 .. $#strs;
+
+        for my $ssi (0 .. $#ss) {
+            for my $dfi (0 .. $#df) {
+                my $pat = $df [$dfi];
+                my $str = $ss [$ssi];
+                my $utf_df = ($dfi > 1) ? 'utf8' : '';
+                my $utf_ss = ($ssi % 2) ? 'utf8' : '';
+                (my $sstr = $str) =~ s/\xDF/\\xDF/;
+
+                if ($utf_df || $utf_ss || length ($ss [$ssi]) == 1) {
+                    my $ret = $str =~ /$pat/i;
+                    next if $pat eq '-';
+                    ok $ret, "\"$sstr\" =~ /\\xDF/i " .
+                             "(str is @{[$utf_ss||'latin']}, pat is " .
+                             "@{[$utf_df||'latin']})";
+                }
+                else {
+                    my $ret = $str !~ /$pat/i;
+                    next if $pat eq '-';
+                    ok $ret, "\"$sstr\" !~ /\\xDF/i " .
+                             "(str is @{[$utf_ss||'latin']}, pat is " .
+                             "@{[$utf_df||'latin']})";
+                }
+            }
+        }
+    }
+
+
+    {
+        local $Message = "BBC(Bleadperl Breaks CPAN) Today: String::Multibyte";
+        my $re  = qr/(?:[\x00-\xFF]{4})/;
+        my $hyp = "\0\0\0-";
+        my $esc = "\0\0\0\\";
+
+        my $str = "$esc$hyp$hyp$esc$esc";
+        my @a = ($str =~ /\G(?:\Q$esc$esc\E|\Q$esc$hyp\E|$re)/g);
+
+        iseq @a,3;
+        local $" = "=";
+        iseq "@a","$esc$hyp=$hyp=$esc$esc";
+    }
+
 
-        ok('x foofoo y' =~ m{
-         (?:foo|bar)+ # $^R correctly set
-        (?{"last regexp code result"})
-        }x);
-        iseq($^R,'last regexp code result');
+    {
+        # Test for keys in %+ and %-
+        local $Message = 'Test keys in %+ and %-';
+        no warnings 'uninitialized';
+        my $_ = "abcdef";
+        /(?<foo>a)|(?<foo>b)/;
+        iseq ((join ",", sort keys %+), "foo");
+        iseq ((join ",", sort keys %-), "foo");
+        iseq ((join ",", sort values %+), "a");
+        iseq ((join ",", sort map "@$_", values %-), "a ");
+        /(?<bar>a)(?<bar>b)(?<quux>.)/;
+        iseq ((join ",", sort keys %+), "bar,quux");
+        iseq ((join ",", sort keys %-), "bar,quux");
+        iseq ((join ",", sort values %+), "a,c"); # leftmost
+        iseq ((join ",", sort map "@$_", values %-), "a b,c");
+        /(?<un>a)(?<deux>c)?/; # second buffer won't capture
+        iseq ((join ",", sort keys %+), "un");
+        iseq ((join ",", sort keys %-), "deux,un");
+        iseq ((join ",", sort values %+), "a");
+        iseq ((join ",", sort map "@$_", values %-), ",a");
     }
-    iseq($^R,'Nothing');
+
 
     {
-        local $^R = "Bad";
-        ok('x foofoo y' =~ m{
-         (foo|bar)\1+ # $^R undefined
-        (?{"last regexp code result"})
-        }x);
-        iseq($^R,'last regexp code result');
+        # length() on captures, the numbered ones end up in Perl_magic_len
+        my $_ = "aoeu \xe6var ook";
+        /^ \w+ \s (?<eek>\S+)/x;
+
+        iseq length ($`),      0, q[length $`];
+        iseq length ($'),      4, q[length $'];
+        iseq length ($&),      9, q[length $&];
+        iseq length ($1),      4, q[length $1];
+        iseq length ($+{eek}), 4, q[length $+{eek} == length $1];
     }
-    iseq($^R,'Nothing');
+
 
     {
-        local $^R = "Bad";
-        ok('x foofoo y' =~ m{
-         (foo|bar)\1 # this time without the +
-        (?{"last regexp code result"})
-        }x);
-        iseq($^R,'last regexp code result');
+        my $ok = -1;
+
+        $ok = exists ($-{x}) ? 1 : 0 if 'bar' =~ /(?<x>foo)|bar/;
+        iseq $ok, 1, '$-{x} exists after "bar"=~/(?<x>foo)|bar/';
+        iseq scalar (%+), 0, 'scalar %+ == 0 after "bar"=~/(?<x>foo)|bar/';
+        iseq scalar (%-), 1, 'scalar %- == 1 after "bar"=~/(?<x>foo)|bar/';
+
+        $ok = -1;
+        $ok = exists ($+{x}) ? 1 : 0 if 'bar' =~ /(?<x>foo)|bar/;
+        iseq $ok, 0, '$+{x} not exists after "bar"=~/(?<x>foo)|bar/';
+        iseq scalar (%+), 0, 'scalar %+ == 0 after "bar"=~/(?<x>foo)|bar/';
+        iseq scalar (%-), 1, 'scalar %- == 1 after "bar"=~/(?<x>foo)|bar/';
+
+        $ok = -1;
+        $ok = exists ($-{x}) ? 1 : 0 if 'foo' =~ /(?<x>foo)|bar/;
+        iseq $ok, 1, '$-{x} exists after "foo"=~/(?<x>foo)|bar/';
+        iseq scalar (%+), 1, 'scalar %+ == 1 after "foo"=~/(?<x>foo)|bar/';
+        iseq scalar (%-), 1, 'scalar %- == 1 after "foo"=~/(?<x>foo)|bar/';
+
+        $ok = -1;
+        $ok = exists ($+{x}) ? 1 : 0 if 'foo'=~/(?<x>foo)|bar/;
+        iseq $ok, 1, '$+{x} exists after "foo"=~/(?<x>foo)|bar/';
     }
-    iseq($^R,'Nothing');
-}
-{
-    local $Message="RT#22395";
-    our $count;
-    for my $l (10,100,1000) {
-	$count=0;
-	('a' x $l) =~ /(.*)(?{$count++})[bc]/;
-	iseq( $count, $l + 1, "# TODO Should be L+1 not L*(L+3)/2 (L=$l)");
+
+
+    {
+        local $_;
+        ($_ = 'abc') =~ /(abc)/g;
+        $_ = '123'; 
+        iseq "$1", 'abc', "/g leads to unsafe match vars: $1";
     }
-}
-{
-    local $Message = "RT#22614";
-    local $_='ab';
-    our @len=();
-    /(.){1,}(?{push @len,0+@-})(.){1,}(?{})^/;
-    iseq("@len","2 2 2");
-}
-{
-    local $Message = "RT#18209";
-    my $text = ' word1 word2 word3 word4 word5 word6 ';
-
-    my @words = ('word1', 'word3', 'word5');
-    my $count;
-    foreach my $word (@words){
-        $text =~ s/$word\s//gi; # Leave a space to seperate words in the resultant str.
-        # The following block is not working.
-        if($&){
-            $count++;
+
+
+    {
+        local $Message = 'Message-ID: <20070818091501.7eff4831@r2d2>';
+        my $str = "";
+        for (0 .. 5) {
+            my @x;
+            $str .= "@x"; # this should ALWAYS be the empty string
+            'a' =~ /(a|)/;
+            push @x, 1;
         }
-        # End bad block
+        iseq length ($str), 0, "Trie scope error, string should be empty";
+        $str = "";
+        my @foo = ('a') x 5;
+        for (@foo) {
+            my @bar;
+            $str .= "@bar";
+            s/a|/push @bar, 1/e;
+        }
+        iseq length ($str), 0, "Trie scope error, string should be empty";
     }
-    iseq($count,3);
-    iseq($text,' word2 word4 word6 ');
-}
-{
-    # RT#6893
-    local $_= qq(A\nB\nC\n); 
-    my @res;
-    while (m#(\G|\n)([^\n]*)\n#gsx) 
-    { 
-        push @res,"$2"; 
-        last if @res>3;
-    }
-    iseq("@res","A B C","RT#6893: /g pattern shouldn't infinite loop");
-}
 
-{
-    # From Message-ID: <877ixs6oa6.fsf@k75.linux.bogus>
-    my $dow_name= "nada";
-    my $parser = "(\$dow_name) = \$time_string =~ /(D\x{e9}\\ C\x{e9}adaoin|D\x{e9}\\ Sathairn|\\w+|\x{100})/";
-    my $time_string = "D\x{e9} C\x{e9}adaoin";
-    eval $parser;
-    ok(!$@,"Test Eval worked");
-    iseq($dow_name,$time_string,"UTF8 trie common prefix extraction");
-}
 
-{
-    my $v;
-    ($v='bar')=~/(\w+)/g;
-    $v='foo';
-    iseq("$1",'bar','$1 is safe after /g - may fail due to specialized config in pp_hot.c')
-}
-{
-    local $Message = "http://nntp.perl.org/group/perl.perl5.porters/118663";
-    my $qr_barR1 = qr/(bar)\g-1/;
-    ok("foobarbarxyz" =~ $qr_barR1);
-    ok("foobarbarxyz" =~ qr/foo${qr_barR1}xyz/);
-    ok("foobarbarxyz" =~ qr/(foo)${qr_barR1}xyz/);
-    ok("foobarbarxyz" =~ qr/(foo)(bar)\g{-1}xyz/);
-    ok("foobarbarxyz" =~ qr/(foo${qr_barR1})xyz/);
-    ok("foobarbarxyz" =~ qr/(foo(bar)\g{-1})xyz/);
-} 
-{
-    local $Message = "RT#41010";
-    my @tails=('','(?(1))','(|)','()?');    
-    my @quants=('*','+');
-    my $doit=sub {
-        my $pats= shift;
-        for (@_) {
-            for my $pat (@$pats) {
-                for my $quant (@quants) {
-                    for my $tail (@tails) {
-                        my $re = "($pat$quant\$)$tail";
-                        ok(/$re/ && $1 eq $_,"'$_'=~/$re/");
-                        ok(/$re/m && $1 eq $_,"'$_'=~/$re/m");
-                    }
+    {
+        local $BugId = '45605';
+        # [perl #45605] Regexp failure with utf8-flagged and byte-flagged string
+
+        my $utf_8 = "\xd6schel";
+        utf8::upgrade ($utf_8);
+        $utf_8 =~ m {(\xd6|&Ouml;)schel};
+        iseq $1, "\xd6", "Upgrade error";
+    }
+
+    {
+# more TRIE/AHOCORASICK problems with mixed utf8 / latin-1 and case folding
+	for my $chr (160 .. 255) {
+	    my $chr_byte = chr($chr);
+	    my $chr_utf8 = chr($chr); utf8::upgrade($chr_utf8);
+	    my $rx = qr{$chr_byte|X}i;
+	    ok($chr_utf8 =~ $rx, "utf8/latin, codepoint $chr");
+	}
+    }
+
+    {
+        # Regardless of utf8ness any character matches itself when 
+        # doing a case insensitive match. See also [perl #36207] 
+        local $BugId = '36207';
+        for my $o (0 .. 255) {
+            my @ch = (chr ($o), chr ($o));
+            utf8::upgrade ($ch [1]);
+            for my $u_str (0, 1) {
+                for my $u_pat (0, 1) {
+                    ok $ch [$u_str] =~ /\Q$ch[$u_pat]\E/i,
+                    "\$c =~ /\$c/i : chr ($o) : u_str = $u_str u_pat = $u_pat";
+                    ok $ch [$u_str] =~ /\Q$ch[$u_pat]\E|xyz/i,
+                    "\$c=~/\$c|xyz/i : chr($o) : u_str = $u_str u_pat = $u_pat";
                 }
             }
-       }
-    };    
-    
-    my @dpats=( 
-                '\d',
-                '[1234567890]',
-                '(1|[23]|4|[56]|[78]|[90])',
-                '(?:1|[23]|4|[56]|[78]|[90])',
-                '(1|2|3|4|5|6|7|8|9|0)',
-                '(?:1|2|3|4|5|6|7|8|9|0)',
-             );
-    my @spats=('[ ]',' ','( |\t)','(?: |\t)','[ \t]','\s');
-    my @sstrs=('  ');
-    my @dstrs=('12345');
-    $doit->(\@spats,@sstrs);
-    $doit->(\@dpats,@dstrs);
-}
-{
-    local $Message = "\$REGMARK";
-    our @r=();
-    ok('foofoo' =~ /foo (*MARK:foo) (?{push @r,$REGMARK}) /x);
-    iseq("@r","foo");           
-    iseq($REGMARK,"foo");
-    ok('foofoo' !~ /foo (*MARK:foo) (*FAIL) /x);
-    ok(!$REGMARK);
-    iseq($REGERROR,'foo');
-}
-{
-    my $x;
-    $x = "abc.def.ghi.jkl";
-    $x =~ s/.*\K\..*//;
-    ok($x eq "abc.def.ghi");
-    
-    $x = "one two three four";
-    $x =~ s/o+ \Kthree//g;
-    ok($x eq "one two  four");
-    
-    $x = "abcde";
-    $x =~ s/(.)\K/$1/g;
-    ok($x eq "aabbccddee");
-}
-sub kt
-{
-    return '4' if $_[0] eq '09028623';
-}
+        }
+    }
 
-{   # Nested EVAL using PL_curpm (via $1 or friends)
-    my $re;
-    our $grabit = qr/ ([0-6][0-9]{7}) (??{ kt $1 }) [890] /x;
-    $re = qr/^ ( (??{ $grabit }) ) $ /x;
-    my @res = '0902862349' =~ $re;
-    iseq(join("-",@res),"0902862349",
-        'PL_curpm is set properly on nested eval');
-
-    our $qr = qr/ (o) (??{ $1 }) /x;
-    ok( 'boob'=~/( b (??{ $qr }) b )/x && 1,
-        "PL_curpm, nested eval");
-}
 
-{
-    use charnames ":full";
-    ok("\N{ROMAN NUMERAL ONE}" =~ /\p{Alphabetic}/, "I =~ Alphabetic");
-    ok("\N{ROMAN NUMERAL ONE}" =~ /\p{Uppercase}/,  "I =~ Uppercase");
-    ok("\N{ROMAN NUMERAL ONE}" !~ /\p{Lowercase}/,  "I !~ Lowercase");
-    ok("\N{ROMAN NUMERAL ONE}" =~ /\p{IDStart}/,    "I =~ ID_Start");
-    ok("\N{ROMAN NUMERAL ONE}" =~ /\p{IDContinue}/, "I =~ ID_Continue");
-    ok("\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{Alphabetic}/, "i =~ Alphabetic");
-    ok("\N{SMALL ROMAN NUMERAL ONE}" !~ /\p{Uppercase}/,  "i !~ Uppercase");
-    ok("\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{Lowercase}/,  "i =~ Lowercase");
-    ok("\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{IDStart}/,    "i =~ ID_Start");
-    ok("\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{IDContinue}/, "i =~ ID_Continue");
-}
+    {
+        our $a = 3; "" =~ /(??{ $a })/;
+        our $b = $a;
+        iseq $b, $a, "Copy of scalar used for postponed subexpression";
+    }
+
 
-{
-# requirement of Unicode Technical Standard #18, 1.7 Code Points
-# cf. http://www.unicode.org/reports/tr18/#Supplementary_Characters
-    for my $u (0x7FF, 0x800, 0xFFFF, 0x10000) {
-        no warnings 'utf8'; # oops
-        my $c = chr $u;
-        my $x = sprintf '%04X', $u;
-        ok( "A${c}B" =~ /A[\0-\x{10000}]B/, "unicode range - $x");
+    {
+         local $BugId   = '49190';
+         local $Message = '$REGMARK in replacement';
+         our $REGMARK;
+         my $_ = "A";
+         ok s/(*:B)A/$REGMARK/;
+         iseq $_, "B";
+         $_ = "CCCCBAA";
+         ok s/(*:X)A+|(*:Y)B+|(*:Z)C+/$REGMARK/g;
+         iseq $_, "ZYX";
+    }
+
+
+    {
+        our @ctl_n = ();
+        our @plus = ();
+        our $nested_tags;
+        $nested_tags = qr{
+            <
+               (\w+)
+               (?{
+                       push @ctl_n,$^N;
+                       push @plus,$+;
+               })
+            >
+            (??{$nested_tags})*
+            </\s* \w+ \s*>
+        }x;
+
+        my $match = '<bla><blubb></blubb></bla>' =~ m/^$nested_tags$/;
+        ok $match, 'nested construct matches';
+        iseq "@ctl_n", "bla blubb", '$^N inside of (?{}) works as expected';
+        iseq "@plus",  "bla blubb", '$+  inside of (?{}) works as expected';
     }
-}
 
-{
-    my $res="";
 
-    if ('1' =~ /(?|(?<digit>1)|(?<digit>2))/) {
-      $res = "@{$- {digit}}";
+    {
+        local $BugId   = '52658';
+        local $Message = 'Substitution evaluation in list context';
+        my $reg = '../xxx/';
+        my @te  = ($reg =~ m{^(/?(?:\.\./)*)},
+                   $reg =~ s/(x)/'b'/eg > 1 ? '##' : '++');
+        iseq $reg, '../bbb/';
+        iseq $te [0], '../';
     }
-    iseq($res,"1",
-        "Check that (?|...) doesnt cause dupe entries in the names array");
-    #---
-    $res="";
-    if ('11' =~ /(?|(?<digit>1)|(?<digit>2))(?&digit)/) {
-      $res = "@{$- {digit}}";
+
+	# This currently has to come before any "use encoding" in this file.
+    {
+        local $Message;
+        local $BugId   = '59342';
+	# for 5.10.x, add a dummy test indead
+        #must_warn 'qr/\400/', '^Use of octal value above 377';
+	$Message=""; ok 1;
     }
-    iseq($res, "1",
-        "Check that (?&..) to a buffer inside a (?|...) goes to the leftmost");
-}
 
-{
-    use warnings;
-    local $Message = "ASCII pattern that really is utf8";
-    my @w;
-    local $SIG{__WARN__}=sub{push @w,"@_"};
-    my $c=qq(\x{DF}); 
-    ok($c=~/${c}|\x{100}/);
-    ok(@w==0);
-}    
-{
-    local $Message = "corruption of match results of qr// across scopes";
-    my $qr=qr/(fo+)(ba+r)/;
-    'foobar'=~/$qr/;
-    iseq("$1$2","foobar");
-    {
-        'foooooobaaaaar'=~/$qr/;
-        iseq("$1$2",'foooooobaaaaar');    
-    }
-    iseq("$1$2","foobar");
-}
-{
-    local $Message = "HORIZWS";
-    local $_="\t \r\n \n \t".chr(11)."\n";
-    s/\H/H/g;
-    s/\h/h/g;
-    iseq($_,"hhHHhHhhHH");
-    $_="\t \r\n \n \t".chr(11)."\n";
-    utf8::upgrade($_);
-    s/\H/H/g;
-    s/\h/h/g;
-    iseq($_,"hhHHhHhhHH");
-}    
-{
-    local $Message = "Various whitespace special patterns";
-    my @h=map { chr( $_ ) } (
-        0x09,   0x20,   0xa0,   0x1680, 0x180e, 0x2000, 0x2001, 0x2002,
-        0x2003, 0x2004, 0x2005, 0x2006, 0x2007, 0x2008, 0x2009, 0x200a,
-        0x202f, 0x205f, 0x3000
-    );
-    my @v=map { chr( $_ ) } ( 0x0a, 0x0b, 0x0c, 0x0d, 0x85, 0x2028, 0x2029 );
-    my @lb=( "\x0D\x0A",
-             map { chr( $_ ) } ( 0x0A..0x0D,0x85,0x2028,0x2029 ));
-    foreach my $t ([\@h,qr/\h/,qr/\h+/],[\@v,qr/\v/,qr/\v+/],[\@lb,qr/\R/,qr/\R+/],){
-        my $ary=shift @$t;
-        foreach my $pat (@$t) {
-            foreach my $str (@$ary) {
-                ok($str=~/($pat)/,$pat);
-                iseq($1,$str,$pat);
-                utf8::upgrade($str);
-                ok($str=~/($pat)/,"Upgraded string - $pat");
-                iseq($1,$str,"Upgraded string - $pat");
-            }
+
+    SKIP: {
+        # XXX: This set of tests is essentially broken, POSIX character classes
+        # should not have differing definitions under Unicode. 
+        # There are property names for that.
+        skip "Tests assume ASCII", 4 unless $IS_ASCII;
+
+        my @notIsPunct = grep {/[[:punct:]]/ and not /\p{IsPunct}/}
+                                map {chr} 0x20 .. 0x7f;
+        iseq join ('', @notIsPunct), '$+<=>^`|~',
+            '[:punct:] disagress with IsPunct on Symbols';
+
+        my @isPrint = grep {not /[[:print:]]/ and /\p{IsPrint}/}
+                            map {chr} 0 .. 0x1f, 0x7f .. 0x9f;
+        iseq join ('', @isPrint), "\x09\x0a\x0b\x0c\x0d\x85",
+            'IsPrint disagrees with [:print:] on control characters';
+
+        my @isPunct = grep {/[[:punct:]]/ != /\p{IsPunct}/}
+                            map {chr} 0x80 .. 0xff;
+        iseq join ('', @isPunct), "\xa1\xab\xb7\xbb\xbf",	# ¡ « · » ¿
+            'IsPunct disagrees with [:punct:] outside ASCII';
+
+        my @isPunctLatin1 = eval q {
+            use encoding 'latin1';
+            grep {/[[:punct:]]/ != /\p{IsPunct}/} map {chr} 0x80 .. 0xff;
+        };
+        skip "Eval failed ($@)", 1 if $@;
+        skip "PERL_LEGACY_UNICODE_CHARCLASS_MAPPINGS set to 0", 1
+              if $ENV {REAL_POSIX_CC};
+        iseq join ('', @isPunctLatin1), '', 
+            'IsPunct agrees with [:punct:] with explicit Latin1';
+    } 
+
+
+    {
+        local $BugId =  '60034';
+        my $a = "xyzt" x 8192;
+        ok $a =~ /\A(?>[a-z])*\z/,
+                '(?>) does not cause wrongness on long string';
+        my $b = $a . chr 256;
+        chop $b;
+        {
+            iseq $a, $b;
         }
+        ok $b =~ /\A(?>[a-z])*\z/,
+           '(?>) does not cause wrongness on long string with UTF-8';
     }
-}
-{
-    local $Message = "Check that \\xDF match properly in its various forms";
-    # test that \xDF matches properly. this is pretty hacky stuff,
-    # but its actually needed. the malarky with '-' is to prevent
-    # compilation caching from playing any role in the test.
-    my @df= (chr(0xDF),'-',chr(0xDF));
-    utf8::upgrade($df[2]);
-    my @strs= ('ss','sS','Ss','SS',chr(0xDF));
-    my @ss= map { ("$_", "$_") } @strs;
-    utf8::upgrade($ss[$_*2+1]) for 0..$#strs;
-
-    for my $ssi (0..$#ss) {
-        for my $dfi (0..$#df) {
-            my $pat= $df[$dfi];
-            my $str= $ss[$ssi];
-            my $utf_df= ($dfi > 1) ? 'utf8' : '';
-            my $utf_ss= ($ssi % 2) ? 'utf8' : '';
-            (my $sstr=$str)=~s/\xDF/\\xDF/;
-
-            if ($utf_df || $utf_ss || length($ss[$ssi])==1) {
-                my $ret= $str=~/$pat/i;
-                next if $pat eq '-';
-                ok($ret, 
-                    "\"$sstr\"=~/\\xDF/i (str is @{[$utf_ss||'latin']}, pat is @{[$utf_df||'latin']})");
-            } else {
-                my $ret= $str !~ /$pat/i;
-                next if $pat eq '-';
-                ok($ret, 
-                    "\"$sstr\"!~/\\xDF/i (str is @{[$utf_ss||'latin']}, pat is @{[$utf_df||'latin']})");
-            }
+
+
+    #
+    # Keep the following tests last -- they may crash perl
+    #
+    print "# Tests that follow may crash perl\n";
+    {   
+        local $BugId   = '19049/38869';
+        local $Message = 'Pattern in a loop, failure should not ' .
+                         'affect previous success';
+        my @list = (
+            'ab cdef',             # Matches regex
+            ('e' x 40000 ) .'ab c' # Matches not, but 'ab c' matches part of it
+        );
+        my $y;
+        my $x;
+        foreach (@list) {
+            m/ab(.+)cd/i; # The ignore-case seems to be important
+            $y = $1;      # Use $1, which might not be from the last match!
+            $x = substr ($list [0], $- [0], $+ [0] - $- [0]);
         }
+        iseq $y, ' ';
+        iseq $x, 'ab cd';
     }
-}
-{
-    local $Message = "BBC(Bleadperl Breaks CPAN) Today: String::Multibyte";
-    my $re  = qr/(?:[\x00-\xFF]{4})/;
-    my $hyp = "\0\0\0-";
-    my $esc = "\0\0\0\\";
 
-    my $str = "$esc$hyp$hyp$esc$esc";
-    my @a = ($str =~ /\G(?:\Q$esc$esc\E|\Q$esc$hyp\E|$re)/g);
 
-    iseq(0+@a,3);
-    iseq(join('=', @a),"$esc$hyp=$hyp=$esc$esc");
-}
-# test for keys in %+ and %-
-{
-    my $_ = "abcdef";
-    /(?<foo>a)|(?<foo>b)/;
-    iseq( (join ",", sort keys %+), "foo" );
-    iseq( (join ",", sort keys %-), "foo" );
-    iseq( (join ",", sort values %+), "a" );
-    iseq( (join ",", sort map "@$_", values %-), "a " );
-    /(?<bar>a)(?<bar>b)(?<quux>.)/;
-    iseq( (join ",", sort keys %+), "bar,quux" );
-    iseq( (join ",", sort keys %-), "bar,quux" );
-    iseq( (join ",", sort values %+), "a,c" ); # leftmost
-    iseq( (join ",", sort map "@$_", values %-), "a b,c" );
-    /(?<un>a)(?<deux>c)?/; # second buffer won't capture
-    iseq( (join ",", sort keys %+), "un" );
-    iseq( (join ",", sort keys %-), "deux,un" );
-    iseq( (join ",", sort values %+), "a" );
-    iseq( (join ",", sort map "@$_", values %-), ",a" );
-}
+    {
+        local $BugId = '24274';
 
-# length() on captures, the numbered ones end up in Perl_magic_len
-{
-    my $_ = "aoeu \xe6var ook";
-    /^ \w+ \s (?<eek>\S+)/x;
+        ok (("a" x (2 ** 15 - 10)) =~ /^()(a|bb)*$/, "Recursive stack cracker");
+        ok ((q(a)x 100) =~ /^(??{'(.)'x 100})/, 
+            "Regexp /^(??{'(.)'x 100})/ crashes older perls");
+    }
 
-    iseq( length($`), 0, 'length $`' );
-    iseq( length($'), 4, q[length $'] );
-    iseq( length($&), 9, 'length $&' );
-    iseq( length($1), 4, 'length $1' );
-    iseq( length($+{eek}), 4, 'length $+{eek} == length $1' );
-}
 
-{
-    my $ok=-1;
-
-    $ok=exists($-{x}) ? 1 : 0
-        if 'bar'=~/(?<x>foo)|bar/;
-    iseq($ok,1,'$-{x} exists after "bar"=~/(?<x>foo)|bar/');
-    iseq(scalar(%+), 0, 'scalar %+ == 0 after "bar"=~/(?<x>foo)|bar/');
-    iseq(scalar(%-), 1, 'scalar %- == 1 after "bar"=~/(?<x>foo)|bar/');
-
-    $ok=-1;
-    $ok=exists($+{x}) ? 1 : 0
-        if 'bar'=~/(?<x>foo)|bar/;
-    iseq($ok,0,'$+{x} not exists after "bar"=~/(?<x>foo)|bar/');
-    iseq(scalar(%+), 0, 'scalar %+ == 0 after "bar"=~/(?<x>foo)|bar/');
-    iseq(scalar(%-), 1, 'scalar %- == 1 after "bar"=~/(?<x>foo)|bar/');
-
-    $ok=-1;
-    $ok=exists($-{x}) ? 1 : 0
-        if 'foo'=~/(?<x>foo)|bar/;
-    iseq($ok,1,'$-{x} exists after "foo"=~/(?<x>foo)|bar/');
-    iseq(scalar(%+), 1, 'scalar %+ == 1 after "foo"=~/(?<x>foo)|bar/');
-    iseq(scalar(%-), 1, 'scalar %- == 1 after "foo"=~/(?<x>foo)|bar/');
-
-    $ok=-1;
-    $ok=exists($+{x}) ? 1 : 0
-        if 'foo'=~/(?<x>foo)|bar/;
-    iseq($ok,1,'$+{x} exists after "foo"=~/(?<x>foo)|bar/');
-}
-{
-    local $_;
-    ($_ = 'abc')=~/(abc)/g;
-    $_ = '123'; 
-    iseq("$1",'abc',"/g leads to unsafe match vars: $1");
-}
-{
-    local $Message="Message-ID: <20070818091501.7eff4831@r2d2>";
-    my $str= "";
-    for(0..5){
-        my @x;
-        $str .= "@x"; # this should ALWAYS be the empty string
-        'a'=~/(a|)/;
-        push @x,1;
-    }
-    iseq(length($str),"0","Trie scope error, string should be empty");
-    $str="";
-    my @foo = ('a')x5;
-    for (@foo) {
-        my @bar;
-        $str .= "@bar";
-        s/a|/push @bar, 1/e;
-    }
-    iseq(length($str),"0","Trie scope error, string should be empty");
-}
-{
-# [perl #45605] Regexp failure with utf8-flagged and byte-flagged string
+    {
+        eval '/\k/';
+        ok $@ =~ /\QSequence \k... not terminated in regex;\E/,
+           'Lone \k not allowed';
+    }
 
-    my $utf_8 = "\xd6schel";
-    utf8::upgrade($utf_8);
-    $utf_8 =~ m{(\xd6|&Ouml;)schel};
-    iseq($1,"\xd6","#45605");
-}
 
-{
-    # Regardless of utf8ness any character matches itself when 
-    # doing a case insensitive match. See also [perl #36207] 
-    for my $o (0..255) {
-        my @ch=(chr($o),chr($o));
-        utf8::upgrade($ch[1]);
-        for my $u_str (0,1) {
-            for my $u_pat (0,1) {
-                ok( $ch[$u_str]=~/\Q$ch[$u_pat]\E/i,
-                    "\$c=~/\$c/i : chr($o) : u_str=$u_str u_pat=$u_pat");
-                ok( $ch[$u_str]=~/\Q$ch[$u_pat]\E|xyz/i,
-                "# \$c=~/\$c|xyz/i : chr($o) : u_str=$u_str u_pat=$u_pat");
+    {
+        local $Message = "Substitution with lookahead (possible segv)";
+        $_ = "ns1ns1ns1";
+        s/ns(?=\d)/ns_/g;
+        iseq $_, "ns_1ns_1ns_1";
+        $_ = "ns1";
+        s/ns(?=\d)/ns_/;
+        iseq $_, "ns_1";
+        $_ = "123";
+        s/(?=\d+)|(?<=\d)/!Bang!/g;
+        iseq $_, "!Bang!1!Bang!2!Bang!3!Bang!";
+    }
+
+
+    {
+        # [perl #45337] utf8 + "[a]a{2}" + /$.../ = panic: sv_len_utf8 cache
+        local $BugId = '45337';
+        local ${^UTF8CACHE} = -1;
+        local $Message = "Shouldn't panic";
+        my $s = "[a]a{2}";
+        utf8::upgrade $s;
+        ok "aaa" =~ /$s/;
+    }
+    {
+        local $BugId = '57042';
+	local $Message = "Check if tree logic breaks \$^R";
+	my $cond_re = qr/\s*
+	    \s* (?:
+		   \( \s* A  (?{1})
+		 | \( \s* B  (?{2})
+	       )
+	   /x;
+	my @res;
+	for my $line ("(A)","(B)") {
+	   if ($line =~ m/$cond_re/) {
+	       push @res, $^R ? "#$^R" : "UNDEF";
+	   }
+	}
+	iseq "@res","#1 #2";
+    }
+    {
+	no warnings 'closure';
+	my $re = qr/A(??{"1"})/;
+	ok "A1B" =~ m/^((??{ $re }))((??{"B"}))$/;
+	ok $1 eq "A1";
+	ok $2 eq "B";
+    }
+
+
+    {
+        use re 'eval';
+        local $Message = 'Test if $^N and $+ work in (?{{})';
+        our @ctl_n = ();
+        our @plus = ();
+        our $nested_tags;
+        $nested_tags = qr{
+            <
+               ((\w)+)
+               (?{
+                       push @ctl_n, (defined $^N ? $^N : "undef");
+                       push @plus, (defined $+ ? $+ : "undef");
+               })
+            >
+            (??{$nested_tags})*
+            </\s* \w+ \s*>
+        }x;
+
+
+        my $c = 0;
+        for my $test (
+            # Test structure:
+            #  [ Expected result, Regex, Expected value(s) of $^N, Expected value(s) of $+ ]
+            [ 1, qr#^$nested_tags$#, "bla blubb bla", "a b a" ],
+            [ 1, qr#^($nested_tags)$#, "bla blubb <bla><blubb></blubb></bla>", "a b a" ],
+            [ 1, qr#^(|)$nested_tags$#, "bla blubb bla", "a b a" ],
+            [ 1, qr#^(?:|)$nested_tags$#, "bla blubb bla", "a b a" ],
+            [ 1, qr#^<(bl|bla)>$nested_tags<(/\1)>$#, "blubb /bla", "b /bla" ],
+            [ 1, qr#(??{"(|)"})$nested_tags$#, "bla blubb bla", "a b a" ],
+            [ 1, qr#^(??{"(bla|)"})$nested_tags$#, "bla blubb bla", "a b a" ],
+            [ 1, qr#^(??{"(|)"})(??{$nested_tags})$#, "bla blubb undef", "a b undef" ],
+            [ 1, qr#^(??{"(?:|)"})$nested_tags$#, "bla blubb bla", "a b a" ],
+            [ 1, qr#^((??{"(?:bla|)"}))((??{$nested_tags}))$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
+            [ 1, qr#^((??{"(?!)?"}))((??{$nested_tags}))$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
+            [ 1, qr#^((??{"(?:|<(/?bla)>)"}))((??{$nested_tags}))\1$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
+            [ 0, qr#^((??{"(?!)"}))?((??{$nested_tags}))(?!)$#, "bla blubb undef", "a b undef" ],
+
+        ) { #"#silence vim highlighting
+            $c++;
+            @ctl_n = ();
+            @plus = ();
+            my $match = (("<bla><blubb></blubb></bla>" =~ $test->[1]) ? 1 : 0);
+            push @ctl_n, (defined $^N ? $^N : "undef");
+            push @plus, (defined $+ ? $+ : "undef");
+            ok($test->[0] == $match, "match $c");
+            if ($test->[0] != $match) {
+              # unset @ctl_n and @plus
+              @ctl_n = @plus = ();
             }
+            iseq("@ctl_n", $test->[2], "ctl_n $c");
+            iseq("@plus", $test->[3], "plus $c");
         }
     }
-}
 
-# Test counter is at bottom of file. Put new tests above here.
-#-------------------------------------------------------------------
-# Keep the following tests last -- they may crash perl
-{   
-    # RT#19049 / RT#38869
-    my @list = (
-        'ab cdef', # matches regex
-        ( 'e' x 40000 ) .'ab c' # matches not, but 'ab c' matches part of it
-    );
-    my $y;
-    my $x;
-    foreach (@list) {
-        m/ab(.+)cd/i; # the ignore-case seems to be important
-        $y = $1; # use $1, which might not be from the last match!
-        $x = substr($list[0],$-[0],$+[0]-$-[0]);
-    }
-    iseq($y,' ',
-        'pattern in a loop, failure should not affect previous success');
-    iseq($x,'ab cd',
-        'pattern in a loop, failure should not affect previous success');
-}
+    {
+        use re 'eval';
+        local $BugId = '56194';
+
+	our $f;
+	local $f;
+	$f = sub {
+            defined $_[0] ? $_[0] : "undef";
+        };
+
+        ok("123" =~ m/^(\d)(((??{1 + $^N})))+$/);
+
+        our @ctl_n;
+        our @plus;
+
+        my $re  = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))*(?{$^N})#;
+        my $re2 = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))*(?{$^N})(|a(b)c|def)(??{"$^R"})#;
+        my $re3 = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})){2}(?{$^N})(|a(b)c|def)(??{"$^R"})#;
+        our $re5;
+        local $re5 = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})){2}(?{$^N})#;
+        my $re6 = qr#(??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})#;
+        my $re7 = qr#(??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})#;
+        my $re8 = qr/(\d+)/;
+        my $c = 0;
+        for my $test (
+             # Test structure:
+             #  [
+             #    String to match
+             #    Regex too match
+             #    Expected values of $^N
+             #    Expected values of $+
+             #    Expected values of $1, $2, $3, $4 and $5
+             #  ]
+             [
+                  "1233",
+                  qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(??{$^N})$#,
+                  "1 2 3 3",
+                  "1 2 3 3",
+                  "\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
+             ],
+             [
+                  "1233",
+                  qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(abc|def|)?(??{$+})$#,
+                  "1 2 3 3",
+                  "1 2 3 3",
+                  "\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
+             ],
+             [
+                  "1233",
+                  qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(|abc|def)?(??{$+})$#,
+                  "1 2 3 3",
+                  "1 2 3 3",
+                  "\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
+             ],
+             [
+                  "1233",
+                  qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(abc|def|)?(??{$^N})$#,
+                  "1 2 3 3",
+                  "1 2 3 3",
+                  "\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
+             ],
+             [
+                  "1233",
+                  qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(|abc|def)?(??{$^N})$#,
+                  "1 2 3 3",
+                  "1 2 3 3",
+                  "\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
+              ],
+              [
+                  "123abc3",
+                   qr#^($re)(|a(b)c|def)(??{$^R})$#,
+                   "1 2 3 abc",
+                   "1 2 3 b",
+                   "\$1 = 123, \$2 = 1, \$3 = 3, \$4 = abc, \$5 = b",
+              ],
+              [
+                  "123abc3",
+                   qr#^($re2)$#,
+                   "1 2 3 123abc3",
+                   "1 2 3 b",
+                   "\$1 = 123abc3, \$2 = 1, \$3 = 3, \$4 = abc, \$5 = b",
+              ],
+              [
+                  "123abc3",
+                   qr#^($re3)$#,
+                   "1 2 123abc3",
+                   "1 2 b",
+                   "\$1 = 123abc3, \$2 = 1, \$3 = 3, \$4 = abc, \$5 = b",
+              ],
+              [
+                  "123abc3",
+                   qr#^(??{$re5})(|abc|def)(??{"$^R"})$#,
+                   "1 2 abc",
+                   "1 2 abc",
+                   "\$1 = abc, \$2 = undef, \$3 = undef, \$4 = undef, \$5 = undef",
+              ],
+              [
+                  "123abc3",
+                   qr#^(??{$re5})(|a(b)c|def)(??{"$^R"})$#,
+                   "1 2 abc",
+                   "1 2 b",
+                   "\$1 = abc, \$2 = b, \$3 = undef, \$4 = undef, \$5 = undef",
+              ],
+              [
+                  "1234",
+                   qr#^((\d+)((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1}))((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1}))((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1})))$#,
+                   "1234 123 12 1 2 3 1234",
+                   "1234 123 12 1 2 3 4",
+                   "\$1 = 1234, \$2 = 1, \$3 = 2, \$4 = 3, \$5 = 4",
+              ],
+              [
+                   "1234556",
+                   qr#^(\d+)($re6)($re6)($re6)$re6(($re6)$re6)$#,
+                   "1234556 123455 12345 1234 123 12 1 2 3 4 4 5 56",
+                   "1234556 123455 12345 1234 123 12 1 2 3 4 4 5 5",
+                   "\$1 = 1, \$2 = 2, \$3 = 3, \$4 = 4, \$5 = 56",
+              ],
+              [
+                  "12345562",
+                   qr#^((??{$re8}))($re7)($re7)($re7)$re7($re7)($re7(\2))$#,
+                   "12345562 1234556 123455 12345 1234 123 12 1 2 3 4 4 5 62",
+                   "12345562 1234556 123455 12345 1234 123 12 1 2 3 4 4 5 2",
+                   "\$1 = 1, \$2 = 2, \$3 = 3, \$4 = 4, \$5 = 5",
+              ],
+        ) {
+            $c++;
+            @ctl_n = ();
+            @plus = ();
+            undef $^R;
+            my $match = $test->[0] =~ $test->[1];
+            my $str = join(", ", '$1 = '.$f->($1), '$2 = '.$f->($2), '$3 = '.$f->($3), '$4 = '.$f->($4),'$5 = '.$f->($5));
+            push @ctl_n, $f->($^N);
+            push @plus, $f->($+);
+            ok($match, "match $c");
+            if (not $match) {
+                # unset $str, @ctl_n and @plus
+                $str = "";
+                @ctl_n = @plus = ();
+            }
+            iseq("@ctl_n", $test->[2], "ctl_n $c");
+            iseq("@plus", $test->[3], "plus $c");
+            iseq($str, $test->[4], "str $c");
+        }
+        SKIP: {
+            if ($] le '5.010') {
+                skip "test segfaults on perl < 5.10", 4;
+            }
 
-ok(("a" x (2**15 - 10)) =~ /^()(a|bb)*$/, "Recursive stack cracker: #24274")
-    or print "# Unexpected outcome: should pass or crash perl\n";
-
-ok((q(a)x 100) =~ /^(??{'(.)'x 100})/, 
-        "Regexp /^(??{'(.)'x 100})/ crashes older perls")
-    or print "# Unexpected outcome: should pass or crash perl\n";
-
-eval '/\k/';
-ok($@=~/\QSequence \k... not terminated in regex;\E/);
-
-{
-    local $Message = "substitution with lookahead (possible segv)";
-    $_="ns1ns1ns1";
-    s/ns(?=\d)/ns_/g;
-    iseq($_,"ns_1ns_1ns_1");
-    $_="ns1";
-    s/ns(?=\d)/ns_/;
-    iseq($_,"ns_1");
-    $_="123";
-    s/(?=\d+)|(?<=\d)/!Bang!/g;
-    iseq($_,"!Bang!1!Bang!2!Bang!3!Bang!");
-}
+            @ctl_n = ();
+            @plus = ();
+
+            our $re4;
+            local $re4 = qr#(1)((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1})){2}(?{$^N})(|abc|def)(??{"$^R"})#;
+            undef $^R;
+            my $match = "123abc3" =~ m/^(??{$re4})$/;
+            my $str = join(", ", '$1 = '.$f->($1), '$2 = '.$f->($2), '$3 = '.$f->($3), '$4 = '.$f->($4),'$5 = '.$f->($5),'$^R = '.$f->($^R));
+            push @ctl_n, $f->($^N);
+            push @plus, $f->($+);
+            ok($match);
+            if (not $match) {
+                # unset $str
+                @ctl_n = ();
+                @plus = ();
+                $str = "";
+            }
+            iseq("@ctl_n", "1 2 undef");
+            iseq("@plus", "1 2 undef");
+            iseq($str, "\$1 = undef, \$2 = undef, \$3 = undef, \$4 = undef, \$5 = undef, \$^R = undef");
+       }
+    }
 
-# [perl #45337] utf8 + "[a]a{2}" + /$.../ = panic: sv_len_utf8 cache
+    {
+	local $BugId = 65372;	# minimal CURLYM limited to 32767 matches
+	my @pat = (
+	    qr{a(x|y)*b},	# CURLYM
+	    qr{a(x|y)*?b},	# .. with minmod
+	    qr{a([wx]|[yz])*b},	# .. and without tries
+	    qr{a([wx]|[yz])*?b},
+	);
+	my $len = 32768;
+	my $s = join '', 'a', 'x' x $len, 'b';
+	for my $pat (@pat) {
+	    ok($s =~ $pat, $pat);
+	}
+    }
+    #
+    # This should be the last test.
+    #
+    iseq $test + 1, $EXPECTED_TESTS, "Got the right number of tests!";
 
-{
-    local ${^UTF8CACHE} = -1;
-    my $s="[a]a{2}";
-    utf8::upgrade $s;
-    ok("aaa" =~ /$s/, "#45337");
-}
+} # End of sub run_tests
 
-# Put new tests above the dotted line about a page above this comment
-iseq(0+$::test,$::TestCount,"Got the right number of tests!");
-# Don't forget to update this!
-BEGIN {
-    $::TestCount = 4013;
-    print "1..$::TestCount\n";
-}
+1;
diff --git a/gnu/usr.bin/perl/t/op/range.t b/gnu/usr.bin/perl/t/op/range.t
index 3cef292446d..214c16835f5 100644
--- a/gnu/usr.bin/perl/t/op/range.t
+++ b/gnu/usr.bin/perl/t/op/range.t
@@ -9,7 +9,7 @@ require 'test.pl';
 
 use Config;
 
-plan (45);
+plan (135);
 
 is(join(':',1..5), '1:2:3:4:5');
 
@@ -188,3 +188,219 @@ is(join(":", map "[$_]", @foo), '[]');
     @foo=(); push @foo, $_ for $1.."";
     is(join(":", map "[$_]", @foo), '');
 }
+
+# Test upper range limit
+my $MAX_INT = ~0>>1;
+
+foreach my $ii (-3 .. 3) {
+    my ($first, $last);
+    eval {
+        my $lim=0;
+        for ($MAX_INT-10 .. $MAX_INT+$ii) {
+            if (! defined($first)) {
+                $first = $_;
+            }
+            $last = $_;
+            last if ($lim++ > 100);   # Protect against integer wrap
+        }
+    };
+    if ($ii <= 0) {
+        ok(! $@, 'Upper bound accepted: ' . ($MAX_INT+$ii));
+        is($first, $MAX_INT-10, 'Lower bound okay');
+        is($last, $MAX_INT+$ii, 'Upper bound okay');
+    } else {
+        ok($@, 'Upper bound rejected: ' . ($MAX_INT+$ii));
+    }
+}
+
+foreach my $ii (-3 .. 3) {
+    my ($first, $last);
+    eval {
+        my $lim=0;
+        for ($MAX_INT+$ii .. $MAX_INT) {
+            if (! defined($first)) {
+                $first = $_;
+            }
+            $last = $_;
+            last if ($lim++ > 100);
+        }
+    };
+    if ($ii <= 0) {
+        ok(! $@, 'Lower bound accepted: ' . ($MAX_INT+$ii));
+        is($first, $MAX_INT+$ii, 'Lower bound okay');
+        is($last, $MAX_INT, 'Upper bound okay');
+    } else {
+        ok($@, 'Lower bound rejected: ' . ($MAX_INT+$ii));
+    }
+}
+
+{
+    my $first;
+    eval {
+        my $lim=0;
+        for ($MAX_INT .. $MAX_INT-1) {
+            if (! defined($first)) {
+                $first = $_;
+            }
+            $last = $_;
+            last if ($lim++ > 100);
+        }
+    };
+    ok(! $@, 'Range accepted');
+    ok(! defined($first), 'Range ineffectual');
+}
+
+foreach my $ii (~0, ~0+1, ~0+(~0>>4)) {
+    eval {
+        my $lim=0;
+        for ($MAX_INT-10 .. $ii) {
+            last if ($lim++ > 100);
+        }
+    };
+    ok($@, 'Upper bound rejected: ' . $ii);
+}
+
+# Test lower range limit
+my $MIN_INT = -1-$MAX_INT;
+
+if (! $Config{d_nv_preserves_uv}) {
+    # $MIN_INT needs adjustment when IV won't fit into an NV
+    my $NV = $MIN_INT - 1;
+    my $OFFSET = 1;
+    while (($NV + $OFFSET) == $MIN_INT) {
+        $OFFSET++
+    }
+    $MIN_INT += $OFFSET;
+}
+
+foreach my $ii (-3 .. 3) {
+    my ($first, $last);
+    eval {
+        my $lim=0;
+        for ($MIN_INT+$ii .. $MIN_INT+10) {
+            if (! defined($first)) {
+                $first = $_;
+            }
+            $last = $_;
+            last if ($lim++ > 100);
+        }
+    };
+    if ($ii >= 0) {
+        ok(! $@, 'Lower bound accepted: ' . ($MIN_INT+$ii));
+        is($first, $MIN_INT+$ii, 'Lower bound okay');
+        is($last, $MIN_INT+10, 'Upper bound okay');
+    } else {
+        ok($@, 'Lower bound rejected: ' . ($MIN_INT+$ii));
+    }
+}
+
+foreach my $ii (-3 .. 3) {
+    my ($first, $last);
+    eval {
+        my $lim=0;
+        for ($MIN_INT .. $MIN_INT+$ii) {
+            if (! defined($first)) {
+                $first = $_;
+            }
+            $last = $_;
+            last if ($lim++ > 100);
+        }
+    };
+    if ($ii >= 0) {
+        ok(! $@, 'Upper bound accepted: ' . ($MIN_INT+$ii));
+        is($first, $MIN_INT, 'Lower bound okay');
+        is($last, $MIN_INT+$ii, 'Upper bound okay');
+    } else {
+        ok($@, 'Upper bound rejected: ' . ($MIN_INT+$ii));
+    }
+}
+
+{
+    my $first;
+    eval {
+        my $lim=0;
+        for ($MIN_INT+1 .. $MIN_INT) {
+            if (! defined($first)) {
+                $first = $_;
+            }
+            $last = $_;
+            last if ($lim++ > 100);
+        }
+    };
+    ok(! $@, 'Range accepted');
+    ok(! defined($first), 'Range ineffectual');
+}
+
+foreach my $ii (~0, ~0+1, ~0+(~0>>4)) {
+    eval {
+        my $lim=0;
+        for (-$ii .. $MIN_INT+10) {
+            last if ($lim++ > 100);
+        }
+    };
+    ok($@, 'Lower bound rejected: ' . -$ii);
+}
+
+# double/tripple magic tests
+sub TIESCALAR { bless { value => $_[1], orig => $_[1] } }
+sub STORE { $_[0]{store}++; $_[0]{value} = $_[1] }
+sub FETCH { $_[0]{fetch}++; $_[0]{value} }
+sub stores { tied($_[0])->{value} = tied($_[0])->{orig};
+             delete(tied($_[0])->{store}) || 0 }
+sub fetches { delete(tied($_[0])->{fetch}) || 0 }
+    
+tie $x, "main", 6;
+
+my @foo;
+@foo = 4 .. $x;
+is(scalar @foo, 3);
+is("@foo", "4 5 6");
+{
+  local $TODO = "test for double magic with range operator";
+  is(fetches($x), 1);
+}
+is(stores($x), 0);
+
+@foo = $x .. 8;
+is(scalar @foo, 3);
+is("@foo", "6 7 8");
+{
+  local $TODO = "test for double magic with range operator";
+  is(fetches($x), 1);
+}
+is(stores($x), 0);
+
+@foo = $x .. $x + 1;
+is(scalar @foo, 2);
+is("@foo", "6 7");
+{
+  local $TODO = "test for double magic with range operator";
+  is(fetches($x), 2);
+}
+is(stores($x), 0);
+
+@foo = ();
+for (4 .. $x) {
+  push @foo, $_;
+}
+is(scalar @foo, 3);
+is("@foo", "4 5 6");
+{
+  local $TODO = "test for double magic with range operator";
+  is(fetches($x), 1);
+}
+is(stores($x), 0);
+
+@foo = ();
+for (reverse 4 .. $x) {
+  push @foo, $_;
+}
+is(scalar @foo, 3);
+is("@foo", "6 5 4");
+{
+  local $TODO = "test for double magic with range operator";
+  is(fetches($x), 1);
+}
+is(stores($x), 0);
+
+# EOF
diff --git a/gnu/usr.bin/perl/t/op/re_tests b/gnu/usr.bin/perl/t/op/re_tests
index 87a3e50285c..4b0e1209689 100644
--- a/gnu/usr.bin/perl/t/op/re_tests
+++ b/gnu/usr.bin/perl/t/op/re_tests
@@ -1,3 +1,6 @@
+# This stops me getting screenfulls of syntax errors every time I accidentally
+# run this file via a shell glob
+__END__
 abc	abc	y	$&	abc
 abc	abc	y	$-[0]	0
 abc	abc	y	$+[0]	3
@@ -411,6 +414,7 @@ a[-]?c	ac	y	$&	ac
 '(abc)\1'i	ABCABC	y	$1	ABC
 '([a-c]*)\1'i	ABCABC	y	$1	ABC
 a(?!b).	abad	y	$&	ad
+(?=)a	a	y	$&	a
 a(?=d).	abad	y	$&	ad
 a(?=c|d).	abad	y	$&	ad
 a(?:b|c|d)(.)	ace	y	$1	e
@@ -614,6 +618,7 @@ $(?<=^(a))	a	y	$1	a
 ((?>[^()]+)|\([^()]*\))+	((abc(ade)ufh()()x	y	$&	abc(ade)ufh()()x
 (?<=x+)y	-	c	-	Variable length lookbehind not implemented
 a{37,17}	-	c	-	Can't do {n,m} with n > m
+a{37,0}	-	c	-	Can't do {n,m} with n > m
 \Z	a\nb\n	y	$-[0]	3
 \z	a\nb\n	y	$-[0]	4
 $	a\nb\n	y	$-[0]	3
@@ -1281,6 +1286,7 @@ a*(*F)	aaaab	n	-	-
 X(\w+)(?=\s)|X(\w+)	Xab	y	[$1-$2]	[-ab]
 
 #check that branch reset works ok.
+(?|(a))	a	y	$1-$+-$^N	a-a-a
 (?|a(.)b|d(.(o).)d|i(.)(.)j)(.)	d!o!da	y	$1-$2-$3	!o!-o-a
 (?|a(.)b|d(.(o).)d|i(.)(.)j)(.)	aabc	y	$1-$2-$3	a--c
 (?|a(.)b|d(.(o).)d|i(.)(.)j)(.)	ixyjp	y	$1-$2-$3	x-y-p
@@ -1289,6 +1295,11 @@ X(\w+)(?=\s)|X(\w+)	Xab	y	[$1-$2]	[-ab]
 (?|(?|(a)|(b))|(?|(c)|(d)))	c	y	$1	c
 (?|(?|(a)|(b))|(?|(c)|(d)))	d	y	$1	d
 (.)(?|(.)(.)x|(.)d)(.)	abcde	y	$1-$2-$3-$4-$5-	b-c--e--
+(?|(?<foo>x))	x	y	$+{foo}	x
+(?|(?<foo>x)|(?<bar>y))	x	y	$+{foo}	x
+(?|(?<bar>y)|(?<foo>x))	x	y	$+{foo}	x
+(?<bar>)(?|(?<foo>x))	x	y	$+{foo}	x
+
 #Bug #41492
 (?(DEFINE)(?<A>(?&B)+)(?<B>a))(?&A)	a	y	$&	a
 (?(DEFINE)(?<A>(?&B)+)(?<B>a))(?&A)	aa	y	$&	aa
@@ -1338,3 +1349,27 @@ foo(\h)bar	foo\tbar	y	$1	\t
 .*\z	foo\n	y	-	-
 ^(?:(\d)x)?\d$	1	y	${\(defined($1)?1:0)}	0	
 .*?(?:(\w)|(\w))x	abx	y	$1-$2	b-
+
+0{50}	000000000000000000000000000000000000000000000000000	y	-	-
+^a?(?=b)b	ab	y	$&	ab	# Bug #56690
+^a*(?=b)b	ab	y	$&	ab	# Bug #56690
+/>\d+$ \n/ix	>10\n	y	$&	>10
+/>\d+$ \n/ix	>1\n	y	$&	>1
+/\d+$ \n/ix	>10\n	y	$&	10
+/>\d\d$ \n/ix	>10\n	y	$&	>10
+/>\d+$ \n/x	>10\n	y	$&	>10
+
+# Two regressions in 5.8.x (only) introduced by change 30638
+# Simplification of the test failure in XML::LibXML::Simple:
+/^\s*i.*?o\s*$/s	io\n io	y	-	-
+# As reported in #59168 by Father Chrysostomos:
+/(.*?)a(?!(a+)b\2c)/	baaabaac	y	$&-$1	baa-ba
+# [perl #60344] Regex lookbehind failure after an (if)then|else in perl 5.10
+/\A(?(?=db2)db2|\D+)(?<!processed)\.csv\z/xms	sql_processed.csv	n	-	-
+/\N{U+0100}/	\x{100}	y	$&	\x{100}	# Bug #59328
+[\s][\S]	\x{a0}\x{a0}	nT	-	-	# TODO Unicode complements should not match same character
+
+# was generating malformed utf8
+'[\x{100}\xff]'i	\x{ff}	y	$&	\x{ff}
+
+((??{ "(?:|)" }))\s	C\x20 	y	-	-
diff --git a/gnu/usr.bin/perl/t/op/read.t b/gnu/usr.bin/perl/t/op/read.t
index 8235bc20724..23f1b51a2c6 100644
--- a/gnu/usr.bin/perl/t/op/read.t
+++ b/gnu/usr.bin/perl/t/op/read.t
@@ -31,9 +31,7 @@ my $has_perlio = !eval {
     !$Config::Config{useperlio}
 };
 
-my $tmpfile = 'Op_read.tmp';
-
-END { 1 while unlink $tmpfile }
+my $tmpfile = tempfile();
 
 my (@values, @buffers) = ('', '');
 
@@ -56,7 +54,6 @@ foreach my $value (@values) {
 	    skip "Needs :utf8 layer but no perlio", 2 * @offsets * @lengths
 	      if $utf8 and !$has_perlio;
 
-	    1 while unlink $tmpfile;
 	    open FH, ">$tmpfile" or die "Can't open $tmpfile: $!";
 	    binmode FH, "utf8" if $utf8;
 	    print FH $value;
diff --git a/gnu/usr.bin/perl/t/op/readdir.t b/gnu/usr.bin/perl/t/op/readdir.t
index 971a02ada7d..53c7b68c27d 100644
--- a/gnu/usr.bin/perl/t/op/readdir.t
+++ b/gnu/usr.bin/perl/t/op/readdir.t
@@ -20,11 +20,12 @@ if (opendir(OP, "op")) { print "ok 1\n"; } else { print "not ok 1\n"; }
 @D = grep(/^[^\.].*\.t$/i, readdir(OP));
 closedir(OP);
 
-##
-## This range will have to adjust as the number of tests expands,
-## as it's counting the number of .t files in src/t
-##
-my ($min, $max) = (150, 170);
+open $man, "<../MANIFEST" or die "Can't open ../MANIFEST: $!";
+my $expect;
+while (<$man>) {
+    ++$expect if m!^t/op/[^/]+\t!;
+}
+my ($min, $max) = ($expect - 10, $expect + 10);
 if (@D > $min && @D < $max) { print "ok 2\n"; }
 else {
     printf "not ok 2 # counting op/*.t, expect $min < %d < $max files\n",
diff --git a/gnu/usr.bin/perl/t/op/ref.t b/gnu/usr.bin/perl/t/op/ref.t
index 3fdc8333888..a98da6e5a29 100644
--- a/gnu/usr.bin/perl/t/op/ref.t
+++ b/gnu/usr.bin/perl/t/op/ref.t
@@ -8,7 +8,7 @@ BEGIN {
 require 'test.pl';
 use strict qw(refs subs);
 
-plan(138);
+plan(189);
 
 # Test glob operations.
 
@@ -54,11 +54,6 @@ $BAR = \$BAZ;
 $BAZ = "hit";
 is ($$$FOO, 'hit');
 
-# test that ref(vstring) makes sense
-my $vstref = \v1;
-is (ref($vstref), "VSTRING", "ref(vstr) eq VSTRING");
-like ( $vstref, qr/VSTRING\(0x[0-9a-f]+\)/, '\vstr is also VSTRING');
-
 # Test references to real arrays.
 
 my $test = curr_test();
@@ -131,9 +126,49 @@ sub mysub2 { lc shift }
 
 # Test the ref operator.
 
-is (ref $subref, 'CODE');
-is (ref $ref, 'ARRAY');
-is (ref $refref, 'HASH');
+sub PVBM () { 'foo' }
+{ my $dummy = index 'foo', PVBM }
+
+my $pviv = 1; "$pviv";
+my $pvnv = 1.0; "$pvnv";
+my $x;
+
+# we don't test
+#   tied lvalue => SCALAR, as we haven't tested tie yet
+#   BIND, 'cos we can't create them yet
+#   REGEXP, 'cos that requires overload or Scalar::Util
+#   LVALUE ref, 'cos I can't work out how to create one :)
+
+for (
+    [ 'undef',          SCALAR  => \undef               ],
+    [ 'constant IV',    SCALAR  => \1                   ],
+    [ 'constant NV',    SCALAR  => \1.0                 ],
+    [ 'constant PV',    SCALAR  => \'f'                 ],
+    [ 'scalar',         SCALAR  => \$x                  ],
+    [ 'PVIV',           SCALAR  => \$pviv               ],
+    [ 'PVNV',           SCALAR  => \$pvnv               ],
+    [ 'PVMG',           SCALAR  => \$0                  ],
+    [ 'PVBM',           SCALAR  => \PVBM                ],
+    [ 'vstring',        VSTRING => \v1                  ],
+    [ 'ref',            REF     => \\1                  ],
+    [ 'lvalue',         LVALUE  => \substr($x, 0, 0)    ],
+    [ 'named array',    ARRAY   => \@ary                ],
+    [ 'anon array',     ARRAY   => [ 1 ]                ],
+    [ 'named hash',     HASH    => \%whatever           ],
+    [ 'anon hash',      HASH    => { a => 1 }           ],
+    [ 'named sub',      CODE    => \&mysub,             ],
+    [ 'anon sub',       CODE    => sub { 1; }           ],
+    [ 'glob',           GLOB    => \*foo                ],
+    [ 'format',         FORMAT  => *STDERR{FORMAT}      ],
+) {
+    my ($desc, $type, $ref) = @$_;
+    is (ref $ref, $type, "ref() for ref to $desc");
+    like ("$ref", qr/^$type\(0x[0-9a-f]+\)$/, "stringify for ref to $desc");
+}
+
+is (ref *STDOUT{IO}, 'IO::Handle', 'IO refs are blessed into IO::Handle');
+like (*STDOUT{IO}, qr/^IO::Handle=IO\(0x[0-9a-f]+\)$/,
+    'stringify for IO refs');
 
 # Test anonymous hash syntax.
 
@@ -536,6 +571,32 @@ is ( (sub {"bar"})[0]->(), "bar", 'code deref from list slice w/ ->' );
     is($ref, *{$ref}{IO}, "IO slot of the temporary glob is set correctly");
 }
 
+# these will segfault if they fail
+
+my $pvbm = PVBM;
+my $rpvbm = \$pvbm;
+
+ok (!eval { *$rpvbm }, 'PVBM ref is not a GLOB ref');
+ok (!eval { *$pvbm }, 'PVBM is not a GLOB ref');
+ok (!eval { $$pvbm }, 'PVBM is not a SCALAR ref');
+ok (!eval { @$pvbm }, 'PVBM is not an ARRAY ref');
+ok (!eval { %$pvbm }, 'PVBM is not a HASH ref');
+ok (!eval { $pvbm->() }, 'PVBM is not a CODE ref');
+ok (!eval { $rpvbm->foo }, 'PVBM is not an object');
+
+# bug 24254
+is( runperl(stderr => 1, prog => 'map eval qq(exit),1 for 1'), "");
+is( runperl(stderr => 1, prog => 'eval { for (1) { map { die } 2 } };'), "");
+is( runperl(stderr => 1, prog => 'for (125) { map { exit } (213)}'), "");
+my $hushed = $^O eq 'VMS' ? 'use vmsish qw(hushed);' : '';
+is( runperl(stderr => 1, prog => $hushed . 'map die,4 for 3'), "Died at -e line 1.\n");
+is( runperl(stderr => 1, prog => $hushed . 'grep die,4 for 3'), "Died at -e line 1.\n");
+is( runperl(stderr => 1, prog => $hushed . 'for $a (3) {@b=sort {die} 4,5}'), "Died at -e line 1.\n");
+
+# bug 57564
+is( runperl(stderr => 1, prog => 'my $i;for $i (1) { for $i (2) { } }'), "");
+
+
 # Bit of a hack to make test.pl happy. There are 3 more tests after it leaves.
 $test = curr_test();
 curr_test($test + 3);
diff --git a/gnu/usr.bin/perl/t/op/regexp.t b/gnu/usr.bin/perl/t/op/regexp.t
index 7ad7d89bc92..ba5da62b656 100644
--- a/gnu/usr.bin/perl/t/op/regexp.t
+++ b/gnu/usr.bin/perl/t/op/regexp.t
@@ -13,8 +13,10 @@
 # 	y	expect a match
 # 	n	expect no match
 # 	c	expect an error
+#	T	the test is a TODO (can be combined with y/n/c)
 #	B	test exposes a known bug in Perl, should be skipped
 #	b	test exposes a known bug in Perl, should be skipped if noamp
+#	t	test exposes a bug with threading, TODO if qr_embed_thr
 #
 # Columns 4 and 5 are used only if column 3 contains C<y> or C<c>.
 #
@@ -49,12 +51,25 @@ BEGIN {
 
     chdir 't' if -d 't';
     @INC = '../lib';
+
+    if ($qr_embed_thr) {
+	require Config;
+	if (!$Config::Config{useithreads}) {
+	    print "1..0 # Skip: no ithreads\n";
+		exit 0;
+	}
+	if ($ENV{PERL_CORE_MINITEST}) {
+	    print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
+		exit 0;
+	}
+	require threads;
+    }
 }
 
 use strict;
 use warnings FATAL=>"all";
 use vars qw($iters $numtests $bang $ffff $nulnul $OP);
-use vars qw($qr $skip_amp $qr_embed); # set by our callers
+use vars qw($qr $skip_amp $qr_embed $qr_embed_thr); # set by our callers
 
 
 if (!defined $file) {
@@ -73,13 +88,14 @@ $OP = $qr ? 'qr' : 'm';
 
 $| = 1;
 printf "1..%d\n# $iters iterations\n", scalar @tests;
+
 my $test;
 TEST:
 foreach (@tests) {
     $test++;
-    if (!/\S/ || /^\s*#/) {
+    if (!/\S/ || /^\s*#/ || /^__END__$/) {
         print "ok $test # (Blank line or comment)\n";
-        if (/\S/) { print $_ };
+        if (/#/) { print $_ };
         next;
     }
     chomp;
@@ -87,15 +103,19 @@ foreach (@tests) {
     my ($pat, $subject, $result, $repl, $expect, $reason) = split(/\t/,$_,6);
     $reason = '' unless defined $reason;
     my $input = join(':',$pat,$subject,$result,$repl,$expect);
-    $pat = "'$pat'" unless $pat =~ /^[:'\/]/;
+    # the double '' below keeps simple syntax highlighters from going crazy
+    $pat = "'$pat'" unless $pat =~ /^[:''\/]/; 
     $pat =~ s/(\$\{\w+\})/$1/eeg;
     $pat =~ s/\\n/\n/g;
     $subject = eval qq("$subject"); die $@ if $@;
     $expect  = eval qq("$expect"); die $@ if $@;
     $expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/;
+    my $todo_qr = $qr_embed_thr && ($result =~ s/t//);
     my $skip = ($skip_amp ? ($result =~ s/B//i) : ($result =~ s/B//));
     $reason = 'skipping $&' if $reason eq  '' && $skip_amp;
     $result =~ s/B//i unless $skip;
+    my $todo= $result =~ s/T// ? " # TODO" : "";
+    
 
     for my $study ('', 'study $subject', 'utf8::upgrade($subject)',
 		   'utf8::upgrade($subject); study $subject') {
@@ -120,6 +140,16 @@ EOFCODE
                 \$got = "$repl";
 EOFCODE
         }
+        elsif ($qr_embed_thr) {
+            $code= <<EOFCODE;
+		# Can't run the match in a subthread, but can do this and
+	 	# clone the pattern the other way.
+                my \$RE = threads->new(sub {qr$pat})->join();
+                $study;
+                \$match = (\$subject =~ /(?:)\$RE(?:)/) while \$c--;
+                \$got = "$repl";
+EOFCODE
+        }
         else {
             $code= <<EOFCODE;
                 $study;
@@ -139,35 +169,39 @@ EOFCODE
 	}
 	chomp( my $err = $@ );
 	if ($result eq 'c') {
-	    if ($err !~ m!^\Q$expect!) { print "not ok $test (compile) $input => `$err'\n"; next TEST }
+	    if ($err !~ m!^\Q$expect!) { print "not ok $test$todo (compile) $input => `$err'\n"; next TEST }
 	    last;  # no need to study a syntax error
 	}
 	elsif ( $skip ) {
 	    print "ok $test # skipped", length($reason) ? " $reason" : '', "\n";
 	    next TEST;
 	}
+	elsif ( $todo_qr ) {
+	    print "not ok $test # TODO", length($reason) ? " - $reason" : '', "\n";
+	    next TEST;
+	}
 	elsif ($@) {
-	    print "not ok $test $input => error `$err'\n$code\n$@\n"; next TEST;
+	    print "not ok $test$todo $input => error `$err'\n$code\n$@\n"; next TEST;
 	}
-	elsif ($result eq 'n') {
-	    if ($match) { print "not ok $test ($study) $input => false positive\n"; next TEST }
+	elsif ($result =~ /^n/) {
+	    if ($match) { print "not ok $test$todo ($study) $input => false positive\n"; next TEST }
 	}
 	else {
 	    if (!$match || $got ne $expect) {
 	        eval { require Data::Dumper };
 		if ($@) {
-		    print "not ok $test ($study) $input => `$got', match=$match\n$code\n";
+		    print "not ok $test$todo ($study) $input => `$got', match=$match\n$code\n";
 		}
 		else { # better diagnostics
 		    my $s = Data::Dumper->new([$subject],['subject'])->Useqq(1)->Dump;
 		    my $g = Data::Dumper->new([$got],['got'])->Useqq(1)->Dump;
-		    print "not ok $test ($study) $input => `$got', match=$match\n$s\n$g\n$code\n";
+		    print "not ok $test$todo ($study) $input => `$got', match=$match\n$s\n$g\n$code\n";
 		}
 		next TEST;
 	    }
 	}
     }
-    print "ok $test\n";
+    print "ok $test$todo\n";
 }
 
 1;
diff --git a/gnu/usr.bin/perl/t/op/runlevel.t b/gnu/usr.bin/perl/t/op/runlevel.t
index 36c63effac8..44aedc0c081 100644
--- a/gnu/usr.bin/perl/t/op/runlevel.t
+++ b/gnu/usr.bin/perl/t/op/runlevel.t
@@ -8,6 +8,7 @@
 
 chdir 't' if -d 't';
 @INC = '../lib';
+require './test.pl';
 $Is_VMS = $^O eq 'VMS';
 $Is_MSWin32 = $^O eq 'MSWin32';
 $Is_NetWare = $^O eq 'NetWare';
@@ -20,9 +21,7 @@ undef $/;
 @prgs = split "\n########\n", <DATA>;
 print "1..", scalar @prgs, "\n";
 
-$tmpfile = "runltmp000";
-1 while -f ++$tmpfile;
-END { if ($tmpfile) { 1 while unlink $tmpfile; } }
+$tmpfile = tempfile();
 
 for (@prgs){
     my $switch = "";
@@ -45,7 +44,7 @@ for (@prgs){
     my $status = $?;
     $results =~ s/\n+$//;
     # allow expected output to be written as if $prog is on STDIN
-    $results =~ s/runltmp\d+/-/g;
+    $results =~ s/$::tempfile_regexp/-/ig;
     $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
     $expected =~ s/\n+$//;
     if ($results ne $expected) {
diff --git a/gnu/usr.bin/perl/t/op/sort.t b/gnu/usr.bin/perl/t/op/sort.t
index 737727ef747..616761a05d4 100644
--- a/gnu/usr.bin/perl/t/op/sort.t
+++ b/gnu/usr.bin/perl/t/op/sort.t
@@ -2,10 +2,11 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib); require 'test.pl';
+    @INC = qw(. ../lib);
+    require 'test.pl';
 }
 use warnings;
-plan( tests => 143 );
+plan( tests => 144 );
 
 # these shouldn't hang
 {
@@ -260,48 +261,43 @@ $x = join('', sort { $a <=> $b } 3, 1, 2);
 cmp_ok($x,'eq','123',q(optimized-away comparison block doesn't take any other arguments away with it));
 
 # test sorting in non-main package
-package Foo;
-@a = ( 5, 19, 1996, 255, 90 );
-@b = sort { $b <=> $a } @a;
-main::cmp_ok("@b",'eq','1996 255 90 19 5','not in main:: 1');
-
-
-@b = sort main::Backwards_stacked @a;
-main::cmp_ok("@b",'eq','90 5 255 1996 19','not in main:: 2');
-
-
-# check if context for sort arguments is handled right
-
-
-sub test_if_list {
-    my $gimme = wantarray;
-    main::is($gimme,1,'wantarray 1');
-
-
-}
-my $m = sub { $a <=> $b };
-
-sub cxt_one { sort $m test_if_list() }
-cxt_one();
-sub cxt_two { sort { $a <=> $b } test_if_list() }
-cxt_two();
-sub cxt_three { sort &test_if_list() }
-cxt_three();
+{
+    package Foo;
+    @a = ( 5, 19, 1996, 255, 90 );
+    @b = sort { $b <=> $a } @a;
+    ::cmp_ok("@b",'eq','1996 255 90 19 5','not in main:: 1');
 
-sub test_if_scalar {
-    my $gimme = wantarray;
-    main::is(!($gimme or !defined($gimme)),1,'wantarray 2');
+    @b = sort ::Backwards_stacked @a;
+    ::cmp_ok("@b",'eq','90 5 255 1996 19','not in main:: 2');
 
+    # check if context for sort arguments is handled right
+    sub test_if_list {
+        my $gimme = wantarray;
+        ::is($gimme,1,'wantarray 1');
+    }
+    my $m = sub { $a <=> $b };
+
+    sub cxt_one { sort $m test_if_list() }
+    cxt_one();
+    sub cxt_two { sort { $a <=> $b } test_if_list() }
+    cxt_two();
+    sub cxt_three { sort &test_if_list() }
+    cxt_three();
+
+    sub test_if_scalar {
+        my $gimme = wantarray;
+        ::is(!($gimme or !defined($gimme)),1,'wantarray 2');
+    }
 
+    $m = \&test_if_scalar;
+    sub cxt_four { sort $m 1,2 }
+    @x = cxt_four();
+    sub cxt_five { sort { test_if_scalar($a,$b); } 1,2 }
+    @x = cxt_five();
+    sub cxt_six { sort test_if_scalar 1,2 }
+    @x = cxt_six();
 }
 
-$m = \&test_if_scalar;
-sub cxt_four { sort $m 1,2 }
-@x = cxt_four();
-sub cxt_five { sort { test_if_scalar($a,$b); } 1,2 }
-@x = cxt_five();
-sub cxt_six { sort test_if_scalar 1,2 }
-@x = cxt_six();
 
 # test against a reentrancy bug
 {
@@ -316,84 +312,81 @@ sub cxt_six { sort test_if_scalar 1,2 }
 	Bar::reenter() unless $init++;
 	$a <=> $b
     } qw/4 3 1 2/;
-    main::cmp_ok("@b",'eq','1 2 3 4','reenter 1');
+    cmp_ok("@b",'eq','1 2 3 4','reenter 1');
 
-    main::ok(!$def,'reenter 2');
+    ok(!$def,'reenter 2');
 }
 
 
 {
     sub routine { "one", "two" };
     @a = sort(routine(1));
-    main::cmp_ok("@a",'eq',"one two",'bug id 19991001.003');
+    cmp_ok("@a",'eq',"one two",'bug id 19991001.003');
 }
 
 
-#my $test = 59;
-sub ok { main::cmp_ok($_[0],'eq',$_[1],$_[2]);
-#    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";
+    is "$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";
+    is "$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";
+    is "$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";
+    is "$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";
+    is "$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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@a", "c b a x", "un-inplace sort with function of lexical 2";
+
+    # RT#54758. Git 62b40d2474e7487e6909e1872b6bccdf812c6818
+    no warnings 'void';
+    my @m; push @m, 0 for 1 .. 1024; $#m; @m = sort @m;
+    ::pass("in-place sorting segfault");
 }
 
 # Test optimisations of reversed sorts. As we now guarantee stability by
@@ -419,77 +412,77 @@ sub generate {
 
 my @input = &generate;
 my @output = sort @input;
-ok join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", "Simple stable sort";
+is join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", "Simple stable sort";
 
 @input = &generate;
 @input = sort @input;
-ok join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8",
+is join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8",
     "Simple stable in place sort";
 
 # This won't be very interesting
 @input = &generate;
 @output = sort {$a <=> $b} @input;
-ok "@output", "A A A B B B C C C", 'stable $a <=> $b sort';
+is "@output", "A A A B B B C C C", 'stable $a <=> $b sort';
 
 @input = &generate;
 @output = sort {$a cmp $b} @input;
-ok join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", 'stable $a cmp $b sort';
+is join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", 'stable $a cmp $b sort';
 
 @input = &generate;
 @input = sort {$a cmp $b} @input;
-ok join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8",
+is join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8",
     'stable $a cmp $b in place sort';
 
 @input = &generate;
 @output = sort {$b cmp $a} @input;
-ok join(" ", map {0+$_} @output), "6 7 8 3 4 5 0 1 2", 'stable $b cmp $a sort';
+is join(" ", map {0+$_} @output), "6 7 8 3 4 5 0 1 2", 'stable $b cmp $a sort';
 
 @input = &generate;
 @input = sort {$b cmp $a} @input;
-ok join(" ", map {0+$_} @input), "6 7 8 3 4 5 0 1 2",
+is join(" ", map {0+$_} @input), "6 7 8 3 4 5 0 1 2",
     'stable $b cmp $a in place sort';
 
 @input = &generate;
 @output = reverse sort @input;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0", "Reversed stable sort";
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0", "Reversed stable sort";
 
 @input = &generate;
 @input = reverse sort @input;
-ok join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
     "Reversed stable in place sort";
 
 @input = &generate;
 my $output = reverse sort @input;
-ok $output, "CCCBBBAAA", "Reversed stable sort in scalar context";
+is $output, "CCCBBBAAA", "Reversed stable sort in scalar context";
 
 
 @input = &generate;
 @output = reverse sort {$a cmp $b} @input;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
     'reversed stable $a cmp $b sort';
 
 @input = &generate;
 @input = reverse sort {$a cmp $b} @input;
-ok join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
     'revesed stable $a cmp $b in place sort';
 
 @input = &generate;
 $output = reverse sort {$a cmp $b} @input;
-ok $output, "CCCBBBAAA", 'Reversed stable $a cmp $b sort in scalar context';
+is $output, "CCCBBBAAA", 'Reversed stable $a cmp $b sort in scalar context';
 
 @input = &generate;
 @output = reverse sort {$b cmp $a} @input;
-ok join(" ", map {0+$_} @output), "2 1 0 5 4 3 8 7 6",
+is join(" ", map {0+$_} @output), "2 1 0 5 4 3 8 7 6",
     'reversed stable $b cmp $a sort';
 
 @input = &generate;
 @input = reverse sort {$b cmp $a} @input;
-ok join(" ", map {0+$_} @input), "2 1 0 5 4 3 8 7 6",
+is join(" ", map {0+$_} @input), "2 1 0 5 4 3 8 7 6",
     'revesed stable $b cmp $a in place sort';
 
 @input = &generate;
 $output = reverse sort {$b cmp $a} @input;
-ok $output, "AAABBBCCC", 'Reversed stable $b cmp $a sort in scalar context';
+is $output, "AAABBBCCC", 'Reversed stable $b cmp $a sort in scalar context';
 
 sub stuff {
     # Something complex enough to defeat any constant folding optimiser
@@ -498,27 +491,27 @@ sub stuff {
 
 @input = &generate;
 @output = reverse sort {stuff || $a cmp $b} @input;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
     'reversed stable complex sort';
 
 @input = &generate;
 @input = reverse sort {stuff || $a cmp $b} @input;
-ok join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
     'revesed stable complex in place sort';
 
 @input = &generate;
 $output = reverse sort {stuff || $a cmp $b } @input;
-ok $output, "CCCBBBAAA", 'Reversed stable complex sort in scalar context';
+is $output, "CCCBBBAAA", 'Reversed stable complex sort in scalar context';
 
 sub sortr {
     reverse sort @_;
 }
 
 @output = sortr &generate;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
     'reversed stable sort return list context';
 $output = sortr &generate;
-ok $output, "CCCBBBAAA",
+is $output, "CCCBBBAAA",
     'reversed stable sort return scalar context';
 
 sub sortcmpr {
@@ -526,10 +519,10 @@ sub sortcmpr {
 }
 
 @output = sortcmpr &generate;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
     'reversed stable $a cmp $b sort return list context';
 $output = sortcmpr &generate;
-ok $output, "CCCBBBAAA",
+is $output, "CCCBBBAAA",
     'reversed stable $a cmp $b sort return scalar context';
 
 sub sortcmprba {
@@ -537,10 +530,10 @@ sub sortcmprba {
 }
 
 @output = sortcmprba &generate;
-ok join(" ", map {0+$_} @output), "2 1 0 5 4 3 8 7 6",
+is join(" ", map {0+$_} @output), "2 1 0 5 4 3 8 7 6",
     'reversed stable $b cmp $a sort return list context';
 $output = sortcmprba &generate;
-ok $output, "AAABBBCCC",
+is $output, "AAABBBCCC",
 'reversed stable $b cmp $a sort return scalar context';
 
 sub sortcmprq {
@@ -548,10 +541,10 @@ sub sortcmprq {
 }
 
 @output = sortcmpr &generate;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
     'reversed stable complex sort return list context';
 $output = sortcmpr &generate;
-ok $output, "CCCBBBAAA",
+is $output, "CCCBBBAAA",
     'reversed stable complex sort return scalar context';
 
 # And now with numbers
@@ -564,148 +557,148 @@ sub generate1 {
 # This won't be very interesting
 @input = &generate1;
 @output = sort {$a cmp $b} @input;
-ok "@output", "A B C D E F G H I", 'stable $a cmp $b sort';
+is "@output", "A B C D E F G H I", 'stable $a cmp $b sort';
 
 @input = &generate1;
 @output = sort {$a <=> $b} @input;
-ok "@output", "A B C D E F G H I", 'stable $a <=> $b sort';
+is "@output", "A B C D E F G H I", 'stable $a <=> $b sort';
 
 @input = &generate1;
 @input = sort {$a <=> $b} @input;
-ok "@input", "A B C D E F G H I", 'stable $a <=> $b in place sort';
+is "@input", "A B C D E F G H I", 'stable $a <=> $b in place sort';
 
 @input = &generate1;
 @output = sort {$b <=> $a} @input;
-ok "@output", "G H I D E F A B C", 'stable $b <=> $a sort';
+is "@output", "G H I D E F A B C", 'stable $b <=> $a sort';
 
 @input = &generate1;
 @input = sort {$b <=> $a} @input;
-ok "@input", "G H I D E F A B C", 'stable $b <=> $a in place sort';
+is "@input", "G H I D E F A B C", 'stable $b <=> $a in place sort';
 
 # test that optimized {$b cmp $a} and {$b <=> $a} remain stable
 # (new in 5.9) without overloading
 { no warnings;
 @b = sort { $b <=> $a } @input = qw/5first 6first 5second 6second/;
-ok "@b" , "6first 6second 5first 5second", "optimized {$b <=> $a} without overloading" ;
+is "@b" , "6first 6second 5first 5second", "optimized {$b <=> $a} without overloading" ;
 @input = sort {$b <=> $a} @input;
-ok "@input" , "6first 6second 5first 5second","inline optimized {$b <=> $a} without overloading" ;
+is "@input" , "6first 6second 5first 5second","inline optimized {$b <=> $a} without overloading" ;
 };
 
 # These two are actually doing string cmp on 0 1 and 2
 @input = &generate1;
 @output = reverse sort @input;
-ok "@output", "I H G F E D C B A", "Reversed stable sort";
+is "@output", "I H G F E D C B A", "Reversed stable sort";
 
 @input = &generate1;
 @input = reverse sort @input;
-ok "@input", "I H G F E D C B A", "Reversed stable in place sort";
+is "@input", "I H G F E D C B A", "Reversed stable in place sort";
 
 @input = &generate1;
 $output = reverse sort @input;
-ok $output, "IHGFEDCBA", "Reversed stable sort in scalar context";
+is $output, "IHGFEDCBA", "Reversed stable sort in scalar context";
 
 @input = &generate1;
 @output = reverse sort {$a <=> $b} @input;
-ok "@output", "I H G F E D C B A", 'reversed stable $a <=> $b sort';
+is "@output", "I H G F E D C B A", 'reversed stable $a <=> $b sort';
 
 @input = &generate1;
 @input = reverse sort {$a <=> $b} @input;
-ok "@input", "I H G F E D C B A", 'revesed stable $a <=> $b in place sort';
+is "@input", "I H G F E D C B A", 'revesed stable $a <=> $b in place sort';
 
 @input = &generate1;
 $output = reverse sort {$a <=> $b} @input;
-ok $output, "IHGFEDCBA", 'reversed stable $a <=> $b sort in scalar context';
+is $output, "IHGFEDCBA", 'reversed stable $a <=> $b sort in scalar context';
 
 @input = &generate1;
 @output = reverse sort {$b <=> $a} @input;
-ok "@output", "C B A F E D I H G", 'reversed stable $b <=> $a sort';
+is "@output", "C B A F E D I H G", 'reversed stable $b <=> $a sort';
 
 @input = &generate1;
 @input = reverse sort {$b <=> $a} @input;
-ok "@input", "C B A F E D I H G", 'revesed stable $b <=> $a in place sort';
+is "@input", "C B A F E D I H G", 'revesed stable $b <=> $a in place sort';
 
 @input = &generate1;
 $output = reverse sort {$b <=> $a} @input;
-ok $output, "CBAFEDIHG", 'reversed stable $b <=> $a sort in scalar context';
+is $output, "CBAFEDIHG", 'reversed stable $b <=> $a sort in scalar context';
 
 @input = &generate1;
 @output = reverse sort {stuff || $a <=> $b} @input;
-ok "@output", "I H G F E D C B A", 'reversed stable complex sort';
+is "@output", "I H G F E D C B A", 'reversed stable complex sort';
 
 @input = &generate1;
 @input = reverse sort {stuff || $a <=> $b} @input;
-ok "@input", "I H G F E D C B A", 'revesed stable complex in place sort';
+is "@input", "I H G F E D C B A", 'revesed stable complex in place sort';
 
 @input = &generate1;
 $output = reverse sort {stuff || $a <=> $b} @input;
-ok $output, "IHGFEDCBA", 'reversed stable complex sort in scalar context';
+is $output, "IHGFEDCBA", 'reversed stable complex sort in scalar context';
 
 sub sortnumr {
     reverse sort {$a <=> $b} @_;
 }
 
 @output = sortnumr &generate1;
-ok "@output", "I H G F E D C B A",
+is "@output", "I H G F E D C B A",
     'reversed stable $a <=> $b sort return list context';
 $output = sortnumr &generate1;
-ok $output, "IHGFEDCBA", 'reversed stable $a <=> $b sort return scalar context';
+is $output, "IHGFEDCBA", 'reversed stable $a <=> $b sort return scalar context';
 
 sub sortnumrba {
     reverse sort {$b <=> $a} @_;
 }
 
 @output = sortnumrba &generate1;
-ok "@output", "C B A F E D I H G",
+is "@output", "C B A F E D I H G",
     'reversed stable $b <=> $a sort return list context';
 $output = sortnumrba &generate1;
-ok $output, "CBAFEDIHG", 'reversed stable $b <=> $a sort return scalar context';
+is $output, "CBAFEDIHG", 'reversed stable $b <=> $a sort return scalar context';
 
 sub sortnumrq {
     reverse sort {stuff || $a <=> $b} @_;
 }
 
 @output = sortnumrq &generate1;
-ok "@output", "I H G F E D C B A",
+is "@output", "I H G F E D C B A",
     'reversed stable complex sort return list context';
 $output = sortnumrq &generate1;
-ok $output, "IHGFEDCBA", 'reversed stable complex sort return scalar context';
+is $output, "IHGFEDCBA", 'reversed stable complex sort return scalar context';
 
 @output = reverse (sort(qw(C A B)), 0);
-ok "@output", "0 C B A", 'reversed sort with trailing argument';
+is "@output", "0 C B A", 'reversed sort with trailing argument';
 
 @output = reverse (0, sort(qw(C A B)));
-ok "@output", "C B A 0", 'reversed sort with leading argument';
+is "@output", "C B A 0", 'reversed sort with leading argument';
 
 eval { @output = sort {goto sub {}} 1,2; };
 $fail_msg = q(Can't goto subroutine outside a subroutine);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto subr outside subr');
+cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto subr outside subr');
 
 
 
 sub goto_sub {goto sub{}}
 eval { @output = sort goto_sub 1,2; };
 $fail_msg = q(Can't goto subroutine from a sort sub);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto subr from a sort sub');
+cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto subr from a sort sub');
 
 
 
 eval { @output = sort {goto label} 1,2; };
 $fail_msg = q(Can't "goto" out of a pseudo block);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto out of a pseudo block 1');
+cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto out of a pseudo block 1');
 
 
 
 sub goto_label {goto label}
 label: eval { @output = sort goto_label 1,2; };
 $fail_msg = q(Can't "goto" out of a pseudo block);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto out of a pseudo block 2');
+cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto out of a pseudo block 2');
 
 
 
 sub self_immolate {undef &self_immolate; $a<=>$b}
 eval { @output = sort self_immolate 1,2,3 };
 $fail_msg = q(Can't undef active subroutine);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'undef active subr');
+cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'undef active subr');
 
 
 
@@ -724,13 +717,12 @@ main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'undef active subr');
     }
 
     rec(1);
-    main::ok(!$failed, "sort from active sub");
+    ok(!$failed, "sort from active sub");
 }
 
 # $a and $b are set in the package the sort() is called from,
 # *not* the package the sort sub is in. This is longstanding
 # de facto behaviour that shouldn't be broken.
-package main;
 my $answer = "good";
 () = sort OtherPack::foo 1,2,3,4;
 
@@ -744,62 +736,68 @@ my $answer = "good";
     }
 }
 
-main::cmp_ok($answer,'eq','good','sort subr called from other package');
+cmp_ok($answer,'eq','good','sort subr called from other package');
 
 
 # Bug 36430 - sort called in package2 while a
 # sort in package1 is active should set $package2::a/b.
-
-$answer = "good";
-my @list = sort { A::min(@$a) <=> A::min(@$b) }
-  [3, 1, 5], [2, 4], [0];
-
-main::cmp_ok($answer,'eq','good','bug 36430');
-
-package A;
-sub min {
-  my @list = sort {
-    $answer = '$a and/or $b are not defined ' if !defined($a) || !defined($b);
-    $a <=> $b;
-  } @_;
-  $list[0];
+{
+    my $answer = "good";
+    my @list = sort { A::min(@$a) <=> A::min(@$b) }
+      [3, 1, 5], [2, 4], [0];
+
+    cmp_ok($answer,'eq','good','bug 36430');
+
+    package A;
+    sub min {
+        my @list = sort {
+            $answer = '$a and/or $b are not defined ' if !defined($a) || !defined($b);
+            $a <=> $b;
+        } @_;
+        $list[0];
+    }
 }
 
+
 # Bug 7567 - an array shouldn't be modifiable while it's being
 # sorted in-place.
-eval { @a=(1..8); @a = sort { @a = (0) } @a; };
-
-$fail_msg = q(Modification of a read-only value attempted);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'bug 7567');
+{
+    eval { @a=(1..8); @a = sort { @a = (0) } @a; };
 
+    $fail_msg = q(Modification of a read-only value attempted);
+    cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'bug 7567');
+}
 
 
 # Sorting shouldn't increase the refcount of a sub
-sub foo {(1+$a) <=> (1+$b)}
-my $refcnt = &Internals::SvREFCNT(\&foo);
-@output = sort foo 3,7,9;
-package Foo;
-ok($refcnt, &Internals::SvREFCNT(\&foo), "sort sub refcnt");
-$fail_msg = q(Modification of a read-only value attempted);
-# Sorting a read-only array in-place shouldn't be allowed
-my @readonly = (1..10);
-Internals::SvREADONLY(@readonly, 1);
-eval { @readonly = sort @readonly; };
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'in-place sort of read-only array');
-
-
+{
+    sub foo {(1+$a) <=> (1+$b)}
+    my $refcnt = &Internals::SvREFCNT(\&foo);
+    @output = sort foo 3,7,9;
+
+    {
+        package Foo;
+        ::is($refcnt, &Internals::SvREFCNT(\&foo), "sort sub refcnt");
+        $fail_msg = q(Modification of a read-only value attempted);
+        # Sorting a read-only array in-place shouldn't be allowed
+        my @readonly = (1..10);
+        Internals::SvREADONLY(@readonly, 1);
+        eval { @readonly = sort @readonly; };
+        ::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'in-place sort of read-only array');
+    }
+}
 
 
 # Using return() should be okay even in a deeper context
 @b = sort {while (1) {return ($a <=> $b)} } 1..10;
-ok("@b", "1 2 3 4 5 6 7 8 9 10", "return within loop");
+is("@b", "1 2 3 4 5 6 7 8 9 10", "return within loop");
 
 # Using return() should be okay even if there are other items
 # on the stack at the time.
 @b = sort {$_ = ($a<=>$b) + do{return $b<=> $a}} 1..10;
-ok("@b", "10 9 8 7 6 5 4 3 2 1", "return with SVs on stack");
+is("@b", "10 9 8 7 6 5 4 3 2 1", "return with SVs on stack");
 
 # As above, but with a sort sub rather than a sort block.
 sub ret_with_stacked { $_ = ($a<=>$b) + do {return $b <=> $a} }
 @b = sort ret_with_stacked 1..10;
-ok("@b", "10 9 8 7 6 5 4 3 2 1", "return with SVs on stack");
+is("@b", "10 9 8 7 6 5 4 3 2 1", "return with SVs on stack");
diff --git a/gnu/usr.bin/perl/t/op/split.t b/gnu/usr.bin/perl/t/op/split.t
index 025327f3853..b3a97415691 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 => 135;
+plan tests => 136;
 
 $FS = ':';
 
@@ -358,3 +358,9 @@ ok(@ary == 3 &&
     is($s[2]," XYZ");
     is(join(':',@s), join(':',@r));
 }
+
+{
+    use constant BANG => {};
+    () = split m/,/, "", BANG;
+    ok(1);
+}
diff --git a/gnu/usr.bin/perl/t/op/sprintf.t b/gnu/usr.bin/perl/t/op/sprintf.t
index c2209467454..ba77e64cf84 100644
--- a/gnu/usr.bin/perl/t/op/sprintf.t
+++ b/gnu/usr.bin/perl/t/op/sprintf.t
@@ -49,8 +49,8 @@ while (<DATA>) {
     }
 
     $evalData = eval $data;
-    $data = ref $evalData ? $evalData : [$evalData];
-    push @tests, [$template, $data, $result, $comment];
+    $evalData = ref $evalData ? $evalData : [$evalData];
+    push @tests, [$template, $evalData, $result, $comment, $data];
 }
 
 print '1..', scalar @tests, "\n";
@@ -66,9 +66,9 @@ $SIG{__WARN__} = sub {
 };
 
 for ($i = 1; @tests; $i++) {
-    ($template, $data, $result, $comment) = @{shift @tests};
+    ($template, $evalData, $result, $comment, $data) = @{shift @tests};
     $w = undef;
-    $x = sprintf(">$template<", @$data);
+    $x = sprintf(">$template<", @$evalData);
     substr($x, -1, 0) = $w if $w;
     # $x may have 3 exponent digits, not 2
     my $y = $x;
diff --git a/gnu/usr.bin/perl/t/op/sprintf2.t b/gnu/usr.bin/perl/t/op/sprintf2.t
index c92ab897023..1327cdd67ca 100755
--- a/gnu/usr.bin/perl/t/op/sprintf2.t
+++ b/gnu/usr.bin/perl/t/op/sprintf2.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }   
 
-plan tests => 1292;
+plan tests => 1368;
 
 is(
     sprintf("%.40g ",0.01),
@@ -134,3 +134,28 @@ for my $num (0, -1, 1) {
     }
 }
 
+# test that %f doesn't panic with +Inf, -Inf, NaN [perl #45383]
+foreach my $n (2**1e100, -2**1e100, 2**1e100/2**1e100) { # +Inf, -Inf, NaN
+    eval { my $f = sprintf("%f", $n); };
+    is $@, "", "sprintf(\"%f\", $n)";
+}
+
+SKIP: {
+    skip "placeholder for tests not merged from 53f65a9ef4", 24;
+}
+
+# Check unicode vs byte length
+for my $width (1,2,3,4,5,6,7) {
+    for my $precis (1,2,3,4,5,6,7) {
+        my $v = "\x{20ac}\x{20ac}";
+        my $format = "%" . $width . "." . $precis . "s";
+        my $chars = ($precis > 2 ? 2 : $precis);
+        my $space = ($width < 2 ? 0 : $width - $chars);
+        fresh_perl_is(
+            'my $v = "\x{20ac}\x{20ac}"; my $x = sprintf "'.$format.'", $v; $x =~ /^(\s*)(\S*)$/; print "$_" for map {length} $1, $2',
+            "$space$chars",
+            {},
+            q(sprintf ").$format.q(", "\x{20ac}\x{20ac}"),
+        );
+    }
+}
diff --git a/gnu/usr.bin/perl/t/op/stat.t b/gnu/usr.bin/perl/t/op/stat.t
index dbddaef6546..a225de4f257 100644
--- a/gnu/usr.bin/perl/t/op/stat.t
+++ b/gnu/usr.bin/perl/t/op/stat.t
@@ -38,8 +38,8 @@ my($DEV, $INO, $MODE, $NLINK, $UID, $GID, $RDEV, $SIZE,
 my $Curdir = File::Spec->curdir;
 
 
-my $tmpfile = 'Op_stat.tmp';
-my $tmpfile_link = $tmpfile.'2';
+my $tmpfile = tempfile();
+my $tmpfile_link = tempfile();
 
 chmod 0666, $tmpfile;
 1 while unlink $tmpfile;
@@ -50,6 +50,10 @@ open(FOO, ">$tmpfile") || DIE("Can't open temp test file: $!");
 
 my($nlink, $mtime, $ctime) = (stat(FOO))[$NLINK, $MTIME, $CTIME];
 
+# The clock on a network filesystem might be different from the
+# system clock.
+my $Filesystem_Time_Offset = abs($mtime - time); 
+
 #nlink should if link support configured in Perl.
 SKIP: {
     skip "No link count - Hard link support not built in.", 1
@@ -453,20 +457,24 @@ SKIP: {
     unlink $linkname or print "# unlink $linkname failed: $!\n";
 }
 
-print "# Zzz...\n";
-sleep(3);
-my $f = 'tstamp.tmp';
-unlink $f;
-ok (open(S, "> $f"), 'can create tmp file');
-close S or die;
-my @a = stat $f;
-print "# time=$^T, stat=(@a)\n";
-my @b = (-M _, -A _, -C _);
-print "# -MAC=(@b)\n";
-ok( (-M _) < 0, 'negative -M works');
-ok( (-A _) < 0, 'negative -A works');
-ok( (-C _) < 0, 'negative -C works');
-ok(unlink($f), 'unlink tmp file');
+SKIP: {
+    skip "Too much clock skew between system and filesystem", 5
+	if ($Filesystem_Time_Offset > 5);
+    print "# Zzz...\n";
+    sleep($Filesystem_Time_Offset+1);
+    my $f = 'tstamp.tmp';
+    unlink $f;
+    ok (open(S, "> $f"), 'can create tmp file');
+    close S or die;
+    my @a = stat $f;
+    print "# time=$^T, stat=(@a)\n";
+    my @b = (-M _, -A _, -C _);
+    print "# -MAC=(@b)\n";
+    ok( (-M _) < 0, 'negative -M works');
+    ok( (-A _) < 0, 'negative -A works');
+    ok( (-C _) < 0, 'negative -C works');
+    ok(unlink($f), 'unlink tmp file');
+}
 
 {
     ok(open(F, ">", $tmpfile), 'can create temp file');
diff --git a/gnu/usr.bin/perl/t/op/subst.t b/gnu/usr.bin/perl/t/op/subst.t
index 6cf84b73990..06c04e83392 100644
--- a/gnu/usr.bin/perl/t/op/subst.t
+++ b/gnu/usr.bin/perl/t/op/subst.t
@@ -7,7 +7,7 @@ BEGIN {
 }
 
 require './test.pl';
-plan( tests => 136 );
+plan( tests => 139 );
 
 $x = 'foo';
 $_ = "x";
@@ -583,3 +583,11 @@ is($name, "cis", q[#22351 bug with 'e' substitution modifier]);
     is($want,$_,"RT#17542");
 }
 
+{
+    my @tests = ('ABC', "\xA3\xA4\xA5", "\x{410}\x{411}\x{412}");
+    foreach (@tests) {
+	my $id = ord $_;
+	s/./pos/ge;
+	is($_, "012", "RT#52104: $id");
+    }
+}
diff --git a/gnu/usr.bin/perl/t/op/substr.t b/gnu/usr.bin/perl/t/op/substr.t
index 40f87662e33..81c87be87bd 100644
--- a/gnu/usr.bin/perl/t/op/substr.t
+++ b/gnu/usr.bin/perl/t/op/substr.t
@@ -25,6 +25,12 @@ require './test.pl';
 
 plan(334);
 
+run_tests() unless caller;
+
+my $krunch = "a";
+
+sub run_tests {
+
 $FATAL_MSG = qr/^substr outside of string/;
 
 is(substr($a,0,3), 'abc');   # P=Q R S
@@ -643,11 +649,10 @@ is($x, "\x{100}\x{200}\xFFb");
 # [perl #24200] string corruption with lvalue sub
 
 {
-    my $foo = "a";
-    sub bar: lvalue { substr $foo, 0 }
+    sub bar: lvalue { substr $krunch, 0 }
     bar = "XXX";
     is(bar, 'XXX');
-    $foo = '123456789';
+    $krunch = '123456789';
     is(bar, '123456789');
 }
 
@@ -675,3 +680,5 @@ is($x, "\x{100}\x{200}\xFFb");
     is(substr($a,1,2), 'bc');
     is(substr($a,1,1), 'b');
 }
+
+}
diff --git a/gnu/usr.bin/perl/t/op/sysio.t b/gnu/usr.bin/perl/t/op/sysio.t
index 435be12efbf..dd63a1588c2 100644
--- a/gnu/usr.bin/perl/t/op/sysio.t
+++ b/gnu/usr.bin/perl/t/op/sysio.t
@@ -4,6 +4,7 @@ print "1..42\n";
 
 chdir('op') || chdir('t/op') || die "sysio.t: cannot look for myself: $!";
 @INC = '../../lib';
+require '../test.pl';
 
 open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!";
 
@@ -60,7 +61,7 @@ print "ok 9\n";
 print 'not ' unless ($a eq "#!.\0\0erl");
 print "ok 10\n";
 
-$outfile = 'sysio.out';
+$outfile = tempfile();
 
 open(O, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
 
diff --git a/gnu/usr.bin/perl/t/op/taint.t b/gnu/usr.bin/perl/t/op/taint.t
index b2688cfe607..0ac02a6306d 100644
--- a/gnu/usr.bin/perl/t/op/taint.t
+++ b/gnu/usr.bin/perl/t/op/taint.t
@@ -17,7 +17,7 @@ use Config;
 use File::Spec::Functions;
 
 BEGIN { require './test.pl'; }
-plan tests => 267;
+plan tests => 301;
 
 $| = 1;
 
@@ -285,7 +285,7 @@ my $TEST = catfile(curdir(), 'TEST');
 # How about command-line arguments? The problem is that we don't
 # always get some, so we'll run another process with some.
 SKIP: {
-    my $arg = catfile(curdir(), "arg$$");
+    my $arg = tempfile();
     open PROG, "> $arg" or die "Can't create $arg: $!";
     print PROG q{
 	eval { join('', @ARGV), kill 0 };
@@ -418,8 +418,7 @@ SKIP: {
     test !eval { require $foo }, 'require';
     test $@ =~ /^Insecure dependency/, $@;
 
-    my $filename = "./taintB$$";	# NB: $filename isn't tainted!
-    END { unlink $filename if defined $filename }
+    my $filename = tempfile();	# NB: $filename isn't tainted!
     $foo = $filename . $TAINT;
     unlink $filename;	# in any case
 
@@ -506,8 +505,7 @@ SKIP: {
 	my $foo = "x" x 979;
 	taint_these $foo;
 	local *FOO;
-	my $temp = "./taintC$$";
-	END { unlink $temp }
+	my $temp = tempfile();
 	test open(FOO, "> $temp"), "Couldn't open $temp for write: $!";
 
 	test !eval { ioctl FOO, $TAINT0, $foo }, 'ioctl';
@@ -1254,6 +1252,70 @@ foreach my $ord (78, 163, 256) {
     ok(!tainted($1), "\\S match with chr $ord");
 }
 
+{
+    # 59998
+    sub cr { my $x = crypt($_[0], $_[1]); $x }
+    sub co { my $x = ~$_[0]; $x }
+    my ($a, $b);
+    $a = cr('hello', 'foo' . $TAINT);
+    $b = cr('hello', 'foo');
+    ok(tainted($a),  "tainted crypt");
+    ok(!tainted($b), "untainted crypt");
+    $a = co('foo' . $TAINT);
+    $b = co('foo');
+    ok(tainted($a),  "tainted complement");
+    ok(!tainted($b), "untainted complement");
+}
+
+{
+    my @data = qw(bonk zam zlonk qunckkk);
+    # Clearly some sort of usenet bang-path
+    my $string = $TAINT . join "!", @data;
+
+    ok(tainted($string), "tainted data");
+
+    my @got = split /!|,/, $string;
+
+    # each @got would be useful here, but I want the test for earlier perls
+    for my $i (0 .. $#data) {
+	ok(tainted($got[$i]), "tainted result $i");
+	is($got[$i], $data[$i], "correct content $i");
+    }
+
+    ok(tainted($string), "still tainted data");
+
+    my @got = split /[!,]/, $string;
+
+    # each @got would be useful here, but I want the test for earlier perls
+    for my $i (0 .. $#data) {
+	ok(tainted($got[$i]), "tainted result $i");
+	is($got[$i], $data[$i], "correct content $i");
+    }
+
+    ok(tainted($string), "still tainted data");
+
+    my @got = split /!/, $string;
+
+    # each @got would be useful here, but I want the test for earlier perls
+    for my $i (0 .. $#data) {
+	ok(tainted($got[$i]), "tainted result $i");
+	is($got[$i], $data[$i], "correct content $i");
+    }
+}
+
+# Bug RT #52552 - broken by change at git commit id f337b08
+{
+    my $x = $TAINT. q{print "Hello world\n"};
+    my $y = pack "a*", $x;
+    ok(tainted($y), "pack a* preserves tainting");
+
+    my $z = pack "A*", q{print "Hello world\n"}.$TAINT;
+    ok(tainted($z), "pack A* preserves tainting");
+
+    my $zz = pack "a*a*", q{print "Hello world\n"}, $TAINT;
+    ok(tainted($zz), "pack a*a* preserves tainting");
+}
+
 # This may bomb out with the alarm signal so keep it last
 SKIP: {
     skip "No alarm()"  unless $Config{d_alarm};
diff --git a/gnu/usr.bin/perl/t/op/undef.t b/gnu/usr.bin/perl/t/op/undef.t
index 04cac52fd67..8bfecab9e4d 100644
--- a/gnu/usr.bin/perl/t/op/undef.t
+++ b/gnu/usr.bin/perl/t/op/undef.t
@@ -3,102 +3,116 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
-print "1..36\n";
+use strict;
 
-print defined($a) ? "not ok 1\n" : "ok 1\n";
+use vars qw(@ary %ary %hash);
+
+plan 37;
+
+ok !defined($a);
 
 $a = 1+1;
-print defined($a) ? "ok 2\n" : "not ok 2\n";
+ok defined($a);
 
 undef $a;
-print defined($a) ? "not ok 3\n" : "ok 3\n";
+ok !defined($a);
 
 $a = "hi";
-print defined($a) ? "ok 4\n" : "not ok 4\n";
+ok defined($a);
 
 $a = $b;
-print defined($a) ? "not ok 5\n" : "ok 5\n";
+ok !defined($a);
 
 @ary = ("1arg");
 $a = pop(@ary);
-print defined($a) ? "ok 6\n" : "not ok 6\n";
+ok defined($a);
 $a = pop(@ary);
-print defined($a) ? "not ok 7\n" : "ok 7\n";
+ok !defined($a);
 
 @ary = ("1arg");
 $a = shift(@ary);
-print defined($a) ? "ok 8\n" : "not ok 8\n";
+ok defined($a);
 $a = shift(@ary);
-print defined($a) ? "not ok 9\n" : "ok 9\n";
+ok !defined($a);
 
 $ary{'foo'} = 'hi';
-print defined($ary{'foo'}) ? "ok 10\n" : "not ok 10\n";
-print defined($ary{'bar'}) ? "not ok 11\n" : "ok 11\n";
+ok defined($ary{'foo'});
+ok !defined($ary{'bar'});
 undef $ary{'foo'};
-print defined($ary{'foo'}) ? "not ok 12\n" : "ok 12\n";
+ok !defined($ary{'foo'});
 
-print defined(@ary) ? "ok 13\n" : "not ok 13\n";
-print defined(%ary) ? "ok 14\n" : "not ok 14\n";
+ok defined(@ary);
+ok defined(%ary);
 undef @ary;
-print defined(@ary) ? "not ok 15\n" : "ok 15\n";
+ok !defined(@ary);
 undef %ary;
-print defined(%ary) ? "not ok 16\n" : "ok 16\n";
+ok !defined(%ary);
 @ary = (1);
-print defined @ary ? "ok 17\n" : "not ok 17\n";
+ok defined @ary;
 %ary = (1,1);
-print defined %ary ? "ok 18\n" : "not ok 18\n";
+ok defined %ary;
 
-sub foo { print "ok 19\n"; }
+sub foo { pass; 1 }
 
-&foo || print "not ok 19\n";
+&foo || fail;
 
-print defined &foo ? "ok 20\n" : "not ok 20\n";
+ok defined &foo;
 undef &foo;
-print defined(&foo) ? "not ok 21\n" : "ok 21\n";
+ok !defined(&foo);
 
 eval { undef $1 };
-print $@ =~ /^Modification of a read/ ? "ok 22\n" : "not ok 22\n";
+like $@, qr/^Modification of a read/;
 
 eval { $1 = undef };
-print $@ =~ /^Modification of a read/ ? "ok 23\n" : "not ok 23\n";
+like $@, qr/^Modification of a read/;
 
 {
     require Tie::Hash;
     tie my %foo, 'Tie::StdHash';
-    print defined %foo ? "ok 24\n" : "not ok 24\n";
+    ok defined %foo;
     %foo = ( a => 1 );
-    print defined %foo ? "ok 25\n" : "not ok 25\n";
+    ok defined %foo;
 }
 
 {
     require Tie::Array;
     tie my @foo, 'Tie::StdArray';
-    print defined @foo ? "ok 26\n" : "not ok 26\n";
+    ok defined @foo;
     @foo = ( a => 1 );
-    print defined @foo ? "ok 27\n" : "not ok 27\n";
+    ok defined @foo;
 }
 
 {
     # [perl #17753] segfault when undef'ing unquoted string constant
     eval 'undef tcp';
-    print $@ =~ /^Can't modify constant item/ ? "ok 28\n" : "not ok 28\n";
+    like $@, qr/^Can't modify constant item/;
 }
 
 # bugid 3096
 # undefing a hash may free objects with destructors that then try to
 # modify the hash. To them, the hash should appear empty.
 
-$test = 29;
 %hash = (
     key1 => bless({}, 'X'),
     key2 => bless({}, 'X'),
 );
 undef %hash;
 sub X::DESTROY {
-    print "not " if keys   %hash; print "ok $test\n"; $test++;
-    print "not " if values %hash; print "ok $test\n"; $test++;
-    print "not " if each   %hash; print "ok $test\n"; $test++;
-    print "not " if defined delete $hash{'key2'}; print "ok $test\n"; $test++;
+    is scalar keys %hash, 0;
+    is scalar values %hash, 0;
+    my @l = each %hash;
+    is @l, 0;
+    is delete $hash{'key2'}, undef;
 }
+
+# this will segfault if it fails
+
+sub PVBM () { 'foo' }
+{ my $dummy = index 'foo', PVBM }
+
+my $pvbm = PVBM;
+undef $pvbm;
+ok !defined $pvbm;
diff --git a/gnu/usr.bin/perl/t/op/universal.t b/gnu/usr.bin/perl/t/op/universal.t
index 9817d3fe680..f1c0323c67d 100644
--- a/gnu/usr.bin/perl/t/op/universal.t
+++ b/gnu/usr.bin/perl/t/op/universal.t
@@ -10,7 +10,7 @@ BEGIN {
     require "./test.pl";
 }
 
-plan tests => 111;
+plan tests => 116;
 
 $a = {};
 bless $a, "Bob";
@@ -228,3 +228,20 @@ package main;
 eval { UNIVERSAL::DOES([], "foo") };
 like( $@, qr/Can't call method "DOES" on unblessed reference/,
     'DOES call error message says DOES, not isa' );
+
+# Tests for can seem to be split between here and method.t
+# Add the verbatim perl code mentioned in the comments of
+# http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-05/msg01710.html
+# but never actually tested.
+is(UNIVERSAL->can("NoSuchPackage::foo"), undef);
+
+@splatt::ISA = 'zlopp';
+ok (splatt->isa('zlopp'));
+ok (!splatt->isa('plop'));
+
+# This should reset the ->isa lookup cache
+@splatt::ISA = 'plop';
+# And here is the new truth.
+ok (!splatt->isa('zlopp'));
+ok (splatt->isa('plop'));
+
diff --git a/gnu/usr.bin/perl/t/op/write.t b/gnu/usr.bin/perl/t/op/write.t
index 25101d109d0..f13ac5f247e 100644
--- a/gnu/usr.bin/perl/t/op/write.t
+++ b/gnu/usr.bin/perl/t/op/write.t
@@ -3,8 +3,11 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
+use strict;	# Amazed that this hackery can be made strict ...
+
 # read in a file
 sub cat {
     my $file = shift;
@@ -58,14 +61,21 @@ for my $tref ( @NumTests ){
 my $bas_tests = 20;
 
 # number of tests in section 3
-my $hmb_tests = 39;
+my $bug_tests = 4 + 3 * 3 * 5 * 2 * 3 + 2 + 1 + 1;
+
+# number of tests in section 4
+my $hmb_tests = 35;
 
-printf "1..%d\n", $bas_tests + $num_tests + $hmb_tests;
+my $tests = $bas_tests + $num_tests + $bug_tests + $hmb_tests;
+
+plan $tests;
 
 ############
 ## Section 1
 ############
 
+use vars qw($fox $multiline $foo $good);
+
 format OUT =
 the quick brown @<<
 $fox
@@ -94,7 +104,7 @@ $foo = 'when in the course of human events it becomes necessary';
 write(OUT);
 close OUT or die "Could not close: $!";
 
-$right =
+my $right =
 "the quick brown fox
 jumped
 forescore
@@ -105,10 +115,7 @@ the course
 of huma...
 now is the time for all good men to come to\n";
 
-if (cat('Op_write.tmp') eq $right)
-    { print "ok 1\n"; 1 while unlink 'Op_write.tmp'; }
-else
-    { print "not ok 1\n"; }
+is cat('Op_write.tmp'), $right and do { 1 while unlink 'Op_write.tmp'; };
 
 $fox = 'wolfishness';
 my $fox = 'foxiness';		# Test a lexical variable.
@@ -147,10 +154,7 @@ becomes
 necessary
 now is the time for all good men to come to\n";
 
-if (cat('Op_write.tmp') eq $right)
-    { print "ok 2\n"; 1 while unlink 'Op_write.tmp'; }
-else
-    { print "not ok 2\n"; }
+is cat('Op_write.tmp'), $right and do { 1 while unlink 'Op_write.tmp'; };
 
 eval <<'EOFORMAT';
 format OUT2 =
@@ -191,14 +195,11 @@ becomes
 necessary
 now is the time for all good men to come to\n";
 
-if (cat('Op_write.tmp') eq $right)
-    { print "ok 3\n"; 1 while unlink 'Op_write.tmp'; }
-else
-    { print "not ok 3\n"; }
+is cat('Op_write.tmp'), $right and do { 1 while unlink 'Op_write.tmp' };
 
 # formline tests
 
-$mustbe = <<EOT;
+$right = <<EOT;
 @ a
 @> ab
 @>> abc
@@ -212,7 +213,8 @@ $mustbe = <<EOT;
 @>>>>>>>>>>         abc
 EOT
 
-$was1 = $was2 = '';
+my $was1 = my $was2 = '';
+use vars '$format2';
 for (0..10) {           
   # lexical picture
   $^A = '';
@@ -225,8 +227,8 @@ for (0..10) {
   formline $format2, 'abc';
   $was2 .= "$format2 $^A\n";
 }
-print $was1 eq $mustbe ? "ok 4\n" : "not ok 4\n";
-print $was2 eq $mustbe ? "ok 5\n" : "not ok 5\n";
+is $was1, $right;
+is $was2, $right;
 
 $^A = '';
 
@@ -246,24 +248,24 @@ close OUT3 or die "Could not close: $!";
 $right =
 "fit\n";
 
-if (cat('Op_write.tmp') eq $right)
-    { print "ok 6\n"; 1 while unlink 'Op_write.tmp'; }
-else
-    { print "not ok 6\n"; }
+is cat('Op_write.tmp'), $right and do { 1 while unlink 'Op_write.tmp' };
+
 
 # test lexicals and globals
 {
+    my $test = curr_test();
     my $this = "ok";
-    our $that = 7;
+    our $that = $test;
     format LEX =
 @<<@|
 $this,$that
 .
     open(LEX, ">&STDOUT") or die;
     write LEX;
-    $that = 8;
+    $that = ++$test;
     write LEX;
     close LEX or die "Could not close: $!";
+    curr_test($test + 1);
 }
 # LEX_INTERPNORMAL test
 my %e = ( a => 1 );
@@ -274,13 +276,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") {
-    print "ok 9\n";
-    1 while unlink "Op_write.tmp";
-    }
-else {
-    print "not ok 9\n";
-    }
+is cat('Op_write.tmp'), "1\n" and do { 1 while unlink "Op_write.tmp" };
 
 eval <<'EOFORMAT';
 format OUT10 =
@@ -291,15 +287,13 @@ EOFORMAT
 
 open(OUT10, '>Op_write.tmp') || die "Can't create Op_write.tmp";
 
+use vars '$test1';
 $test1 = 12.95;
 write(OUT10);
 close OUT10 or die "Could not close: $!";
 
 $right = "   12.95 00012.95\n";
-if (cat('Op_write.tmp') eq $right)
-    { print "ok 10\n"; 1 while unlink 'Op_write.tmp'; }
-else
-    { print "not ok 10\n"; }
+is cat('Op_write.tmp'), $right and do { 1 while unlink 'Op_write.tmp' };
 
 eval <<'EOFORMAT';
 format OUT11 =
@@ -322,18 +316,16 @@ $right =
 "00012.95
 1 0#
 10 #\n";
-if (cat('Op_write.tmp') eq $right)
-    { print "ok 11\n"; 1 while unlink 'Op_write.tmp'; }
-else
-    { print "not ok 11\n"; }
+is cat('Op_write.tmp'), $right and do { 1 while unlink 'Op_write.tmp' };
 
 {
+    my $test = curr_test();
     my $el;
     format OUT12 =
 ok ^<<<<<<<<<<<<<<~~ # sv_chop() naze
 $el
 .
-    my %hash = (12 => 3);
+    my %hash = ($test => 3);
     open(OUT12, '>Op_write.tmp') || die "Can't create Op_write.tmp";
 
     for $el (keys %hash) {
@@ -341,15 +333,16 @@ $el
     }
     close OUT12 or die "Could not close: $!";
     print cat('Op_write.tmp');
-
+    curr_test($test + 1);
 }
 
 {
+    my $test = curr_test();
     # Bug report and testcase by Alexey Tourbin
     use Tie::Scalar;
     my $v;
     tie $v, 'Tie::StdScalar';
-    $v = 13;
+    $v = $test;
     format OUT13 =
 ok ^<<<<<<<<< ~~
 $v
@@ -358,6 +351,7 @@ $v
     write(OUT13);
     close OUT13 or die "Could not close: $!";
     print cat('Op_write.tmp');
+    curr_test($test + 1);
 }
 
 {   # test 14
@@ -365,9 +359,7 @@ $v
     # must fail since we have a trailing ; in the eval'ed string (WL)
     my @v = ('k');
     eval "format OUT14 = \n@\n\@v";
-    print +($@ && $@ =~ /Format not terminated/)
-      ? "ok 14\n" : "not ok 14 $@\n";
-
+    like $@, qr/Format not terminated/;
 }
 
 {   # test 15
@@ -383,7 +375,7 @@ $txt
     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";
+    is $res, "line 1\nline 2\n";
 }
 
 {   # test 16: multiple use of a variable in same line with ^<
@@ -398,7 +390,7 @@ $txt,             $txt
     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";
+    is $res, <<EOD;
 this_is_block_1   this_is_block_2
 this_is_block_3   this_is_block_4
 EOD
@@ -420,7 +412,7 @@ Here we go: @* That's all, folks!
     my $exp = <<EOD;
 Here we go: $txt That's all, folks!
 EOD
-    print $res eq $exp ? "ok 17\n" : "not ok 17\n";
+    is $res, $exp;
 }
 
 {   # test 18: @# and ~~ would cause runaway format, but we now
@@ -432,8 +424,7 @@ EOD
 .
     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";
+    like $@,  qr/Repeated format line will never terminate/;
     close OUT18 or die "Could not close: $!";
 }
 
@@ -448,7 +439,7 @@ EOD
     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";
+    is $res, <<EOD;
 gaga\0
 gaga\0
 EOD
@@ -477,7 +468,7 @@ $h{xkey}, $h{ykey}
     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";
+    is $res, $exp;
 }
 
 
@@ -486,68 +477,112 @@ $h{xkey}, $h{ykey}
 ## numeric formatting
 #####################
 
-my $nt = $bas_tests;
+curr_test($bas_tests + 1);
+
 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";
+	if (ref $expected) {
+	    like $writeres, $expected, $writefmt;
+	} else {
+	    is $writeres, $expected, $writefmt;
+	}	
     }
 }
 
 
 #####################################
 ## Section 3
-## Easiest to add new tests above here
-#######################################
-
-# scary format testing from H.Merijn Brand
-
-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')) {
-  foreach ($test..$tests) {
-      print "ok $_ # skipped: '|-' and '-|' not supported\n";
-  }
-  exit(0);
-}
-
-
-use strict;	# Amazed that this hackery can be made strict ...
+## Easiest to add new tests just here
+#####################################
 
 # DAPM. Exercise a couple of error codepaths
 
 {
     local $~ = '';
     eval { write };
-    print "not " unless $@ and $@ =~ /Not a format reference/;
-    print "ok $test - Not a format reference\n";
-    $test++;
+    like $@, qr/Not a format reference/, 'format reference';
 
     $~ = "NOSUCHFORMAT";
     eval { write };
-    print "not " unless $@ and $@ =~ /Undefined format/;
-    print "ok $test - Undefined format\n";
-    $test++;
+    like $@, qr/Undefined format/, 'no such format';
 }
 
-# Just a complete test for format, including top-, left- and bottom marging
-# and format detection through glob entries
+{
+  package Count;
+
+  sub TIESCALAR {
+    my $class = shift;
+    bless [shift, 0, 0], $class;
+  }
+
+  sub FETCH {
+    my $self = shift;
+    ++$self->[1];
+    $self->[0];
+  }
+
+  sub STORE {
+    my $self = shift;
+    ++$self->[2];
+    $self->[0] = shift;
+  }
+}
+
+{
+  my ($pound_utf8, $pm_utf8) = map { my $a = "$_\x{100}"; chop $a; $a}
+    my ($pound, $pm) = ("\xA3", "\xB1");
+
+  foreach my $first ('N', $pound, $pound_utf8) {
+    foreach my $base ('N', $pm, $pm_utf8) {
+      foreach my $second ($base, "$base\n", "$base\nMoo!", "$base\nMoo!\n",
+			  "$base\nMoo!\n",) {
+	foreach (['^*', qr/(.+)/], ['@*', qr/(.*?)$/s]) {
+	  my ($format, $re) = @$_;
+	  foreach my $class ('', 'Count') {
+	    my $name = "$first, $second $format $class";
+	    $name =~ s/\n/\\n/g;
+
+	    $first =~ /(.+)/ or die $first;
+	    my $expect = "1${1}2";
+	    $second =~ $re or die $second;
+	    $expect .= " 3${1}4";
+
+	    if ($class) {
+	      my $copy1 = $first;
+	      my $copy2;
+	      tie $copy2, $class, $second;
+	      is swrite("1^*2 3${format}4", $copy1, $copy2), $expect, $name;
+	      my $obj = tied $copy2;
+	      is $obj->[1], 1, 'value read exactly once';
+	    } else {
+	      my ($copy1, $copy2) = ($first, $second);
+	      is swrite("1^*2 3${format}4", $copy1, $copy2), $expect, $name;
+	    }
+	  }
+	}
+      }
+    }
+  }
+}
+
+{
+  # This will fail an assertion in 5.10.0 built with -DDEBUGGING (because
+  # pp_formline attempts to set SvCUR() on an SVt_RV). I suspect that it will
+  # be doing something similarly out of bounds on everything from 5.000
+  my $ref = [];
+  is swrite('>^*<', $ref), ">$ref<";
+  is swrite('>@*<', $ref), ">$ref<";
+}
 
 format EMPTY =
 .
 
+my $test = curr_test();
+
 format Comment =
 ok @<<<<<
 $test
@@ -559,19 +594,59 @@ $test
 open STDOUT_DUP, ">&STDOUT";
 my $oldfh = select STDOUT_DUP;
 $= = 10;
-{   local $~ = "Comment";
-    write;
-    $test++;
-    print $- == 9
-	? "ok $test # TODO\n" : "not ok $test # TODO \$- = $- instead of 9\n";
-    $test++;
-    print $^ eq "STDOUT_DUP_TOP"
-	? "ok $test\n" : "not ok $test\n# \$^ = $^ instead of 'STDOUT_DUP_TOP'\n";
-    $test++;
+{
+  local $~ = "Comment";
+  write;
+  curr_test($test + 1);
+  {
+    local $::TODO = '[ID 20020227.005] format bug with undefined _TOP';
+    is $-, 9;
+  }
+  is $^, "STDOUT_DUP_TOP";
 }
 select $oldfh;
 close STDOUT_DUP;
 
+*CmT =  *{$::{Comment}}{FORMAT};
+ok  defined *{$::{CmT}}{FORMAT}, "glob assign";
+
+fresh_perl_like(<<'EOP', qr/^Format STDOUT redefined at/, {stderr => 1}, '#64562 - Segmentation fault with redefined formats and warnings');
+#!./perl
+
+use strict;
+use warnings; # crashes!
+
+format =
+.
+
+write;
+
+format =
+.
+
+write;
+EOP
+
+#############################
+## Section 4
+## Add new tests *above* here
+#############################
+
+# scary format testing from H.Merijn Brand
+
+# Just a complete test for format, including top-, left- and bottom marging
+# and format detection through glob entries
+
+if ($^O eq 'VMS' || $^O eq 'MSWin32' || $^O eq 'dos' || $^O eq 'MacOS' ||
+    ($^O eq 'os2' and not eval '$OS2::can_fork')) {
+  $test = curr_test();
+ SKIP: {
+      skip "'|-' and '-|' not supported", $tests - $test + 1;
+  }
+  exit(0);
+}
+
+
 $^  = "STDOUT_TOP";
 $=  =  7;		# Page length
 $-  =  0;		# Lines left
@@ -591,33 +666,31 @@ select ((select (STDOUT), $| = 1)[0]); # flush STDOUT
 
 my $opened = open FROM_CHILD, "-|";
 unless (defined $opened) {
-    print "not ok $test - open gave $!\n"; exit 0;
+    fail "open gave $!";
+    exit 0;
 }
 
 if ($opened) {
     # in parent here
 
-    print "ok $test - open\n"; $test++;
+    pass 'open';
     my $s = " " x $lm;
     while (<FROM_CHILD>) {
 	unless (@data) {
-	    print "not ok $test - too much output\n";
+	    fail 'too much output';
 	    exit;
 	}
 	s/^/$s/;
 	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";
-	}
+	is $_, $exp;
     }
     close FROM_CHILD;
-    print + (@data?"not ":""), "ok ", $test++, " - too little output\n";
+    is "@data", "", "correct length of output";
     exit;
 }
 
 # in child here
+$::NO_ENDING = 1;
 
     select ((select (STDOUT), $| = 1)[0]);
 $tm = "\n" x $tm;
diff --git a/gnu/usr.bin/perl/t/pod/pod2usage.xr b/gnu/usr.bin/perl/t/pod/pod2usage.xr
index 853348fa510..b7c3da563e3 100644
--- a/gnu/usr.bin/perl/t/pod/pod2usage.xr
+++ b/gnu/usr.bin/perl/t/pod/pod2usage.xr
@@ -33,12 +33,12 @@ OPTIONS AND ARGUMENTS
             on MSWin32 and DOS).
 
     *file*  The pathname of a file containing pod documentation to be output
-            in usage mesage format (defaults to standard input).
+            in usage message format (defaults to standard input).
 
 DESCRIPTION
     pod2usage will read the given input file looking for pod documentation
     and will print the corresponding usage message. If no input file is
-    specified than standard input is read.
+    specified then standard input is read.
 
     pod2usage invokes the pod2usage() function in the Pod::Usage module.
     Please see the pod2usage() entry in the Pod::Usage manpage.
diff --git a/gnu/usr.bin/perl/utils/Makefile b/gnu/usr.bin/perl/utils/Makefile
index 2d741387888..4d56bea80cb 100644
--- a/gnu/usr.bin/perl/utils/Makefile
+++ b/gnu/usr.bin/perl/utils/Makefile
@@ -7,9 +7,9 @@ RUN =   # Used mainly cross-compilation setups.
 # Files to be built with variable substitution after miniperl is
 # available.  Dependencies handled manually below (for now).
 
-pl = c2ph.PL config_data.PL corelist.PL cpan.PL h2ph.PL h2xs.PL instmodsh.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL cpanp-run-perl.PL cpanp.PL cpan2dist.PL splain.PL dprofpp.PL libnetcfg.PL piconv.PL enc2xs.PL xsubpp.PL
-plextract = c2ph config_data corelist cpan h2ph h2xs instmodsh perlbug perldoc perlivp pl2pm prove cpanp-run-perl cpanp cpan2dist splain dprofpp libnetcfg piconv enc2xs xsubpp
-plextractexe = ./c2ph ./config_data ./corelist ./cpan ./h2ph ./h2xs ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./cpanp-run-perl ./cpanp ./cpan2dist ./splain ./dprofpp ./libnetcfg ./piconv ./enc2xs ./xsubpp
+pl = c2ph.PL config_data.PL corelist.PL cpan.PL h2ph.PL h2xs.PL instmodsh.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL ptar.PL ptardiff.PL cpanp-run-perl.PL cpanp.PL cpan2dist.PL shasum.PL splain.PL dprofpp.PL libnetcfg.PL piconv.PL enc2xs.PL xsubpp.PL
+plextract = c2ph config_data corelist cpan h2ph h2xs instmodsh perlbug perldoc perlivp pl2pm prove ptar ptardiff cpanp-run-perl cpanp cpan2dist shasum splain dprofpp libnetcfg piconv enc2xs xsubpp
+plextractexe = ./c2ph ./config_data ./corelist ./cpan ./h2ph ./h2xs ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./ptar ./ptardiff ./cpanp-run-perl ./cpanp ./cpan2dist ./shasum ./splain ./dprofpp ./libnetcfg ./piconv ./enc2xs ./xsubpp
 
 all: $(plextract) 
 
@@ -38,6 +38,10 @@ perlivp:	perlivp.PL ../config.sh
 
 prove:		prove.PL ../config.sh
 
+ptar:		ptar.PL ../config.sh
+
+ptardiff:	ptardiff.PL ../config.sh
+
 cpanp-run-perl:	cpanp-run-perl.PL ../config.sh
 
 cpanp:	cpanp.PL ../config.sh
@@ -46,6 +50,8 @@ cpan2dist:	cpan2dist.PL ../config.sh
 
 pl2pm:		pl2pm.PL ../config.sh
 
+shasum:		shasum.PL ../config.sh
+
 splain:		splain.PL ../config.sh ../lib/diagnostics.pm
 
 dprofpp:	dprofpp.PL ../config.sh
diff --git a/gnu/usr.bin/perl/utils/Makefile.SH b/gnu/usr.bin/perl/utils/Makefile.SH
index 5292a96276b..b5a2f12bb1f 100644
--- a/gnu/usr.bin/perl/utils/Makefile.SH
+++ b/gnu/usr.bin/perl/utils/Makefile.SH
@@ -39,9 +39,9 @@ cat >>Makefile <<'!NO!SUBS!'
 # Files to be built with variable substitution after miniperl is
 # available.  Dependencies handled manually below (for now).
 
-pl = c2ph.PL config_data.PL corelist.PL cpan.PL h2ph.PL h2xs.PL instmodsh.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL cpanp-run-perl.PL cpanp.PL cpan2dist.PL splain.PL dprofpp.PL libnetcfg.PL piconv.PL enc2xs.PL xsubpp.PL
-plextract = c2ph config_data corelist cpan h2ph h2xs instmodsh perlbug perldoc perlivp pl2pm prove cpanp-run-perl cpanp cpan2dist splain dprofpp libnetcfg piconv enc2xs xsubpp
-plextractexe = ./c2ph ./config_data ./corelist ./cpan ./h2ph ./h2xs ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./cpanp-run-perl ./cpanp ./cpan2dist ./splain ./dprofpp ./libnetcfg ./piconv ./enc2xs ./xsubpp
+pl = c2ph.PL config_data.PL corelist.PL cpan.PL h2ph.PL h2xs.PL instmodsh.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL ptar.PL ptardiff.PL cpanp-run-perl.PL cpanp.PL cpan2dist.PL shasum.PL splain.PL dprofpp.PL libnetcfg.PL piconv.PL enc2xs.PL xsubpp.PL
+plextract = c2ph config_data corelist cpan h2ph h2xs instmodsh perlbug perldoc perlivp pl2pm prove ptar ptardiff cpanp-run-perl cpanp cpan2dist shasum splain dprofpp libnetcfg piconv enc2xs xsubpp
+plextractexe = ./c2ph ./config_data ./corelist ./cpan ./h2ph ./h2xs ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./ptar ./ptardiff ./cpanp-run-perl ./cpanp ./cpan2dist ./shasum ./splain ./dprofpp ./libnetcfg ./piconv ./enc2xs ./xsubpp
 
 all: $(plextract) 
 
@@ -70,6 +70,10 @@ perlivp:	perlivp.PL ../config.sh
 
 prove:		prove.PL ../config.sh
 
+ptar:		ptar.PL ../config.sh
+
+ptardiff:	ptardiff.PL ../config.sh
+
 cpanp-run-perl:	cpanp-run-perl.PL ../config.sh
 
 cpanp:	cpanp.PL ../config.sh
@@ -78,6 +82,8 @@ cpan2dist:	cpan2dist.PL ../config.sh
 
 pl2pm:		pl2pm.PL ../config.sh
 
+shasum:		shasum.PL ../config.sh
+
 splain:		splain.PL ../config.sh ../lib/diagnostics.pm
 
 dprofpp:	dprofpp.PL ../config.sh
diff --git a/gnu/usr.bin/perl/utils/dprofpp.PL b/gnu/usr.bin/perl/utils/dprofpp.PL
index f9c487e0ff7..a24d1c15bd6 100644
--- a/gnu/usr.bin/perl/utils/dprofpp.PL
+++ b/gnu/usr.bin/perl/utils/dprofpp.PL
@@ -17,7 +17,7 @@ chdir(dirname($0));
 ($file = basename($0)) =~ s/\.PL$//i;
 $file .= '.COM' if ($^O eq 'VMS');
 
-my $dprof_pm = File::Spec->catfile(File::Spec->updir, 'ext', 'Devel', 'DProf', 'DProf.pm');
+my $dprof_pm = File::Spec->catfile(File::Spec->updir, 'ext', 'Devel-DProf', 'DProf.pm');
 my $VERSION = 0;
 open( PM, "<$dprof_pm" ) || die "Can't open $dprof_pm: $!";
 while(<PM>){
@@ -337,13 +337,13 @@ sub shortusage {
     print <<'EOF';
 dprofpp [options] [profile]
 
-    -A          Count autoloaded to *AUTOLOAD
+    -A          Count autoloaded to *AUTOLOAD.
     -a          Sort by alphabetic name of subroutines.
-    -d          Reverse sort
+    -d          Reverse sort.
     -E          Sub times are reported exclusive of child times. (default)
-    -f          Filter all calls mathcing the pattern.
+    -f          Filter all calls matching the pattern.
     -G          Group all calls matching the pattern together.
-    -g subr     Count only those who are SUBR or called from SUBR
+    -g subr     Count only subs who are SUBR or called from SUBR.
     -H          Display long manual page.
     -h          Display this short usage message.
     -I          Sub times are reported inclusive of child times.
@@ -351,12 +351,12 @@ dprofpp [options] [profile]
     -O cnt      Specifies maximum number of subroutines to display.
     -P          Used with -G to pull all other calls together.
     -p script   Specifies name of script to be profiled.
-    -Q          Used with -p to indicate the dprofpp should quit
+    -Q          Used with -p to indicate that dprofpp should quit
                 after profiling the script, without interpreting the data.
     -q          Do not print column headers.
-    -R          Count anonyms separately even if from the same package
+    -R          Count anonymous subs separately even if from the same package.
     -r          Use real elapsed time rather than user+system time.
-    -S          Create statistics for all the depths
+    -S          Create statistics for all the depths.
     -s          Use system time rather than user+system time.
     -T          Show call tree.
     -t          Show call tree, compressed.
diff --git a/gnu/usr.bin/perl/utils/h2ph.PL b/gnu/usr.bin/perl/utils/h2ph.PL
index c319def8547..cd4b5a0b2cc 100644
--- a/gnu/usr.bin/perl/utils/h2ph.PL
+++ b/gnu/usr.bin/perl/utils/h2ph.PL
@@ -85,7 +85,7 @@ sub reindent($) {
 }
 
 my ($t, $tab, %curargs, $new, $eval_index, $dir, $name, $args, $outfile);
-my ($incl, $incl_type, $next);
+my ($incl, $incl_type, $incl_quote, $next);
 while (defined (my $file = next_file())) {
     if (-l $file and -d $file) {
         link_if_possible($file) if ($opt_l);
@@ -123,7 +123,7 @@ while (defined (my $file = next_file())) {
 
     print OUT
         "require '_h2ph_pre.ph';\n\n",
-        "no warnings 'redefine';\n\n";
+        "no warnings qw(redefine misc);\n\n";
 
     while (defined (local $_ = next_line($file))) {
 	if (s/^\s*\#\s*//) {
@@ -186,9 +186,10 @@ while (defined (my $file = next_file())) {
                       print OUT $t,"unless(defined(\&$name)) {\n    sub $name () {\t",$new,";}\n}\n";
 		    }
 		}
-	    } elsif (/^(include|import|include_next)\s*[<\"](.*)[>\"]/) {
+	    } elsif (/^(include|import|include_next)\s*([<\"])(.*)[>\"]/) {
                 $incl_type = $1;
-                $incl = $2;
+                $incl_quote = $2;
+                $incl = $3;
                 if (($incl_type eq 'include_next') ||
                     ($opt_e && exists($bad_file{$incl}))) {
                     $incl =~ s/\.h$/.ph/;
@@ -221,6 +222,10 @@ while (defined (my $file = next_file())) {
 			   "warn(\$\@) if \$\@;\n");
                 } else {
                     $incl =~ s/\.h$/.ph/;
+                    # copy the prefix in the quote syntax (#include "x.h") case
+                    if ($incl !~ m|/| && $incl_quote eq q{"} && $file =~ m|^(.*)/|) {
+                        $incl = "$1/$incl";
+                    }
 		    print OUT $t,"require '$incl';\n";
                 }
 	    } elsif (/^ifdef\s+(\w+)/) {
@@ -553,7 +558,7 @@ sub next_line
                 $in =~ s/\?\?</{/g;                         # | ??<|  {|
                 $in =~ s/\?\?>/}/g;                         # | ??>|  }|
             }
-	    if ($in =~ s/^\#ifdef __LANGUAGE_PASCAL__//) {
+	    if ($in =~ /^\#ifdef __LANGUAGE_PASCAL__/) {
 		# Tru64 disassembler.h evilness: mixed C and Pascal.
 		while (<IN>) {
 		    last if /^\#endif/;
@@ -561,8 +566,8 @@ sub next_line
 		$in = "";
 		next READ;
 	    }
-	    # Skip inlined functions in headers
-	    if ($in =~ s/^(extern|static) (__inline__|inline) .*[^;]\s*$//) {
+	    if ($in =~ /^extern inline / && # Inlined assembler.
+		$^O eq 'linux' && $file =~ m!(?:^|/)asm/[^/]+\.h$!) {
 		while (<IN>) {
 		    last if /^}/;
 		}
@@ -724,8 +729,13 @@ sub queue_includes_from
                 $line .= <HEADER>;
             }
 
-            if ($line =~ /^#\s*include\s+<(.*?)>/) {
-                push(@ARGV, $1) unless $Is_converted{$1};
+            if ($line =~ /^#\s*include\s+([<"])(.*?)[>"]/) {
+                my ($delimiter, $new_file) = ($1, $2);
+                # copy the prefix in the quote syntax (#include "x.h") case
+                if ($delimiter eq q{"} && $file =~ m|^(.*)/|) {
+                    $new_file = "$1/$new_file";
+                }
+                push(@ARGV, $new_file) unless $Is_converted{$new_file};
             }
         }
     close HEADER;
@@ -733,7 +743,7 @@ sub queue_includes_from
 
 
 # Determine include directories; $Config{usrinc} should be enough for (all
-# non-GCC?) C compilers, but gcc uses an additional include directory.
+# non-GCC?) C compilers, but gcc uses additional include directories.
 sub inc_dirs
 {
     my $from_gcc    = `LC_ALL=C $Config{cc} -v 2>&1`;
@@ -745,7 +755,7 @@ sub inc_dirs
            $from_gcc = '';
        };
     };
-    length($from_gcc) ? ($from_gcc, $Config{usrinc}) : ($Config{usrinc});
+    length($from_gcc) ? ($from_gcc, $from_gcc . "-fixed", $Config{usrinc}) : ($Config{usrinc});
 }
 
 
@@ -799,6 +809,7 @@ sub build_preamble_if_necessary
 		    quotemeta($define{$_}), "\" } }\n\n";
 	    }
 	}
+	print PREAMBLE "\n1;\n";  # avoid 'did not return a true value' when empty
     close PREAMBLE               or die "Cannot close $preamble:  $!";
 }
 
diff --git a/gnu/usr.bin/perl/utils/h2xs.PL b/gnu/usr.bin/perl/utils/h2xs.PL
index c774d62adf1..125dbf4dc70 100644
--- a/gnu/usr.bin/perl/utils/h2xs.PL
+++ b/gnu/usr.bin/perl/utils/h2xs.PL
@@ -901,6 +901,7 @@ if( @path_h ){
 
         # Remove C and C++ comments
         $src =~ s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#$2#gs;
+        $src =~ s#//.*$##gm;
 
 	while ($src =~ /\benum\s*([\w_]*)\s*\{\s([^}]+)\}/gsc) {
 	    my ($enum_name, $enum_body) = ($1, $2);
@@ -912,7 +913,7 @@ if( @path_h ){
                 my ($key, $declared_val) = $item =~ /(\w+)\s*(?:=\s*(.*))?/;
                 $val = defined($declared_val) && length($declared_val) ? $declared_val : 1 + $val;
                 $seen_define{$key} = $val;
-                $const_names{$key}++;
+                $const_names{$key} = { name => $key, macro => 1 };
             }
         } # while (...)
       } # if (!defined $opt_e or $opt_e)
@@ -1076,7 +1077,14 @@ if( ! $opt_X ){  # use XS, unless it was disabled
     }
   }
 }
-my @const_names = sort keys %const_names;
+my (@const_specs, @const_names);
+
+for (sort(keys(%const_names))) {
+    my $v = $const_names{$_};
+    
+    push(@const_specs, ref($v) ? $v : $_);
+    push(@const_names, $_);
+}
 
 -d $modpmdir || mkpath([$modpmdir], 0, 0775);
 open(PM, ">$modpmname") || die "Can't create $ext$modpname/$modpmname: $!\n";
@@ -1465,7 +1473,7 @@ if( ! $opt_c ) {
                    XS_FILE =>      $xsfallback,
                    DEFAULT_TYPE => $opt_t,
                    NAME =>         $module,
-                   NAMES =>        \@const_names,
+                   NAMES =>        \@const_specs,
                  );
   print XS "#include \"$constscfname\"\n";
 }
@@ -1950,7 +1958,7 @@ if (!$opt_c) {
                            XS_FILE =>      $constsxsfname,
                            DEFAULT_TYPE => $opt_t,
                            NAME =>         $module,
-                           NAMES =>        \@const_names,
+                           NAMES =>        \@const_specs,
                  );
   print PL <<"END";
 if  (eval {require ExtUtils::Constant; 1}) {
diff --git a/gnu/usr.bin/perl/utils/perlbug.PL b/gnu/usr.bin/perl/utils/perlbug.PL
index c288095a202..8d02a8bfaeb 100644
--- a/gnu/usr.bin/perl/utils/perlbug.PL
+++ b/gnu/usr.bin/perl/utils/perlbug.PL
@@ -40,6 +40,9 @@ if (! defined($_)) {
 my @patches;
 while (<PATCH_LEVEL>) {
     last if /^\s*}/;
+    next if /^\s*#/;  # preprocessor stuff
+    next if /PERL_GIT_UNPUSHED_COMMITS/;    # XXX expand instead
+    next if /PERL_GIT_UNCOMMITTED_CHANGES/; # XXX expand instead
     chomp;
     s/^\s+,?\s*"?//;
     s/"?\s*,?$//;
@@ -81,26 +84,29 @@ my \@patches = (
 
 print OUT <<'!NO!SUBS!';
 
+use warnings;
+no warnings 'once'; # Eventually, the $::opt_ stuff should get cleaned up
+use strict;
 use Config;
 use File::Spec;		# keep perlbug Perl 5.005 compatible
 use Getopt::Std;
-use strict;
+use File::Basename 'basename';
 
 sub paraprint;
 
 BEGIN {
-    eval "use Mail::Send;";
+    eval { require Mail::Send;};
     $::HaveSend = ($@ eq "");
-    eval "use Mail::Util;";
+    eval { require Mail::Util; } ;
     $::HaveUtil = ($@ eq "");
     # use secure tempfiles wherever possible
-    eval "require File::Temp;";
+    eval { require File::Temp; };
     $::HaveTemp = ($@ eq "");
     eval { require Module::CoreList; };
     $::HaveCoreList = ($@ eq "");
 };
 
-my $Version = "1.36";
+my $Version = "1.39";
 
 # Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
 # Changed in 1.07 to see more sendmail execs, and added pipe output.
@@ -141,16 +147,31 @@ my $Version = "1.36";
 # Changed in 1.34 Added Message-Id RFOLEY 18-06-2002 
 # Changed in 1.35 Use File::Temp (patch from Solar Designer) NWCLARK 28-02-2004
 # Changed in 1.36 Initial Module::CoreList support Alexandr Ciornii 11-07-2007
-
-# TODO: - Allow the user to re-name the file on mail failure, and
-#       make sure failure (transmission-wise) of Mail::Send is
-#       accounted for.
+# Changed in 1.37 Killed some string evals, rewrote most prose JESSE 2008-06-08
+# Changed in 1.38 Actually enforce the CoreList check,
+#                 Record the module the user enters if they do so
+#                 Refactor prompts to use common code           JESSE 2008-06-08
+# Changed in 1.39 Trap mail sending failures (simple ones) so   JESSE 2008-06-08
+#                 users might be able to recover their bug reports
+#                 Refactor mail sending routines
+#                 Unify message building code
+#                 Unify message header building
+#                 Fix "module" prompting to not squish "category" prompting 
+#                 use warnings; (except 'once' warnings)
+#                 Unified report fingerprint/change detection code
+#                 Removed some labeled 'gotos'
+#TODO:
+#       make sure failure (transmission-wise) of Mail::Send is accounted for.
+#       (This may work now. Unsure of the original author's issue -JESSE 2008-06-08)
 #       - Test -b option
 
-my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename, $messageid, $domain,
-    $subject, $from, $verbose, $ed, $outfile, $Is_MacOS, $category, $severity,
-    $fh, $me, $Is_MSWin32, $Is_Linux, $Is_VMS, $msg, $body, $andcc, %REP, $ok,
-    $Is_OpenBSD);
+my( $file, $usefile, $cc, $address, $bugaddress, $testaddress, $thanksaddress,
+    $filename, $messageid, $domain, $subject, $from, $verbose, $ed, $outfile,
+    $fh, $me, $body, $andcc, %REP, $ok, $thanks, $progname,
+    $Is_MacOS, $Is_MSWin32, $Is_Linux, $Is_VMS, $Is_OpenBSD,
+    $report_about_module, $category, $severity,
+
+);
 
 my $perl_version = $^V ? sprintf("%vd", $^V) : $];
 
@@ -161,8 +182,8 @@ Init();
 if ($::opt_h) { Help(); exit; }
 if ($::opt_d) { Dump(*STDOUT); exit; }
 if (!-t STDIN && !($ok and not $::opt_n)) {
-    paraprint <<EOF;
-Please use perlbug interactively. If you want to
+    paraprint <<"EOF";
+Please use $progname interactively. If you want to
 include a file, you can use the -f switch.
 EOF
     die "\n";
@@ -171,7 +192,16 @@ EOF
 Query();
 Edit() unless $usefile || ($ok and not $::opt_n);
 NowWhat();
-Send();
+if ($outfile) {
+    save_message_to_disk($outfile);
+} else {
+    Send();
+    if ($thanks) {
+	print "\nThank you for taking the time to send a thank-you message!\n\n";
+    } else {
+	print "\nThank you for taking the time to file a bug report!\n\n";
+    }
+}
 
 exit;
 
@@ -181,37 +211,37 @@ sub ask_for_alternatives { # (category|severity)
 	'category' => {
 	    'default' => 'core',
 	    'ok'      => 'install',
+	    # Inevitably some of these will end up in RT whatever we do:
+	    'thanks'  => 'thanks',
 	    'opts'    => [qw(core docs install library utilities)], # patch, notabug
 	},
 	'severity' => {
 	    'default' => 'low',
 	    'ok'      => 'none',
+	    'thanks'  => 'none',
 	    'opts'    => [qw(critical high medium low wishlist none)], # zero
 	},
     );
-    die "Invalid alternative($name) requested\n" unless grep(/^$name$/, keys %alts);
+    die "Invalid alternative ($name) requested\n" unless grep(/^$name$/, keys %alts);
     my $alt = "";
-    if ($ok) {
-	$alt = $alts{$name}{'ok'};
+    my $what = $ok || $thanks;
+    if ($what) {
+	$alt = $alts{$name}{$what};
     } else {
  	my @alts = @{$alts{$name}{'opts'}};
+    print "\n\n";
 	paraprint <<EOF;
-Please pick a \u$name from the following:
+Please pick a $name from the following list:
 
     @alts
-
 EOF
 	my $err = 0;
 	do {
 	    if ($err++ > 5) {
 		die "Invalid $name: aborting.\n";
 	    }
-	    print "Please enter a \u$name [$alts{$name}{'default'}]: ";
-	    $alt = <>;
-	    chomp $alt;
-	    if ($alt =~ /^\s*$/) {
-		$alt = $alts{$name}{'default'};
-	    }
+        $alt = _prompt('', "\u$name", $alts{$name}{'default'});
+		$alt ||= $alts{$name}{'default'};
 	} while !((($alt) = grep(/^$alt/i, @alts)));
     }
     lc $alt;
@@ -227,10 +257,10 @@ sub Init {
     $Is_MacOS = $^O eq 'MacOS';
 
     @ARGV = split m/\s+/,
-        MacPerl::Ask('Provide command-line args here (-h for help):')
+        MacPerl::Ask('Provide command line args here (-h for help):')
         if $Is_MacOS && $MacPerl::Version =~ /App/;
 
-    if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:")) { Help(); exit; };
+    if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T")) { Help(); exit; };
 
     # This comment is needed to notify metaconfig that we are
     # using the $perladmin, $cf_by, and $cf_time definitions.
@@ -238,13 +268,28 @@ sub Init {
     # -------- Configuration ---------
 
     # perlbug address
-    $perlbug = 'perlbug@perl.org';
+    $bugaddress = 'perlbug@perl.org';
 
     # Test address
     $testaddress = 'perlbug-test@perl.org';
 
+    # Thanks address
+    $thanksaddress = 'perl-thanks@perl.org';
+
+    if (basename ($0) =~ /^perlthanks/i) {
+	# invoked as perlthanks
+	$::opt_T = 1;
+	$::opt_C = 1; # don't send a copy to the local admin
+    }
+
+    if ($::opt_T) {
+	$thanks = 'thanks';
+    }
+    
+    $progname = $thanks ? 'perlthanks' : 'perlbug';
     # Target address
-    $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
+    $address = $::opt_a || ($::opt_t ? $testaddress
+			    : $thanks ? $thanksaddress : $bugaddress);
 
     # Users address, used in message and in Reply-To header
     $from = $::opt_r || "";
@@ -285,7 +330,7 @@ sub Init {
     }
 
     # OK - send "OK" report for build on this system
-    $ok = 0;
+    $ok = '';
     if ($::opt_o) {
 	if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
 	    my $age = time - $patchlevel_date;
@@ -310,7 +355,7 @@ EOF
 	    $subject = ($::opt_n ? 'Not ' : '')
 		    . "OK: perl $perl_version ${patch_tags}on"
 		    ." $::Config{'archname'} $::Config{'osvers'} $subject";
-	    $ok = 1;
+	    $ok = 'ok';
 	} else {
 	    Help();
 	    exit();
@@ -354,41 +399,58 @@ EOF
 sub Query {
     # Explain what perlbug is
     unless ($ok) {
-	paraprint <<EOF;
-This program provides an easy way to create a message reporting a bug
-in perl, and e-mail it to $address.  It is *NOT* intended for
-sending test messages or simply verifying that perl works, *NOR* is it
-intended for reporting bugs in third-party perl modules.  It is *ONLY*
-a means of reporting verifiable problems with the core perl distribution,
-and any solutions to such problems, to the people who maintain perl.
-
-If you're just looking for help with perl, try posting to the Usenet
-newsgroup comp.lang.perl.misc.  If you're looking for help with using
-perl with CGI, try posting to comp.infosystems.www.programming.cgi.
+	if ($thanks) {
+	    paraprint <<'EOF';
+This program provides an easy way to send a thank-you message back to the
+authors and maintainers of perl.
+
+If you wish to submit a bug report, please run it without the -T flag
+(or run the program perlbug rather than perlthanks)
 EOF
+	} else {
+	    paraprint <<"EOF";
+This program provides an easy way to create a message reporting a
+bug in the core perl distribution (along with tests or patches)
+to the volunteers who maintain perl at $address.  To send a thank-you
+note to $thanksaddress instead of a bug report, please run 'perlthanks'.
+
+Please do not use $0 to send test messages, test whether perl
+works, or to report bugs in perl modules from CPAN.
+
+For help using perl, try posting to the Usenet newsgroup 
+comp.lang.perl.misc.
+EOF
+	}
     }
 
     # Prompt for subject of message, if needed
     
-    if (TrivialSubject($subject)) {
+    if ($subject && TrivialSubject($subject)) {
 	$subject = '';
     }
 
     unless ($subject) {
-	paraprint <<EOF;
-First of all, please provide a subject for the
-message. It should be a concise description of
-the bug or problem. "perl bug" or "perl problem"
-is not a concise description.
+	    print 
+"First of all, please provide a subject for the message.\n";
+	if ( not $thanks)  {
+	    paraprint <<EOF;
+This should be a concise description of your bug or problem
+which will help the volunteers working to improve perl to categorize
+and resolve the issue.  Be as specific and descriptive as
+you can. A subject like "perl bug" or "perl problem" will make it
+much less likely that your issue gets the attention it deserves.
 EOF
+	}
 
 	my $err = 0;
 	do {
-	    print "Subject: ";
-	    $subject = <>;
-	    chomp $subject;
+        $subject = _prompt('','Subject');
 	    if ($err++ == 5) {
-		die "Aborting.\n";
+		if ($thanks) {
+		    $subject = 'Thanks for Perl';
+		} else {
+		    die "Aborting.\n";
+		}
 	    }
 	} while (TrivialSubject($subject));
     }
@@ -420,14 +482,17 @@ EOF
 	if ($guess) {
 	    unless ($ok) {
 		paraprint <<EOF;
-Your e-mail address will be useful if you need to be contacted. If the
-default shown is not your full internet e-mail address, please correct it.
+Perl's developers may need your email address to contact you for
+further information about your issue or to inform you when it is
+resolved.  If the default shown is not your email address, please
+correct it.
 EOF
 	    }
 	} else {
 	    paraprint <<EOF;
-So that you may be contacted if necessary, please enter
-your full internet e-mail address here.
+Please enter your full internet email address so that Perl's
+developers can contact you with questions about your issue or to
+inform you that it has been resolved.
 EOF
 	}
 
@@ -436,9 +501,7 @@ EOF
 	    $from = $guess;
 	} else {
 	    # verify it
-	    print "Your address [$guess]: ";
-	    $from = <>;
-	    chomp $from;
+        $from = _prompt('','Your address',$guess);
 	    $from = $guess if $from eq '';
 	}
     }
@@ -450,15 +513,12 @@ EOF
 
     # Prompt for administrator address, unless an override was given
     if( !$::opt_C and !$::opt_c ) {
-	paraprint <<EOF;
-A copy of this report can be sent to your local
-perl administrator. If the address is wrong, please
-correct it, or enter 'none' or 'yourself' to not send
-a copy.
+	my $description =  <<EOF;
+$0 can send a copy of this report to your local perl
+administrator.  If the address below is wrong, please correct it,
+or enter 'none' or 'yourself' to not send a copy.
 EOF
-	print "Local perl administrator [$cc]: ";
-	my $entry = scalar <>;
-	chomp $entry;
+	my $entry = _prompt($description, "Local perl administrator", $cc);
 
 	if ($entry ne "") {
 	    $cc = $entry;
@@ -467,37 +527,59 @@ EOF
     }
 
     $cc = '' if $cc =~ /^(none|yourself|me|myself|ourselves)$/i;
-    $andcc = " and $cc" if $cc;
+    if ($cc) { 
+        $andcc = " and $cc" 
+    } else {
+        $andcc = ''
+    }
 
     # Prompt for editor, if no override is given
 editor:
     unless ($::opt_e || $::opt_f || $::opt_b) {
-	paraprint <<EOF;
-Now you need to supply the bug report. Try to make
-the report concise but descriptive. Include any
-relevant detail. If you are reporting something
-that does not work as you think it should, please
-try to include example of both the actual
-result, and what you expected.
-
-Some information about your local
-perl configuration will automatically be included
-at the end of the report. If you are using any
-unusual version of perl, please try and confirm
-exactly which versions are relevant.
-
-You will probably want to use an editor to enter
-the report. If "$ed" is the editor you want
-to use, then just press Enter, otherwise type in
-the name of the editor you would like to use.
-
-If you would like to use a prepared file, type
-"file", and you will be asked for the filename.
+
+    my $description;
+
+	chomp (my $common_end = <<"EOF");
+You will probably want to use a text editor to enter the body of
+your report. If "$ed" is the editor you want to use, then just press
+Enter, otherwise type in the name of the editor you would like to
+use.
+
+If you have already composed the body of your report, you may enter
+"file", and $0 will prompt you to enter the name of the file
+containing your report.
+EOF
+
+	if ($thanks) {
+	    $description = <<"EOF";
+It's now time to compose your thank-you message.
+
+Some information about your local perl configuration will automatically
+be included at the end of your message, because we're curious about
+the different ways that people build and use perl. If you'd rather
+not share this information, you're welcome to delete it.
+
+$common_end
 EOF
-	print "Editor [$ed]: ";
-	my $entry =scalar <>;
-	chomp $entry;
+	} else {
+	    $description =  <<"EOF";
+It's now time to compose your bug report. Try to make the report
+concise but descriptive. Please include any detail which you think
+might be relevant or might help the volunteers working to improve
+perl. If you are reporting something that does not work as you think
+it should, please try to include examples of the actual result and of
+what you expected.
+
+Some information about your local perl configuration will automatically
+be included at the end of your report. If you are using an unusual
+version of perl, it would be useful if you could confirm that you
+can replicate the problem on a standard build of perl as well.
+
+$common_end
+EOF
+	}
 
+    my $entry = _prompt($description, "Editor", $ed);
 	$usefile = 0;
 	if ($entry eq "file") {
 	    $usefile = 1;
@@ -505,27 +587,32 @@ EOF
 	    $ed = $entry;
 	}
     }
-    my $report_about_module = '';
-    if ($::HaveCoreList) {
-	paraprint <<EOF;
-Is your report about a Perl module? If yes, enter its name. If not, skip.
+    if ($::HaveCoreList && !$ok && !$thanks) {
+	my $description =  <<EOF;
+If your bug is about a Perl module rather than a core language
+feature, please enter its name here. If it's not, just hit Enter
+to skip this question.
 EOF
-	print "Module []: ";
-	my $entry = scalar <>;
-	$entry =~ s/^\s+//s;
-	$entry =~ s/\s+$//s;
-	if ($entry ne q{}) {
-	    $category ||= 'library';
-	    $report_about_module = $entry;
+
+    my $entry = '';
+	while ($entry eq '') {
+        $entry = _prompt($description, 'Module');
 	    my $first_release = Module::CoreList->first_release($entry);
-	    unless ($first_release) {
+	    if ($entry and not $first_release) {
 		paraprint <<EOF;
-Module $entry is not a core module. Please check that
-you entered its name correctly. If it is correct,
-abort this program, try searching for $entry on
-search.cpan.org, and report it there.
+$entry is not a "core" Perl module. Please check that you entered
+its name correctly. If it is correct, quit this program, try searching
+for $entry on http://rt.cpan.org, and report your issue there.
 EOF
-	    }
+
+            $entry = '';
+        } elsif ($entry) {
+	        $category ||= 'library';
+	        $report_about_module = $entry;
+            last;
+        } else {
+            last;
+        }
 	}
     }
 
@@ -541,25 +628,26 @@ EOF
     # Prompt for file to read report from, if needed
     if ($usefile and !$file) {
 filename:
-	paraprint <<EOF;
+	my $description = <<EOF;
 What is the name of the file that contains your report?
 EOF
-	print "Filename: ";
-	my $entry = scalar <>;
-	chomp $entry;
+	my $entry = _prompt($description, "Filename");
 
 	if ($entry eq "") {
 	    paraprint <<EOF;
-No filename? I'll let you go back and choose an editor again.
+It seems you didn't enter a filename. Please choose to use a text
+editor or enter a filename.
 EOF
 	    goto editor;
 	}
 
 	unless (-f $entry and -r $entry) {
 	    paraprint <<EOF;
-I'm sorry, but I can't read from `$entry'. Maybe you mistyped the name of
-the file? If you don't want to send a file, just enter a blank line and you
-can get back to the editor selection.
+'$entry' doesn't seem to be a readable file.  You may have mistyped
+its name or may not have permission to read it.
+
+If you don't want to use a file as the content of your report, just
+hit Enter and you'll be able to select a text editor instead.
 EOF
 	    goto filename;
 	}
@@ -567,8 +655,9 @@ EOF
     }
 
     # Generate report
-    open(REP,">$filename") or die "Unable to create report file `$filename': $!\n";
-    my $reptype = !$ok ? "bug" : $::opt_n ? "build failure" : "success";
+    open(REP,">$filename") or die "Unable to create report file '$filename': $!\n";
+    my $reptype = !$ok ? ($thanks ? 'thank-you' : 'bug')
+	: $::opt_n ? "build failure" : "success";
 
     print REP <<EOF;
 This is a $reptype report for perl from $from,
@@ -580,35 +669,42 @@ EOF
 	print REP $body;
     } elsif ($usefile) {
 	open(F, "<$file")
-		or die "Unable to read report file from `$file': $!\n";
+		or die "Unable to read report file from '$file': $!\n";
 	while (<F>) {
 	    print REP $_
 	}
-	close(F) or die "Error closing `$file': $!";
+	close(F) or die "Error closing '$file': $!";
     } else {
-	print REP <<EOF;
+	if ($thanks) {
+	    print REP <<'EOF';
+
+-----------------------------------------------------------------
+[Please enter your thank-you message here]
+
+
+
+[You're welcome to delete anything below this line]
+-----------------------------------------------------------------
+EOF
+	} else {
+	    print REP <<'EOF';
 
 -----------------------------------------------------------------
-[Please enter your report here]
+[Please describe your issue here]
 
 
 
 [Please do not change anything below this line]
 -----------------------------------------------------------------
 EOF
+	}
     }
     Dump(*REP);
     close(REP) or die "Error closing report file: $!";
 
-    # read in the report template once so that
-    # we can track whether the user does any editing.
-    # yes, *all* whitespace is ignored.
-    open(REP, "<$filename") or die "Unable to open report file `$filename': $!\n";
-    while (<REP>) {
-	s/\s+//g;
-	$REP{$_}++;
-    }
-    close(REP) or die "Error closing report file `$filename': $!";
+    # Set up an initial report fingerprint so we can compare it later
+    _fingerprint_lines_in_report();
+
 } # sub Query
 
 sub Dump {
@@ -620,6 +716,12 @@ Flags:
     category=$category
     severity=$severity
 EFF
+
+    if ($report_about_module ) { 
+        print OUT <<EFF;
+    module=$report_about_module
+EFF
+    }
     if ($::opt_A) {
 	print OUT <<EFF;
     ack=no
@@ -685,78 +787,71 @@ EOF
 sub Edit {
     # Edit the report
     if ($usefile || $body) {
-	paraprint <<EOF;
-Please make sure that the name of the editor you want to use is correct.
-EOF
-	print "Editor [$ed]: ";
-	my $entry =scalar <>;
-	chomp $entry;
+	my $description = "Please make sure that the name of the editor you want to use is correct.";
+	my $entry = _prompt($description, 'Editor', $ed);
 	$ed = $entry unless $entry eq '';
     }
 
-tryagain:
-    my $sts;
-    $sts = system("$ed $filename") unless $Is_MacOS;
-    if ($Is_MacOS) {
-        require ExtUtils::MakeMaker;
-        ExtUtils::MM_MacOS::launch_file($filename);
-        paraprint <<EOF;
-Press Enter when done.
+    _edit_file($ed);
+}
+
+sub _edit_file {
+    my $editor = shift;
+
+    my $report_written = 0;
+
+    while ( !$report_written ) {
+        if ($Is_MacOS) {
+            require ExtUtils::MakeMaker;
+            ExtUtils::MM_MacOS::launch_file($filename);
+            _prompt('', "Press Enter when done." );
+        } else {    # we're not on oldschool mac os
+            my $exit_status = system("$editor $filename");
+            if ($exit_status) {
+                my $desc = <<EOF;
+The editor you chose ('$editor') could not be run!
+
+If you mistyped its name, please enter it now, otherwise just press Enter.
 EOF
-        scalar <>;
-    }
-    if ($sts) {
-	paraprint <<EOF;
-The editor you chose (`$ed') could apparently not be run!
-Did you mistype the name of your editor? If so, please
-correct it here, otherwise just press Enter.
+                my $entry = _prompt( $desc, 'Editor', $editor );
+                if ( $entry ne "" ) {
+                    $editor = $entry;
+                    next;
+                } else {
+                    paraprint <<EOF;
+You may want to save your report to a file, so you can edit and
+mail it later.
 EOF
-	print "Editor [$ed]: ";
-	my $entry =scalar <>;
-	chomp $entry;
+                    return;
+                }
+            }
+        }
+        return if ( $ok and not $::opt_n ) || $body;
 
-	if ($entry ne "") {
-	    $ed = $entry;
-	    goto tryagain;
-	} else {
-	    paraprint <<EOF;
-You may want to save your report to a file, so you can edit and mail it
-yourself.
+        # Check that we have a report that has some, eh, report in it.
+
+        unless ( _fingerprint_lines_in_report() ) {
+            my $description = <<EOF;
+It looks like you didn't enter a report. You may [r]etry your edit
+or [c]ancel this report.
 EOF
-	}
-    }
+            my $action = _prompt( $description, "Action (Retry/Cancel) " );
+            if ( $action =~ /^[re]/i ) {    # <R>etry <E>dit
+                next;
+            } elsif ( $action =~ /^[cq]/i ) {    # <C>ancel, <Q>uit
+                Cancel();                        # cancel exits
+            }
+        }
+        # Ok. the user did what they needed to;
+        return;
 
-    return if ($ok and not $::opt_n) || $body;
-    # Check that we have a report that has some, eh, report in it.
-    my $unseen = 0;
-
-    open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
-    # a strange way to check whether any significant editing
-    # have been done: check whether any new non-empty lines
-    # have been added. Yes, the below code ignores *any* space
-    # in *any* line.
-    while (<REP>) {
-	s/\s+//g;
-	$unseen++ if $_ ne '' and not exists $REP{$_};
     }
+}
 
-    while ($unseen == 0) {
-	paraprint <<EOF;
-I am sorry but it looks like you did not report anything.
-EOF
-	print "Action (Retry Edit/Cancel) ";
-	my ($action) = scalar(<>);
-	if ($action =~ /^[re]/i) { # <R>etry <E>dit
-	    goto tryagain;
-	} elsif ($action =~ /^[cq]/i) { # <C>ancel, <Q>uit
-	    Cancel();
-	}
-    }
-} # sub Edit
 
 sub Cancel {
     1 while unlink($filename);  # remove all versions under VMS
-    print "\nCancelling.\n";
+    print "\nQuitting without sending your message.\n";
     exit(0);
 }
 
@@ -764,53 +859,33 @@ sub NowWhat {
     # Report is done, prompt for further action
     if( !$::opt_S ) {
 	while(1) {
-	    paraprint <<EOF;
-Now that you have completed your report, would you like to send
-the message to $address$andcc, display the message on
-the screen, re-edit it, display/change the subject,
-or cancel without sending anything?
-You may also save the message as a file to mail at another time.
+	    my $menu = <<EOF;
+
+
+You have finished composing your message. At this point, you have 
+a few options. You can:
+
+    * [Se]end the message to $address$andcc, 
+    * [D]isplay the message on the screen,
+    * [R]e-edit the message
+    * Display or change the message's [su]bject
+    * Save the message to a [f]ile to mail at another time
+    * [Q]uit without sending a message
+
 EOF
       retry:
-	    print "Action (Send/Display/Edit/Subject/Save to File): ";
-	    my $action = scalar <>;
-	    chomp $action;
-
+        print $menu;
+	    my $action =  _prompt('', "Action (Send/Display/Edit/Subject/Save to File)");;
+        print "\n";
 	    if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
-		my $file_save = $outfile || "perlbug.rep";
-		print "\n\nName of file to save message in [$file_save]: ";
-		my $file = scalar <>;
-		chomp $file;
-		$file = $file_save if $file eq "";
-
-		unless (open(FILE, ">$file")) {
-		    print "\nError opening $file: $!\n\n";
-		    goto retry;
-		}
-		open(REP, "<$filename") or die "Couldn't open file `$filename': $!\n";
-		print FILE "To: $address\nSubject: $subject\n";
-		print FILE "Cc: $cc\n" if $cc;
-		print FILE "Reply-To: $from\n" if $from;
-		print FILE "Message-Id: $messageid\n" if $messageid;
-		print FILE "\n";
-		while (<REP>) { print FILE }
-		close(REP) or die "Error closing report file `$filename': $!";
-		close(FILE) or die "Error closing $file: $!";
-
-		print "\nMessage saved in `$file'.\n";
-		exit;
+            if ( SaveMessage() ) { exit }
 	    } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
 		# Display the message
-		open(REP, "<$filename") or die "Couldn't open file `$filename': $!\n";
+		open(REP, "<$filename") or die "Couldn't open file '$filename': $!\n";
 		while (<REP>) { print $_ }
-		close(REP) or die "Error closing report file `$filename': $!";
+		close(REP) or die "Error closing report file '$filename': $!";
 	    } elsif ($action =~ /^su/i) { # <Su>bject
-		print "Subject: $subject\n";
-		print "If the above subject is fine, just press Enter.\n";
-		print "If not, type in the new subject.\n";
-		print "Subject: ";
-		my $reply = scalar <STDIN>;
-		chomp $reply;
+		my $reply = _prompt( "Subject: $subject", "If the above subject is fine, press Enter. Otherwise, type a replacement now\nSubject");
 		if ($reply ne '') {
 		    unless (TrivialSubject($reply)) {
 			$subject = $reply;
@@ -819,17 +894,12 @@ EOF
 		}
 	    } elsif ($action =~ /^se/i) { # <S>end
 		# Send the message
-		print "Are you certain you want to send this message?\n"
-		    . 'Please type "yes" if you are: ';
-		my $reply = scalar <STDIN>;
-		chomp $reply;
-		if ($reply eq "yes") {
+		my $reply =  _prompt( "Are you certain you want to send this message?", 'Please type "yes" if you are','no');
+		if ($reply =~ /^yes$/) {
 		    last;
 		} else {
 		    paraprint <<EOF;
-That wasn't a clear "yes", so I won't send your message. If you are sure
-your message should be sent, type in "yes" (without the quotes) at the
-confirmation prompt.
+You didn't type "yes", so your message has not yet been sent.
 EOF
 		}
 	    } elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
@@ -839,7 +909,7 @@ EOF
 		Cancel();
 	    } elsif ($action =~ /^s/i) {
 		paraprint <<EOF;
-I'm sorry, but I didn't understand that. Please type "send" or "save".
+The command you entered was ambiguous. Please type "send", "save" or "subject".
 EOF
 	    }
 	}
@@ -852,110 +922,69 @@ sub TrivialSubject {
 	/^(y(es)?|no?|help|perl( (bug|problem))?|bug|problem)$/i ||
 	length($subject) < 4 ||
 	$subject !~ /\s/) {
-	print "\nThat doesn't look like a good subject.  Please be more verbose.\n\n";
+	print "\nThe subject you entered wasn't very descriptive. Please try again.\n\n";
         return 1;
     } else {
 	return 0;
     }
 }
 
+sub SaveMessage {
+    my $file_save = $outfile || "$progname.rep";
+    my $file = _prompt( '', "Name of file to save message in", $file_save );
+    save_message_to_disk($file) || return undef;
+    print "\n";
+    paraprint <<EOF;
+A copy of your message has been saved in '$file' for you to
+send to '$address' with your normal mail client.
+EOF
+}
+
 sub Send {
+
     # Message has been accepted for transmission -- Send the message
-    if ($outfile) {
-	open SENDMAIL, ">$outfile" or die "Couldn't open '$outfile': $!\n";
-	goto sendout;
-    }
 
-    # on linux certain mail implementations won't accept the subject
+    # on linux certain "mail" implementations won't accept the subject
     # as "~s subject" and thus the Subject header will be corrupted
     # so don't use Mail::Send to be safe
-    if ($::HaveSend && !$Is_Linux && !$Is_OpenBSD) {
-	$msg = new Mail::Send Subject => $subject, To => $address;
-	$msg->cc($cc) if $cc;
-	$msg->add("Reply-To",$from) if $from;
-
-	$fh = $msg->open;
-	open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
-	while (<REP>) { print $fh $_ }
-	close(REP) or die "Error closing $filename: $!";
-	$fh->close;
-
-	print "\nMessage sent.\n";
-    } elsif ($Is_VMS) {
-	if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
-	     ($cc      =~ /@/ and $cc      !~ /^\w+%"/) ) {
-	    my $prefix;
-	    foreach (qw[ IN MX SMTP UCX PONY WINS ], '') {
-		$prefix = "$_%", last if $ENV{"MAIL\$PROTOCOL_$_"};
-	    }
-	    $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
-	    $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
-	}
-	$subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
-	my $sts = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
-	if ($sts) {
-	    die <<EOF;
-Can't spawn off mail
-	(leaving bug report in $filename): $sts
-EOF
-	}
-    } else {
-	my $sendmail = "";
-	for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
-	    $sendmail = $_, last if -e $_;
-	}
-	if ($^O eq 'os2' and $sendmail eq "") {
-	    my $path = $ENV{PATH};
-	    $path =~ s:\\:/: ;
-	    my @path = split /$Config{'path_sep'}/, $path;
-	    for (@path) {
-		$sendmail = "$_/sendmail", last if -e "$_/sendmail";
-		$sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
-	    }
-	}
+    eval {
+        if ( $::HaveSend && !$Is_Linux && !$Is_OpenBSD ) {
+            _send_message_mailsend();
+        } elsif ($Is_VMS) {
+            _send_message_vms();
+        } else {
+            _send_message_sendmail();
+        }
+    };
 
-	paraprint(<<"EOF"), die "\n" if $sendmail eq "";
-I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
-the perl package Mail::Send has not been installed, so I can't send your bug
-report. We apologize for the inconvenience.
+    if ( my $error = $@ ) {
+        paraprint <<EOF;
+$0 has detected an error while trying to send your message: $error.
 
-So you may attempt to find some way of sending your message, it has
-been left in the file `$filename'.
+Your message may not have been sent. You will now have a chance to save a copy to disk.
 EOF
-	open(SENDMAIL, "|$sendmail -t -oi") || die "'|$sendmail -t -oi' failed: $!";
-sendout:
-	print SENDMAIL "To: $address\n";
-	print SENDMAIL "Subject: $subject\n";
-	print SENDMAIL "Cc: $cc\n" if $cc;
-	print SENDMAIL "Reply-To: $from\n" if $from;
-	print SENDMAIL "Message-Id: $messageid\n" if $messageid;
-	print SENDMAIL "\n\n";
-	open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
-	while (<REP>) { print SENDMAIL $_ }
-	close(REP) or die "Error closing $filename: $!";
-
-	if (close(SENDMAIL)) {
-	    printf "\nMessage %s.\n", $outfile ? "saved" : "sent";
-	} else {
-	    warn "\nSendmail returned status '", $? >> 8, "'\n";
-	}
+        SaveMessage();
+        return;
     }
-    1 while unlink($filename);  # remove all versions under VMS
-} # sub Send
+
+    1 while unlink($filename);    # remove all versions under VMS
+}    # sub Send
 
 sub Help {
     print <<EOF;
 
-A program to help generate bug reports about perl5, and mail them.
-It is designed to be used interactively. Normally no arguments will
-be needed.
+This program is designed to help you generate and send bug reports
+(and thank-you notes) about perl5 and the modules which ship with it.
+
+In most cases, you can just run "$0" interactively from a command
+line without any special arguments and follow the prompts.
+
+Advanced usage:
 
-Usage:
 $0  [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
     [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
 $0  [-v] [-r returnaddress] [-A] [-ok | -okay | -nok | -nokay]
 
-Simplest usage:  run "$0", and follow the prompts.
 
 Options:
 
@@ -964,8 +993,8 @@ Options:
         quickly send a prepared message.
   -F    File to output the resulting mail message to, instead of mailing.
   -S    Send without asking for confirmation.
-  -a    Address to send the report to. Defaults to `$address'.
-  -c    Address to send copy of report to. Defaults to `$cc'.
+  -a    Address to send the report to. Defaults to '$address'.
+  -c    Address to send copy of report to. Defaults to '$cc'.
   -C    Don't send copy to administrator.
   -s    Subject to include with the message. You will be prompted
         if you don't supply one on the command line.
@@ -974,7 +1003,8 @@ Options:
   -r    Your return address. The program will ask you to confirm
         this if you don't give it here.
   -e    Editor to use.
-  -t    Test mode. The target address defaults to `$testaddress'.
+  -t    Test mode. The target address defaults to '$testaddress'.
+  -T    Thank-you mode. The target address defaults to '$thanksaddress'.
   -d    Data mode.  This prints out your configuration data, without mailing
         anything. You can use this with -v to get more complete data.
   -A    Don't send a bug received acknowledgement to the return address.
@@ -1008,7 +1038,6 @@ sub filename {
 
 sub paraprint {
     my @paragraphs = split /\n{2,}/, "@_";
-    print "\n\n";
     for (@paragraphs) {   # implicit local $_
 	s/(\S)\s*\n/$1 /g;
 	write;
@@ -1016,6 +1045,160 @@ sub paraprint {
     }
 }
 
+sub _prompt {
+    my ($explanation, $prompt, $default) = (@_);
+    if ($explanation) {
+        print "\n\n";
+        paraprint $explanation;
+    }
+    print $prompt. ($default ? " [$default]" :''). ": ";
+	my $result = scalar(<>);
+    chomp($result);
+	$result =~ s/^\s*(.*?)\s*$/$1/s;
+    if ($default && $result eq '') {
+        return $default;
+    } else {
+        return $result;
+    }
+}
+
+sub _build_header {
+    my %attr = (@_);
+
+    my $head = '';
+    for my $header (keys %attr) {
+        $head .= "$header: ".$attr{$header}."\n";
+    }
+    return $head;
+}
+
+sub _message_headers {
+    my %headers = ( To => $address, Subject => $subject );
+    $headers{'Cc'}         = $cc        if ($cc);
+    $headers{'Message-Id'} = $messageid if ($messageid);
+    $headers{'Reply-To'}   = $from      if ($from);
+    return \%headers;
+}
+
+sub build_complete_message {
+    my $content = _build_header(%{_message_headers()}) . "\n\n";
+    open( REP, "<$filename" ) or die "Couldn't open file '$filename': $!\n";
+    while (<REP>) { $content .= $_; }
+    close(REP) or die "Error closing report file '$filename': $!";
+    return $content;
+}
+
+sub save_message_to_disk {
+    my $file = shift;
+
+	    open OUTFILE, ">$file" or do { warn  "Couldn't open '$file': $!\n"; return undef};
+        print OUTFILE build_complete_message();
+        close(OUTFILE) or do { warn  "Error closing $file: $!"; return undef };
+	    print "\nMessage saved.\n";
+        return 1;
+}
+
+sub _send_message_vms {
+    if (   ( $address =~ /@/ and $address !~ /^\w+%"/ )
+        or ( $cc =~ /@/ and $cc !~ /^\w+%"/ ) ) {
+        my $prefix;
+        foreach ( qw[ IN MX SMTP UCX PONY WINS ], '' ) {
+            $prefix = "$_%", last if $ENV{"MAIL\$PROTOCOL_$_"};
+        }
+        $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
+        $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
+    }
+    $subject =~ s/"/""/g;
+    $address =~ s/"/""/g;
+    $cc      =~ s/"/""/g;
+    my $sts = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
+    if ($sts) {
+        die "Can't spawn off mail (leaving bug report in $filename): $sts";
+    }
+}
+
+sub _send_message_mailsend {
+    my $msg = Mail::Send->new();
+    my %headers = %{_message_headers()};
+    for my $key ( keys %headers) {
+        $msg->add($key => $headers{$key});
+    }
+
+    $fh = $msg->open;
+    open(REP, "<$filename") or die "Couldn't open '$filename': $!\n";
+    while (<REP>) { print $fh $_ }
+    close(REP) or die "Error closing $filename: $!";
+    $fh->close;
+
+    print "\nMessage sent.\n";
+}
+
+sub _probe_for_sendmail {
+    my $sendmail = "";
+    for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
+        $sendmail = $_, last if -e $_;
+    }
+    if ( $^O eq 'os2' and $sendmail eq "" ) {
+        my $path = $ENV{PATH};
+        $path =~ s:\\:/:;
+        my @path = split /$Config{'path_sep'}/, $path;
+        for (@path) {
+            $sendmail = "$_/sendmail",     last if -e "$_/sendmail";
+            $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
+        }
+    }
+    return $sendmail;
+}
+
+sub _send_message_sendmail {
+    my $sendmail = _probe_for_sendmail();
+    unless ($sendmail) {
+        paraprint(<<"EOF"), die "\n";
+It appears that there is no program which looks like "sendmail" on
+your system and that the Mail::Send library from CPAN isn't available.
+Because of this, there's no easy way to automatically send your
+message.
+
+A copy of your message has been saved in '$filename' for you to
+send to '$address' with your normal mail client.
+EOF
+    }
+
+    open( SENDMAIL, "|$sendmail -t -oi" )
+        || die "'|$sendmail -t -oi' failed: $!";
+    print SENDMAIL build_complete_message();
+    if ( close(SENDMAIL) ) {
+        print "\nMessage sent\n";
+    } else {
+        warn "\nSendmail returned status '", $? >> 8, "'\n";
+    }
+}
+
+
+
+# a strange way to check whether any significant editing
+# has been done: check whether any new non-empty lines
+# have been added.
+
+sub _fingerprint_lines_in_report {
+    my $new_lines = 0;
+    # read in the report template once so that
+    # we can track whether the user does any editing.
+    # yes, *all* whitespace is ignored.
+
+    open(REP, "<$filename") or die "Unable to open report file '$filename': $!\n";
+    while (my $line = <REP>) {
+        $line =~ s/\s+//g;
+        $new_lines++ if (!$REP{$line});
+
+    }
+    close(REP) or die "Error closing report file '$filename': $!";
+    # returns the number of lines with content that wasn't there when last we looked
+    return $new_lines;
+}
+
+
+
 format STDOUT =
 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
 $_
@@ -1029,36 +1212,48 @@ perlbug - how to submit bug reports on Perl
 
 =head1 SYNOPSIS
 
+B<perlbug>
+
 B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
 S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
 S<[ B<-r> I<returnaddress> ]>
 S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
-S<[ B<-S> ]> S<[ B<-t> ]>  S<[ B<-d> ]>  S<[ B<-A> ]>  S<[ B<-h> ]>
+S<[ B<-S> ]> S<[ B<-t> ]>  S<[ B<-d> ]>  S<[ B<-A> ]>  S<[ B<-h> ]> S<[ B<-T> ]>
 
 B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
  S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
 
+B<perlthanks>
+
 =head1 DESCRIPTION
 
-A program to help generate bug reports about perl or the modules that
-come with it, and mail them.
 
-If you have found a bug with a non-standard port (one that was not part
-of the I<standard distribution>), a binary distribution, or a
-non-standard module (such as Tk, CGI, etc), then please see the
-documentation that came with that distribution to determine the correct
-place to report bugs.
+This program is designed to help you generate and send bug reports
+(and thank-you notes) about perl5 and the modules which ship with it.
+
+In most cases, you can just run it interactively from a command
+line without any special arguments and follow the prompts.
 
-C<perlbug> is designed to be used interactively. Normally no arguments
-will be needed.  Simply run it, and follow the prompts.
+If you have found a bug with a non-standard port (one that was not
+part of the I<standard distribution>), a binary distribution, or a
+non-core module (such as Tk, DBI, etc), then please see the
+documentation that came with that distribution to determine the
+correct place to report bugs.
 
-If you are unable to run B<perlbug> (most likely because you don't have
-a working setup to send mail that perlbug recognizes), you may have to
-compose your own report, and email it to B<perlbug@perl.org>.  You might
-find the B<-d> option useful to get summary information in that case.
+If you are unable to send your report using B<perlbug> (most likely
+because your system doesn't have a way to send mail that perlbug
+recognizes), you may be able to use this tool to compose your report
+and save it to a file which you can then send to B<perlbug@perl.org>
+using your regular mail client.
 
-In any case, when reporting a bug, please make sure you have run through
-this checklist:
+In extreme cases, B<perlbug> may not work well enough on your system
+to guide you through composing a bug report. In those cases, you
+may be able to use B<perlbug -d> to get system configuration
+information to include in a manually composed bug report to
+B<perlbug@perl.org>.
+
+
+When reporting a bug, please run through this checklist:
 
 =over 4
 
@@ -1068,110 +1263,142 @@ Type C<perl -v> at the command line to find out.
 
 =item Are you running the latest released version of perl?
 
-Look at http://www.perl.com/ to find out.  If it is not the latest
-released version, get that one and see whether your bug has been
-fixed.  Note that bug reports about old versions of Perl, especially
-those prior to the 5.0 release, are likely to fall upon deaf ears.
-You are on your own if you continue to use perl1 .. perl4.
+Look at http://www.perl.org/ to find out.  If you are not using the
+latest released version, please try to replicate your bug on the
+latest stable release.
+
+Note that reports about bugs in old versions of Perl, especially
+those which indicate you haven't also tested the current stable
+release of Perl, are likely to receive less attention from the
+volunteers who build and maintain Perl than reports about bugs in
+the current release.
+
+This tool isn't apropriate for reporting bugs in any version
+prior to Perl 5.0.
 
 =item Are you sure what you have is a bug?
 
-A significant number of the bug reports we get turn out to be documented
-features in Perl.  Make sure the behavior you are witnessing doesn't fall
-under that category, by glancing through the documentation that comes
-with Perl (we'll admit this is no mean task, given the sheer volume of
-it all, but at least have a look at the sections that I<seem> relevant).
+A significant number of the bug reports we get turn out to be
+documented features in Perl.  Make sure the issue you've run into
+isn't intentional by glancing through the documentation that comes
+with the Perl distribution.
 
-Be aware of the familiar traps that perl programmers of various hues
-fall into.  See L<perltrap>.
+Given the sheer volume of Perl documentation, this isn't a trivial
+undertaking, but if you can point to documentation that suggests
+the behaviour you're seeing is I<wrong>, your issue is likely to
+receive more attention. You may want to start with B<perldoc>
+L<perltrap> for pointers to common traps that new (and experienced)
+Perl programmers run into.
 
-Check in L<perldiag> to see what any Perl error message(s) mean.
-If message isn't in perldiag, it probably isn't generated by Perl.
-Consult your operating system documentation instead.
+If you're unsure of the meaning of an error message you've run
+across, B<perldoc> L<perldiag> for an explanation.  If the message
+isn't in perldiag, it probably isn't generated by Perl.  You may
+have luck consulting your operating system documentation instead.
 
-If you are on a non-UNIX platform check also L<perlport>, as some
+If you are on a non-UNIX platform B<perldoc> L<perlport>, as some
 features may be unimplemented or work differently.
 
-Try to study the problem under the Perl debugger, if necessary.
-See L<perldebug>.
+You may be able to figure out what's going wrong using the Perl
+debugger.  For information about how to use the debugger B<perldoc>
+L<perldebug>.
 
 =item Do you have a proper test case?
 
 The easier it is to reproduce your bug, the more likely it will be
-fixed, because if no one can duplicate the problem, no one can fix it.
-A good test case has most of these attributes: fewest possible number
-of lines; few dependencies on external commands, modules, or
-libraries; runs on most platforms unimpeded; and is self-documenting.
+fixed -- if nobody can duplicate your problem, it probably won't be 
+addressed.
+
+A good test case has most of these attributes: short, simple code;
+few dependencies on external commands, modules, or libraries; no
+platform-dependent code (unless it's a platform-specific bug);
+clear, simple documentation.
+
+A good test case is almost always a good candidate to be included in
+Perl's test suite.  If you have the time, consider writing your test case so
+that it can be easily included into the standard test suite.
 
-A good test case is almost always a good candidate to be on the perl
-test suite.  If you have the time, consider making your test case so
-that it will readily fit into the standard test suite.
+=item Have you included all relevant information?
 
-Remember also to include the B<exact> error messages, if any.
-"Perl complained something" is not an exact error message.
+Be sure to include the B<exact> error messages, if any.
+"Perl gave an error" is not an exact error message.
 
 If you get a core dump (or equivalent), you may use a debugger
 (B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
-report.  NOTE: unless your Perl has been compiled with debug info
+report.  
+
+NOTE: unless your Perl has been compiled with debug info
 (often B<-g>), the stack trace is likely to be somewhat hard to use
 because it will most probably contain only the function names and not
 their arguments.  If possible, recompile your Perl with debug info and
-reproduce the dump and the stack trace.
+reproduce the crash and the stack trace.
 
 =item Can you describe the bug in plain English?
 
-The easier it is to understand a reproducible bug, the more likely it
-will be fixed.  Anything you can provide by way of insight into the
-problem helps a great deal.  In other words, try to analyze the
-problem (to the extent you can) and report your discoveries.
+The easier it is to understand a reproducible bug, the more likely
+it will be fixed.  Any insight you can provide into the problem
+will help a great deal.  In other words, try to analyze the problem
+(to the extent you can) and report your discoveries.
 
 =item Can you fix the bug yourself?
 
 A bug report which I<includes a patch to fix it> will almost
-definitely be fixed.  Use the C<diff> program to generate your patches
-(C<diff> is being maintained by the GNU folks as part of the B<diffutils>
-package, so you should be able to get it from any of the GNU software
-repositories).  If you do submit a patch, the cool-dude counter at
-perlbug@perl.org will register you as a savior of the world.  Your
-patch may be returned with requests for changes, or requests for more
+definitely be fixed.  When sending a patch, please use the C<diff>
+program with the C<-u> option to generate "unified" diff files.
+Bug reports with patches are likely to receive significantly more
+attention and interest than those without patches.
+
+Your patch may be returned with requests for changes, or requests for more
 detailed explanations about your fix.
 
-Here are some clues for creating quality patches: Use the B<-c> or
-B<-u> switches to the diff program (to create a so-called context or
-unified diff).  Make sure the patch is not reversed (the first
-argument to diff is typically the original file, the second argument
-your changed file).  Make sure you test your patch by applying it with
-the C<patch> program before you send it on its way.  Try to follow the
-same style as the code you are trying to patch.  Make sure your patch
-really does work (C<make test>, if the thing you're patching supports
-it).
+Here are a few hints for creating high-quality patches:
+
+Make sure the patch is not reversed (the first argument to diff is
+typically the original file, the second argument your changed file).
+Make sure you test your patch by applying it with the C<patch>
+program before you send it on its way.  Try to follow the same style
+as the code you are trying to patch.  Make sure your patch really
+does work (C<make test>, if the thing you're patching is covered
+by Perl's test suite).
 
 =item Can you use C<perlbug> to submit the report?
 
 B<perlbug> will, amongst other things, ensure your report includes
-crucial information about your version of perl.  If C<perlbug> is unable
-to mail your report after you have typed it in, you may have to compose
-the message yourself, add the output produced by C<perlbug -d> and email
-it to B<perlbug@perl.org>.  If, for some reason, you cannot run
-C<perlbug> at all on your system, be sure to include the entire output
-produced by running C<perl -V> (note the uppercase V).
+crucial information about your version of perl.  If C<perlbug> is
+unable to mail your report after you have typed it in, you may have
+to compose the message yourself, add the output produced by C<perlbug
+-d> and email it to B<perlbug@perl.org>.  If, for some reason, you
+cannot run C<perlbug> at all on your system, be sure to include the
+entire output produced by running C<perl -V> (note the uppercase V).
 
 Whether you use C<perlbug> or send the email manually, please make
-your Subject line informative.  "a bug" not informative.  Neither is
-"perl crashes" nor "HELP!!!".  These don't help.
-A compact description of what's wrong is fine.
+your Subject line informative.  "a bug" is not informative.  Neither
+is "perl crashes" nor is "HELP!!!".  These don't help.  A compact
+description of what's wrong is fine.
+
+=item Can you use C<perlbug> to submit a thank-you note?
+
+Yes, you can do this by either using the C<-T> option, or by invoking
+the program as C<perlthanks>. Thank-you notes are good. It makes people
+smile. 
 
 =back
 
-Having done your bit, please be prepared to wait, to be told the bug
-is in your code, or even to get no reply at all.  The Perl maintainers
-are busy folks, so if your problem is a small one or if it is difficult
-to understand or already known, they may not respond with a personal reply.
+Having done your bit, please be prepared to wait, to be told the
+bug is in your code, or possibly to get no reply at all.  The
+volunteers who maintain Perl are busy folks, so if your problem is
+an obvious bug in your own code, is difficult to understand or is
+a duplicate of an existing report, you may not receive a personal
+reply.
+
 If it is important to you that your bug be fixed, do monitor the
-C<Changes> file in any development releases since the time you submitted
-the bug, and encourage the maintainers with kind words (but never any
-flames!).  Feel free to resend your bug report if the next released
-version of perl comes out and your bug is still present.
+perl5-porters@perl.org mailing list and the commit logs to development
+versions of Perl, and encourage the maintainers with kind words or
+offers of frosty beverages.  (Please do be kind to the maintainers.
+Harassing or flaming them is likely to have the opposite effect of
+the one you want.)
+
+Feel free to update the ticket about your bug on http://rt.perl.org
+if a new version of Perl is released and your bug is still present.
 
 =head1 OPTIONS
 
@@ -1273,6 +1500,10 @@ supply one on the command line.
 
 Test mode.  The target address defaults to B<perlbug-test@perl.org>.
 
+=item B<-T>
+
+Send a thank-you note instead of a bug report. 
+
 =item B<-v>
 
 Include verbose configuration data in the report.
@@ -1281,15 +1512,16 @@ Include verbose configuration data in the report.
 
 =head1 AUTHORS
 
-Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently I<doc>tored
-by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>), Tom Christiansen
-(E<lt>tchrist@perl.comE<gt>), Nathan Torkington (E<lt>gnat@frii.comE<gt>),
-Charles F. Randall (E<lt>cfr@pobox.comE<gt>), Mike Guy
-(E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop (E<lt>domo@computer.orgE<gt>),
-Hugo van der Sanden (E<lt>hv@crypt.org<gt>),
+Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently
+I<doc>tored by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>),
+Tom Christiansen (E<lt>tchrist@perl.comE<gt>), Nathan Torkington
+(E<lt>gnat@frii.comE<gt>), Charles F. Randall (E<lt>cfr@pobox.comE<gt>),
+Mike Guy (E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop
+(E<lt>domo@computer.orgE<gt>), Hugo van der Sanden (E<lt>hv@crypt.org<gt>),
 Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>), Chris Nandor
 (E<lt>pudge@pobox.comE<gt>), Jon Orwant (E<lt>orwant@media.mit.eduE<gt>,
-and Richard Foley (E<lt>richard@rfi.netE<gt>).
+Richard Foley (E<lt>richard.foley@rfi.netE<gt>), and Jesse Vincent
+(E<lt>jesse@bestpractical.com<gt>).
 
 =head1 SEE ALSO
 
diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm
index a68e796f3a3..54f37c94fb2 100644
--- a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm
+++ b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm
@@ -13,7 +13,7 @@ use Carp '&croak';
 use DynaLoader ();
 use Exporter ();
  
-$VERSION = '2.3';
+$VERSION = '2.4';
 @ISA = qw( Exporter DynaLoader IO::File );
 @EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL  &O_NDELAY &O_NOWAIT
               &O_RDONLY &O_RDWR  &O_TRUNC &O_WRONLY );
diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs
index bb475e77469..c50bacb3f35 100644
--- a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs
+++ b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs
@@ -93,10 +93,10 @@ newFH(PerlIO *fp, char type) {
      * equivalent to gv_fetchpv("VMS::Stdio::__FH__",TRUE,SVt_PVIO),
      * with a little less overhead, and good exercise for me. :-) */
     stashp = (GV **)hv_fetch(PL_defstash,"VMS::",5,TRUE);
-    if (!stashp || *stashp == (GV *)&PL_sv_undef) return Nullsv;
+    if (!stashp || *stashp == (GV *)&PL_sv_undef) return NULL;
     if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV();
     stashp = (GV **)hv_fetch(GvHV(*stashp),"Stdio::",7,TRUE);
-    if (!stashp || *stashp == (GV *)&PL_sv_undef) return Nullsv;
+    if (!stashp || *stashp == (GV *)&PL_sv_undef) return NULL;
     if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV();
 
     /* Set up GV to point to IO, and then take reference */
@@ -131,14 +131,14 @@ binmode(fh)
            SV *name;
 	   IO *io;
 	   char iotype;
-	   char filespec[NAM$C_MAXRSS], *acmode, *s, *colon, *dirend = Nullch;
+	   char filespec[NAM$C_MAXRSS], *acmode, *s, *colon, *dirend = NULL;
 	   int ret = 0, saverrno = errno, savevmserrno = vaxc$errno;
            SV pos;
            PerlIO *fp;
 	   io = sv_2io(fh);
            fp = io ? IoOFP(io) : NULL;
 	   iotype = io ? IoTYPE(io) : '\0';
-	    if (fp == NULL || strchr(">was+-|",iotype) == Nullch) {
+	    if (fp == NULL || strchr(">was+-|",iotype) == NULL) {
 	      set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN); XSRETURN_UNDEF;
 	    }
            if (!PerlIO_getname(fp,filespec)) XSRETURN_UNDEF;
@@ -152,7 +152,7 @@ binmode(fh)
 	    }
 	    /* If we've got a non-file-structured device, clip off the trailing
 	     * junk, and don't lose sleep if we can't get a stream position.  */
-	    if (dirend == Nullch) *(colon+1) = '\0'; 
+	    if (dirend == NULL) *(colon+1) = '\0'; 
            if (iotype != '-' && (ret = PerlIO_getpos(fp, &pos)) == -1 && dirend)
 	      XSRETURN_UNDEF;
 	    switch (iotype) {
@@ -174,7 +174,7 @@ binmode(fh)
 	    }
            /* appearances to the contrary, this is an freopen substitute */
            name = sv_2mortal(newSVpvn(filespec,strlen(filespec)));
-           if (PerlIO_openn(aTHX_ Nullch,acmode,-1,0,0,fp,1,&name) == Nullfp) XSRETURN_UNDEF;
+           if (PerlIO_openn(aTHX_ NULL,acmode,-1,0,0,fp,1,&name) == NULL) XSRETURN_UNDEF;
            if (iotype != '-' && ret != -1 && PerlIO_setpos(fp,&pos) == -1) XSRETURN_UNDEF;
 	    if (ret == -1) { set_errno(saverrno); set_vaxc_errno(savevmserrno); }
 	    XSRETURN_YES;
@@ -349,7 +349,7 @@ vmsopen(spec,...)
 	        fp = fopen(spec,mode,args[0],args[1],args[2],args[3],args[4],args[5],args[6],args[7]);
 	        break;
 	    }
-           if (fp != Null(FILE*)) {
+	    if (fp != NULL) {
              pio_fp = PerlIO_fdopen(fileno(fp),mode);
              fh = newFH(pio_fp,(mode[1] ? '+' : (mode[0] == 'r' ? '<' : (mode[0] == 'a' ? 'a' : '>'))));
 	     ST(0) = (fh ? sv_2mortal(fh) : &PL_sv_undef);
@@ -408,7 +408,7 @@ vmssysopen(spec,mode,perm,...)
 	    }
 	    i = mode & 3;
 	    if (fd >= 0 &&
-              ((pio_fp = PerlIO_fdopen(fd, &("r\000w\000r+"[2*i]))) != Null(PerlIO*))) {
+              ((pio_fp = PerlIO_fdopen(fd, &("r\000w\000r+"[2*i]))) != NULL)) {
              fh = newFH(pio_fp,"<>++"[i]);
 	     ST(0) = (fh ? sv_2mortal(fh) : &PL_sv_undef);
 	    }
@@ -433,10 +433,10 @@ writeof(mysv)
 	    struct dsc$descriptor devdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, devnam};
 	    IO *io = sv_2io(mysv);
            PerlIO *fp = io ? IoOFP(io) : NULL;
-	    if (fp == NULL || strchr(">was+-|",IoTYPE(io)) == Nullch) {
+	    if (fp == NULL || strchr(">was+-|",IoTYPE(io)) == NULL) {
 	      set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN); XSRETURN_UNDEF;
 	    }
-           if (PerlIO_getname(fp,devnam) == Nullch) { ST(0) = &PL_sv_undef; XSRETURN(1); }
+           if (PerlIO_getname(fp,devnam) == NULL) { ST(0) = &PL_sv_undef; XSRETURN(1); }
 	    if ((cp = strrchr(devnam,':')) != NULL) *(cp+1) = '\0';
 	    devdsc.dsc$w_length = strlen(devnam);
 	    retsts = sys$assign(&devdsc,&chan,0,0);
diff --git a/gnu/usr.bin/perl/vms/ext/XSSymSet.pm b/gnu/usr.bin/perl/vms/ext/XSSymSet.pm
deleted file mode 100644
index 5fd59e79aaf..00000000000
--- a/gnu/usr.bin/perl/vms/ext/XSSymSet.pm
+++ /dev/null
@@ -1,237 +0,0 @@
-package ExtUtils::XSSymSet;
-
-use strict;
-use vars qw( $VERSION );
-$VERSION = '1.1';
-
-
-sub new { 
-  my($pkg,$maxlen,$silent) = @_;
-  $maxlen ||= 31;
-  $silent ||= 0;
-  my($obj) = { '__M@xLen' => $maxlen, '__S!lent' => $silent };
-  bless $obj, $pkg;
-}
-
-
-sub trimsym {
-  my($self,$name,$maxlen,$silent) = @_;
-
-  unless (defined $maxlen) {
-    if (ref $self) { $maxlen ||= $self->{'__M@xLen'}; }
-    $maxlen ||= 31;
-  }
-  unless (defined $silent) {
-    if (ref $self) { $silent ||= $self->{'__S!lent'}; }
-    $silent ||= 0;
-  }
-  return $name if (length $name <= $maxlen);
-
-  my $trimmed = $name;
-  # First, just try to remove duplicated delimiters
-  $trimmed =~ s/__/_/g;
-  if (length $trimmed > $maxlen) {
-    # Next, all duplicated chars
-    $trimmed =~ s/(.)\1+/$1/g;
-    if (length $trimmed > $maxlen) {
-      my $squeezed = $trimmed;
-      my($xs,$prefix,$func) = $trimmed =~ /^(XS_)?(.*)_([^_]*)$/;
-      $xs ||= '';
-      my $frac = 3; # replaces broken length-based calculations but w/same result
-      my $pat = '([^_])';
-      if (length $func <= 12) {  # Try to preserve short function names
-        if ($frac > 1) { $pat .= '[^A-Z_]{' . ($frac - 1) . '}'; }
-        $prefix =~ s/$pat/$1/g;
-        $squeezed = "$xs$prefix" . "_$func";
-        if (length $squeezed > $maxlen) {
-          $pat =~ s/A-Z//;
-          $prefix =~ s/$pat/$1/g;
-          $squeezed = "$xs$prefix" . "_$func";
-        }
-      }
-      else { 
-        if ($frac > 1) { $pat .= '[^A-Z_]{' . ($frac - 1) . '}'; }
-        $squeezed = "$prefix$func";
-        $squeezed =~ s/$pat/$1/g;
-        if (length "$xs$squeezed" > $maxlen) {
-          $pat =~ s/A-Z//;
-          $squeezed =~ s/$pat/$1/g;
-        }
-        $squeezed = "$xs$squeezed";
-      }
-      if (length $squeezed <= $maxlen) { $trimmed = $squeezed; }
-      else {
-        my $frac = int((length $trimmed - $maxlen) / length $trimmed + 0.5);
-        my $pat = '(.).{$frac}';
-        $trimmed =~ s/$pat/$1/g;
-      }
-    }
-  }
-  warn "Warning: long symbol $name\n\ttrimmed to $trimmed\n\t" unless $silent;
-  return $trimmed;
-}
-
-
-sub addsym {
-  my($self,$sym,$maxlen,$silent) = @_;
-  my $trimmed = $self->get_trimmed($sym);
-
-  return $trimmed if defined $trimmed;
-
-  $maxlen ||= $self->{'__M@xLen'} || 31;
-  $silent ||= $self->{'__S!lent'} || 0;    
-  $trimmed = $self->trimsym($sym,$maxlen,1);
-  if (exists $self->{$trimmed}) {
-    my($i) = "00";
-    $trimmed = $self->trimsym($sym,$maxlen-3,$silent);
-    while (exists $self->{"${trimmed}_$i"}) { $i++; }
-    warn "Warning: duplicate symbol $trimmed\n\tchanged to ${trimmed}_$i\n\t(original was $sym)\n\t"
-      unless $silent;
-    $trimmed .= "_$i";
-  }
-  elsif (not $silent and $trimmed ne $sym) {
-    warn "Warning: long symbol $sym\n\ttrimmed to $trimmed\n\t";
-  }
-  $self->{$trimmed} = $sym;
-  $self->{'__N+Map'}->{$sym} = $trimmed;
-  $trimmed;
-}
-
-
-sub delsym {
-  my($self,$sym) = @_;
-  my $trimmed = $self->{'__N+Map'}->{$sym};
-  if (defined $trimmed) {
-    delete $self->{'__N+Map'}->{$sym};
-    delete $self->{$trimmed};
-  }
-  $trimmed;
-}
-
-
-sub get_trimmed {
-  my($self,$sym) = @_;
-  $self->{'__N+Map'}->{$sym};
-}
-
-
-sub get_orig {
-  my($self,$trimmed) = @_;
-  $self->{$trimmed};
-}
-
-
-sub all_orig { (keys %{$_[0]->{'__N+Map'}}); }
-sub all_trimmed { (grep { /^\w+$/ } keys %{$_[0]}); }
-
-__END__
-
-=head1 NAME
-
-VMS::XSSymSet - keep sets of symbol names palatable to the VMS linker
-
-=head1 SYNOPSIS
-
-  use VMS::XSSymSet;
-
-  $set = new VMS::XSSymSet;
-  while ($sym = make_symbol()) { $set->addsym($sym); }
-  foreach $safesym ($set->all_trimmed) {
-    print "Processing $safesym (derived from ",$self->get_orig($safesym),")\n";
-    do_stuff($safesym);
-  }
-
-  $safesym = VMS::XSSymSet->trimsym($onesym);
-
-=head1 DESCRIPTION
-
-Since the VMS linker distinguishes symbols based only on the first 31
-characters of their names, it is occasionally necessary to shorten
-symbol names in order to avoid collisions.  (This is especially true of
-names generated by xsubpp, since prefixes generated by nested package
-names can become quite long.)  C<VMS::XSSymSet> provides functions to
-shorten names in a consistent fashion, and to track a set of names to
-insure that each is unique.  While designed with F<xsubpp> in mind, it
-may be used with any set of strings.  
-
-This package supplies the following functions, all of which should be
-called as methods.
-
-=over 4
-
-=item new([$maxlen[,$silent]])
-
-Creates an empty C<VMS::XSSymset> set of symbols.  This function may be
-called as a static method or via an existing object.  If C<$maxlen> or
-C<$silent> are specified, they are used as the defaults for maximum
-name length and warning behavior in future calls to addsym() or
-trimsym() via this object.
-
-=item addsym($name[,$maxlen[,$silent]])
-
-Creates a symbol name from C<$name>, using the methods described
-under trimsym(), which is unique in this set of symbols, and returns
-the new name.  C<$name> and its resultant are added to the set, and
-any future calls to addsym() specifying the same C<$name> will return
-the same result, regardless of the value of C<$maxlen> specified.
-Unless C<$silent> is true, warnings are output if C<$name> had to be
-trimmed or changed in order to avoid collision with an existing symbol
-name.  C<$maxlen> and C<$silent> default to the values specified when
-this set of symbols was created.  This method must be called via an
-existing object.
-
-=item trimsym($name[,$maxlen[,$silent]])
-
-Creates a symbol name C<$maxlen> or fewer characters long from
-C<$name> and returns it. If C<$name> is too long, it first tries to
-shorten it by removing duplicate characters, then by periodically
-removing non-underscore characters, and finally, if necessary, by
-periodically removing characters of any type.  C<$maxlen> defaults
-to 31.  Unless C<$silent> is true, a warning is output if C<$name>
-is altered in any way.  This function may be called either as a
-static method or via an existing object, but in the latter case no
-check is made to insure that the resulting name is unique in the
-set of symbols.
-
-=item delsym($name)
-
-Removes C<$name> from the set of symbols, where C<$name> is the
-original symbol name passed previously to addsym().  If C<$name>
-existed in the set of symbols, returns its "trimmed" equivalent,
-otherwise returns C<undef>.  This method must be called via an
-existing object.
-
-=item get_orig($trimmed)
-
-Returns the original name which was trimmed to C<$trimmed> by a
-previous call to addsym(), or C<undef> if C<$trimmed> does not
-correspond to a member of this set of symbols.  This method must be
-called via an existing object.
-
-=item get_trimmed($name)
-
-Returns the trimmed name which was generated from C<$name> by a
-previous call to addsym(), or C<undef> if C<$name> is not a member
-of this set of symbols.  This method must be called via an
-existing object.
-
-=item all_orig()
-
-Returns a list containing all of the original symbol names
-from this set.
-
-=item all_trimmed()
-
-Returns a list containing all of the trimmed symbol names
-from this set.
-
-=back
-
-=head1 AUTHOR
-
-Charles Bailey  E<lt>I<bailey@newman.upenn.edu>E<gt>
-
-=head1 REVISION
-
-Last revised 14-Feb-1997, for Perl 5.004.
-
diff --git a/gnu/usr.bin/perl/vms/ext/filespec.t b/gnu/usr.bin/perl/vms/ext/filespec.t
index 3415400b216..b40cc816f32 100644
--- a/gnu/usr.bin/perl/vms/ext/filespec.t
+++ b/gnu/usr.bin/perl/vms/ext/filespec.t
@@ -15,13 +15,46 @@ foreach (<DATA>) {
 require './test.pl';
 plan(tests => scalar(2*@tests)+6);
 
+my $vms_unix_rpt;
+my $vms_efs;
+
+if ($^O eq 'VMS') {
+    if (eval 'require VMS::Feature') {
+        $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
+        $vms_efs = VMS::Feature::current("efs_charset");
+    } else {
+        my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+        my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
+        $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; 
+        $vms_efs = $efs_charset =~ /^[ET1]/i; 
+    }
+}
+
+
+
 foreach $test (@tests) {
-  ($arg,$func,$expect) = split(/\s+/,$test);
+  ($arg,$func,$expect2,$expect5) = split(/\s+/,$test);
+
+  $expect2 = undef if $expect2 eq 'undef';
+  $expect2 = undef if $expect2 eq '^';
+  $expect5 = undef if $expect5 eq 'undef';
+  $expect5 = $expect2 if $expect5 eq '^';
+
+  if ($vms_efs) {
+	$expect = $expect5;
+  }
+  else {
+	$expect = $expect2;
+  }
 
-  $expect = undef if $expect eq 'undef';
   $rslt = eval "$func('$arg')";
   is($@, '', "eval ${func}('$arg')");
-  is(lc($rslt), lc($expect), "${func}('$arg'): '$rslt'");
+  if ($expect ne '^*') {
+    is(lc($rslt), lc($expect), "${func}('$arg'): '$rslt'");
+  }
+  else {
+    is(lc($rslt), lc($expect), "${func}('$arg'): '$rslt' # TODO fix ODS-5 test");
+  }
 }
 
 $defwarn = <<'EOW';
@@ -49,84 +82,90 @@ __DATA__
 # lots of underscores used to minimize collision with existing logical names
 
 # Basic VMS to Unix filespecs
-__some_:[__where_.__over_]__the_.__rainbow_    unixify /__some_/__where_/__over_/__the_.__rainbow_
-[.__some_.__where_.__over_]__the_.__rainbow_   unixify __some_/__where_/__over_/__the_.__rainbow_
-[-.__some_.__where_.__over_]__the_.__rainbow_  unixify ../__some_/__where_/__over_/__the_.__rainbow_
-[.__some_.--.__where_.__over_]__the_.__rainbow_        unixify __some_/../../__where_/__over_/__the_.__rainbow_
-[.__some_...__where_.__over_]__the_.__rainbow_ unixify __some_/.../__where_/__over_/__the_.__rainbow_
-[...__some_.__where_.__over_]__the_.__rainbow_ unixify .../__some_/__where_/__over_/__the_.__rainbow_
-[.__some_.__where_.__over_...]__the_.__rainbow_        unixify __some_/__where_/__over_/.../__the_.__rainbow_
-[.__some_.__where_.__over_...] unixify __some_/__where_/__over_/.../
-[.__some_.__where_.__over_.-]  unixify __some_/__where_/__over_/../
-[]	unixify		./
-[-]	unixify		../
-[--]	unixify		../../
-[...]	unixify		.../
-__lyrics_:[__are_.__very_^.__sappy_]__but_^.__rhymes_^.__are_.__true_    unixify /__lyrics_/__are_/__very_.__sappy_/__but_.__rhymes_.__are_.__true_
+__some_:[__where_.__over_]__the_.__rainbow_    unixify /__some_/__where_/__over_/__the_.__rainbow_ ^
+__some_:<__where_.__over_>__the_.__rainbow_    unixify /__some_/__where_/__over_/__the_.__rainbow_ ^
+[.__some_.__where_.__over_]__the_.__rainbow_   unixify __some_/__where_/__over_/__the_.__rainbow_ ^
+[-.__some_.__where_.__over_]__the_.__rainbow_  unixify ../__some_/__where_/__over_/__the_.__rainbow_ ^
+[.__some_.--.__where_.__over_]__the_.__rainbow_        unixify __some_/../../__where_/__over_/__the_.__rainbow_ ^
+[.__some_...__where_.__over_]__the_.__rainbow_ unixify __some_/.../__where_/__over_/__the_.__rainbow_ ^*
+[...__some_.__where_.__over_]__the_.__rainbow_ unixify .../__some_/__where_/__over_/__the_.__rainbow_ ^*
+[.__some_.__where_.__over_...]__the_.__rainbow_        unixify __some_/__where_/__over_/.../__the_.__rainbow_ ^*
+[.__some_.__where_.__over_...] unixify __some_/__where_/__over_/.../ ^*
+[.__some_.__where_.__over_.-]  unixify __some_/__where_/__over_/../ ^
+[]	unixify		./	^
+[-]	unixify		../	^
+[--]	unixify		../../	^
+[...]	unixify		.../	^*
+[.$(macro)]	unixify	$(macro)/ ^
 
 # and back again
-/__some_/__where_/__over_/__the_.__rainbow_    vmsify  __some_:[__where_.__over_]__the_.__rainbow_
-__some_/__where_/__over_/__the_.__rainbow_     vmsify  [.__some_.__where_.__over_]__the_.__rainbow_
-../__some_/__where_/__over_/__the_.__rainbow_  vmsify  [-.__some_.__where_.__over_]__the_.__rainbow_
-__some_/../../__where_/__over_/__the_.__rainbow_       vmsify  [-.__where_.__over_]__the_.__rainbow_
-.../__some_/__where_/__over_/__the_.__rainbow_ vmsify  [...__some_.__where_.__over_]__the_.__rainbow_
-__some_/.../__where_/__over_/__the_.__rainbow_ vmsify  [.__some_...__where_.__over_]__the_.__rainbow_
-/__some_/.../__where_/__over_/__the_.__rainbow_        vmsify  __some_:[...__where_.__over_]__the_.__rainbow_
-__some_/__where_/...   vmsify  [.__some_.__where_...]
-/__where_/...  vmsify  __where_:[...]
-.	vmsify	[]
-..	vmsify	[-]
-../..	vmsify	[--]
-.../	vmsify	[...]
-/	vmsify	sys$disk:[000000]
+/__some_/__where_/__over_/__the_.__rainbow_    vmsify  __some_:[__where_.__over_]__the_.__rainbow_ ^
+__some_/__where_/__over_/__the_.__rainbow_     vmsify  [.__some_.__where_.__over_]__the_.__rainbow_ ^
+../__some_/__where_/__over_/__the_.__rainbow_  vmsify  [-.__some_.__where_.__over_]__the_.__rainbow_ ^
+__some_/../../__where_/__over_/__the_.__rainbow_       vmsify  [-.__where_.__over_]__the_.__rainbow_  [.__some_.--.__where_.__over_]__the_.__rainbow_
+.../__some_/__where_/__over_/__the_.__rainbow_ vmsify  [...__some_.__where_.__over_]__the_.__rainbow_ [.^.^.^..__some_.__where_.__over_]__the_.__rainbow_
+__some_/.../__where_/__over_/__the_.__rainbow_ vmsify  [.__some_...__where_.__over_]__the_.__rainbow_  [.__some_.^.^.^..__where_.__over_]__the_.__rainbow_
+/__some_/.../__where_/__over_/__the_.__rainbow_        vmsify  __some_:[...__where_.__over_]__the_.__rainbow_ __some_:[^.^.^..__where_.__over_]__the_.__rainbow_
+__some_/__where_/...   vmsify  [.__some_.__where_...] [.__some_.__where_]^.^.^..
+/__where_/...  vmsify  __where_:[...] __where_:[]^.^.^..
+.	vmsify	[]	^
+..	vmsify	[-]	^
+../..	vmsify	[--]	^
+.../	vmsify	[...]	[.^.^.^.]
+# Can not predict what / will translate to.
+/	vmsify	sys$disk:[000000] ^*
+./$(macro)/	vmsify	[.$(macro)] ^
+./$(macro)	vmsify	[]$(macro) ^
+./$(m+	vmsify	[]$^(m^+	[]$^(m^+.
 
 # Fileifying directory specs
-__down_:[__the_.__garden_.__path_]     fileify __down_:[__the_.__garden_]__path_.dir;1
-[.__down_.__the_.__garden_.__path_]    fileify [.__down_.__the_.__garden_]__path_.dir;1
-/__down_/__the_/__garden_/__path_      fileify /__down_/__the_/__garden_/__path_.dir;1
-/__down_/__the_/__garden_/__path_/     fileify /__down_/__the_/__garden_/__path_.dir;1
-__down_/__the_/__garden_/__path_       fileify __down_/__the_/__garden_/__path_.dir;1
-__down_:[__the_.__garden_]__path_      fileify __down_:[__the_.__garden_]__path_.dir;1
-__down_:[__the_.__garden_]__path_.     fileify # N.B. trailing . ==> null type
-__down_:[__the_]__garden_.__path_      fileify undef
-/__down_/__the_/__garden_/__path_.     fileify # N.B. trailing . ==> null type
-/__down_/__the_/__garden_.__path_      fileify undef
+__down_:[__the_.__garden_.__path_]     fileify __down_:[__the_.__garden_]__path_.dir;1 ^
+[.__down_.__the_.__garden_.__path_]    fileify [.__down_.__the_.__garden_]__path_.dir;1 ^
+/__down_/__the_/__garden_/__path_      fileify /__down_/__the_/__garden_/__path_.dir;1 /__down_/__the_/__garden_/__path_
+/__down_/__the_/__garden_/__path_/     fileify /__down_/__the_/__garden_/__path_.dir;1 /__down_/__the_/__garden_/__path_
+__down_/__the_/__garden_/__path_       fileify __down_/__the_/__garden_/__path_.dir;1 __down_/__the_/__garden_/__path_
+__down_:[__the_.__garden_]__path_      fileify __down_:[__the_.__garden_]__path_.dir;1 ^
+__down_:[__the_.__garden_]__path_.     fileify ^ __down_:[__the_.__garden_]__path_^..dir;1 # N.B. trailing . ==> null type
+__down_:[__the_]__garden_.__path_      fileify ^ __down_:[__the_]__garden_^.__path_.dir;1 #undef
+/__down_/__the_/__garden_/__path_.     fileify ^ /__down_/__the_/__garden_/__path_. # N.B. trailing . ==> null type
+/__down_/__the_/__garden_.__path_      fileify ^ /__down_/__the_/__garden_.__path_
 
 # and pathifying them
-__down_:[__the_.__garden_]__path_.dir;1        pathify __down_:[__the_.__garden_.__path_]
-[.__down_.__the_.__garden_]__path_.dir pathify [.__down_.__the_.__garden_.__path_]
-/__down_/__the_/__garden_/__path_.dir  pathify /__down_/__the_/__garden_/__path_/
-__down_/__the_/__garden_/__path_.dir   pathify __down_/__the_/__garden_/__path_/
-__down_:[__the_.__garden_]__path_      pathify __down_:[__the_.__garden_.__path_]
-__down_:[__the_.__garden_]__path_.     pathify # N.B. trailing . ==> null type
-__down_:[__the_]__garden_.__path_      pathify undef
-/__down_/__the_/__garden_/__path_.     pathify # N.B. trailing . ==> null type
-/__down_/__the_/__garden_.__path_      pathify undef
-__down_:[__the_.__garden_]__path_.dir;2        pathify #N.B. ;2
-__path_        pathify __path_/
-/__down_/__the_/__garden_/.    pathify /__down_/__the_/__garden_/./
-/__down_/__the_/__garden_/..   pathify /__down_/__the_/__garden_/../
-/__down_/__the_/__garden_/...  pathify /__down_/__the_/__garden_/.../
-__path_.notdir pathify undef
+__down_:[__the_.__garden_]__path_.dir;1        pathify __down_:[__the_.__garden_.__path_] ^
+[.__down_.__the_.__garden_]__path_.dir pathify [.__down_.__the_.__garden_.__path_] ^
+/__down_/__the_/__garden_/__path_.dir  pathify /__down_/__the_/__garden_/__path_/ ^
+__down_/__the_/__garden_/__path_.dir   pathify __down_/__the_/__garden_/__path_/ ^
+__down_:[__the_.__garden_]__path_      pathify __down_:[__the_.__garden_.__path_] ^
+__down_:[__the_.__garden_]__path_.     pathify ^ __down_:[__the.__garden_.__path_^.] # N.B. trailing . ==> null type
+__down_:[__the_]__garden_.__path_      pathify ^ __down_:[__the_.__garden_^.__path_] # undef
+/__down_/__the_/__garden_/__path_.     pathify /__down_/__the_/__garden_/__path__/ /__down_/__the_/__garden_/__path_./ # N.B. trailing . ==> null type
+/__down_/__the_/__garden_.__path_      pathify /__down_/__the_/__garden____path_/ /__down_/__the_/__garden_.__path_/
+__down_:[__the_.__garden_]__path_.dir;2        pathify ^ #N.B. ;2
+__path_        pathify __path_/ ^
+/__down_/__the_/__garden_/.    pathify /__down_/__the_/__garden_/./ ^
+/__down_/__the_/__garden_/..   pathify /__down_/__the_/__garden_/../ ^
+/__down_/__the_/__garden_/...  pathify /__down_/__the_/__garden_/.../ ^ 
+__path_.notdir pathify __path__notdir/ __path_.notdir/
 
 # Both VMS/Unix and file/path conversions
-__down_:[__the_.__garden_]__path_.dir;1        unixpath        /__down_/__the_/__garden_/__path_/
-/__down_/__the_/__garden_/__path_      vmspath __down_:[__the_.__garden_.__path_]
-__down_:[__the_.__garden_.__path_]     unixpath        /__down_/__the_/__garden_/__path_/
-__down_:[__the_.__garden_.__path_...]  unixpath        /__down_/__the_/__garden_/__path_/.../
-/__down_/__the_/__garden_/__path_.dir  vmspath __down_:[__the_.__garden_.__path_]
-[.__down_.__the_.__garden_]__path_.dir unixpath        __down_/__the_/__garden_/__path_/
-__down_/__the_/__garden_/__path_       vmspath [.__down_.__the_.__garden_.__path_]
-__path_        vmspath [.__path_]
-/	vmspath	sys$disk:[000000]
+__down_:[__the_.__garden_]__path_.dir;1        unixpath        /__down_/__the_/__garden_/__path_/ ^
+/__down_/__the_/__garden_/__path_      vmspath __down_:[__the_.__garden_.__path_] ^
+__down_:[__the_.__garden_.__path_]     unixpath        /__down_/__the_/__garden_/__path_/ ^
+__down_:[__the_.__garden_.__path_...]  unixpath        /__down_/__the_/__garden_/__path_/.../ # Not translatable
+/__down_/__the_/__garden_/__path_.dir  vmspath __down_:[__the_.__garden_.__path_] ^
+[.__down_.__the_.__garden_]__path_.dir unixpath        __down_/__the_/__garden_/__path_/ ^
+__down_/__the_/__garden_/__path_       vmspath [.__down_.__the_.__garden_.__path_] ^
+__path_        vmspath [.__path_] ^
+/	vmspath	sys$disk:[000000] ^*
+/sys$scratch	vmspath	sys$scratch: ^
 
 # Redundant characters in Unix paths
-//__some_/__where_//__over_/../__the_.__rainbow_       vmsify  __some_:[__where_]__the_.__rainbow_
-/__some_/__where_//__over_/./__the_.__rainbow_ vmsify  __some_:[__where_.__over_]__the_.__rainbow_
-..//../	vmspath	[--]
-./././	vmspath	[]
-./../.	vmsify	[-]
+//__some_/__where_//__over_/../__the_.__rainbow_       vmsify  __some_:[__where_]__the_.__rainbow_ __some_:[__where_.__over_.-]__the_.__rainbow_
+/__some_/__where_//__over_/./__the_.__rainbow_ vmsify  __some_:[__where_.__over_]__the_.__rainbow_ ^
+..//../	vmspath	[--] ^
+./././	vmspath	[] ^
+./../.	vmsify	[-] ^
 
 # Our override of File::Spec->canonpath can do some strange things
-__dev:[__dir.000000]__foo     File::Spec->canonpath   __dev:[__dir.000000]__foo
-__dev:[__dir.][000000]__foo   File::Spec->canonpath   __dev:[__dir]__foo
+__dev:[__dir.000000]__foo     File::Spec->canonpath   __dev:[__dir.000000]__foo ^
+__dev:[__dir.][000000]__foo   File::Spec->canonpath   __dev:[__dir]__foo ^
diff --git a/gnu/usr.bin/perl/vms/perlvms.pod b/gnu/usr.bin/perl/vms/perlvms.pod
deleted file mode 100644
index b8993d818d1..00000000000
--- a/gnu/usr.bin/perl/vms/perlvms.pod
+++ /dev/null
@@ -1,1223 +0,0 @@
-=head1 NAME
-
-perlvms - VMS-specific documentation for Perl
-
-=head1 DESCRIPTION
-
-Gathered below are notes describing details of Perl 5's 
-behavior on VMS.  They are a supplement to the regular Perl 5 
-documentation, so we have focussed on the ways in which Perl 
-5 functions differently under VMS than it does under Unix, 
-and on the interactions between Perl and the rest of the 
-operating system.  We haven't tried to duplicate complete 
-descriptions of Perl features from the main Perl 
-documentation, which can be found in the F<[.pod]> 
-subdirectory of the Perl distribution.
-
-We hope these notes will save you from confusion and lost 
-sleep when writing Perl scripts on VMS.  If you find we've 
-missed something you think should appear here, please don't 
-hesitate to drop a line to vmsperl@perl.org.
-
-=head1 Installation
-
-Directions for building and installing Perl 5 can be found in 
-the file F<README.vms> in the main source directory of the 
-Perl distribution..
-
-=head1 Organization of Perl Images
-
-=head2 Core Images
-
-During the installation process, three Perl images are produced.
-F<Miniperl.Exe> is an executable image which contains all of
-the basic functionality of Perl, but cannot take advantage of
-Perl extensions.  It is used to generate several files needed
-to build the complete Perl and various extensions.  Once you've
-finished installing Perl, you can delete this image.
-
-Most of the complete Perl resides in the shareable image
-F<PerlShr.Exe>, which provides a core to which the Perl executable
-image and all Perl extensions are linked.  You should place this
-image in F<Sys$Share>, or define the logical name F<PerlShr> to
-translate to the full file specification of this image.  It should
-be world readable.  (Remember that if a user has execute only access
-to F<PerlShr>, VMS will treat it as if it were a privileged shareable
-image, and will therefore require all downstream shareable images to be
-INSTALLed, etc.)
-
-
-Finally, F<Perl.Exe> is an executable image containing the main
-entry point for Perl, as well as some initialization code.  It
-should be placed in a public directory, and made world executable.
-In order to run Perl with command line arguments, you should
-define a foreign command to invoke this image.
-
-=head2 Perl Extensions
-
-Perl extensions are packages which provide both XS and Perl code
-to add new functionality to perl.  (XS is a meta-language which
-simplifies writing C code which interacts with Perl, see
-L<perlxs> for more details.)  The Perl code for an
-extension is treated like any other library module - it's
-made available in your script through the appropriate
-C<use> or C<require> statement, and usually defines a Perl
-package containing the extension.
-
-The portion of the extension provided by the XS code may be
-connected to the rest of Perl in either of two ways.  In the
-B<static> configuration, the object code for the extension is
-linked directly into F<PerlShr.Exe>, and is initialized whenever
-Perl is invoked.  In the B<dynamic> configuration, the extension's
-machine code is placed into a separate shareable image, which is
-mapped by Perl's DynaLoader when the extension is C<use>d or
-C<require>d in your script.  This allows you to maintain the
-extension as a separate entity, at the cost of keeping track of the
-additional shareable image.  Most extensions can be set up as either
-static or dynamic.
-
-The source code for an extension usually resides in its own
-directory.  At least three files are generally provided:
-I<Extshortname>F<.xs> (where I<Extshortname> is the portion of
-the extension's name following the last C<::>), containing
-the XS code, I<Extshortname>F<.pm>, the Perl library module
-for the extension, and F<Makefile.PL>, a Perl script which uses
-the C<MakeMaker> library modules supplied with Perl to generate
-a F<Descrip.MMS> file for the extension.
-
-=head2 Installing static extensions
-
-Since static extensions are incorporated directly into
-F<PerlShr.Exe>, you'll have to rebuild Perl to incorporate a
-new extension.  You should edit the main F<Descrip.MMS> or F<Makefile>
-you use to build Perl, adding the extension's name to the C<ext>
-macro, and the extension's object file to the C<extobj> macro.
-You'll also need to build the extension's object file, either
-by adding dependencies to the main F<Descrip.MMS>, or using a
-separate F<Descrip.MMS> for the extension.  Then, rebuild
-F<PerlShr.Exe> to incorporate the new code.
-
-Finally, you'll need to copy the extension's Perl library
-module to the F<[.>I<Extname>F<]> subdirectory under one
-of the directories in C<@INC>, where I<Extname> is the name
-of the extension, with all C<::> replaced by C<.> (e.g.
-the library module for extension Foo::Bar would be copied
-to a F<[.Foo.Bar]> subdirectory).
-
-=head2 Installing dynamic extensions
-
-In general, the distributed kit for a Perl extension includes
-a file named Makefile.PL, which is a Perl program which is used
-to create a F<Descrip.MMS> file which can be used to build and
-install the files required by the extension.  The kit should be
-unpacked into a directory tree B<not> under the main Perl source
-directory, and the procedure for building the extension is simply
-
-    $ perl Makefile.PL  ! Create Descrip.MMS
-    $ mmk               ! Build necessary files
-    $ mmk test          ! Run test code, if supplied
-    $ mmk install       ! Install into public Perl tree
-
-I<N.B.> The procedure by which extensions are built and
-tested creates several levels (at least 4) under the
-directory in which the extension's source files live.
-For this reason if you are running a version of VMS prior
-to V7.1 you shouldn't nest the source directory
-too deeply in your directory structure lest you exceed RMS'
-maximum of 8 levels of subdirectory in a filespec.  (You
-can use rooted logical names to get another 8 levels of
-nesting, if you can't place the files near the top of
-the physical directory structure.)
-
-VMS support for this process in the current release of Perl
-is sufficient to handle most extensions.  However, it does
-not yet recognize extra libraries required to build shareable
-images which are part of an extension, so these must be added
-to the linker options file for the extension by hand.  For
-instance, if the F<PGPLOT> extension to Perl requires the
-F<PGPLOTSHR.EXE> shareable image in order to properly link
-the Perl extension, then the line C<PGPLOTSHR/Share> must
-be added to the linker options file F<PGPLOT.Opt> produced
-during the build process for the Perl extension.
-
-By default, the shareable image for an extension is placed in
-the F<[.lib.site_perl.auto>I<Arch>.I<Extname>F<]> directory of the
-installed Perl directory tree (where I<Arch> is F<VMS_VAX> or
-F<VMS_AXP>, and I<Extname> is the name of the extension, with
-each C<::> translated to C<.>).  (See the MakeMaker documentation
-for more details on installation options for extensions.)
-However, it can be manually placed in any of several locations:
-
-=over 4
-
-=item *
-
-the F<[.Lib.Auto.>I<Arch>I<$PVers>I<Extname>F<]> subdirectory
-of one of the directories in C<@INC> (where I<PVers>
-is the version of Perl you're using, as supplied in C<$]>,
-with '.' converted to '_'), or
-
-=item *
-
-one of the directories in C<@INC>, or
-
-=item *
-
-a directory which the extensions Perl library module
-passes to the DynaLoader when asking it to map
-the shareable image, or
-
-=item *
-
-F<Sys$Share> or F<Sys$Library>.
-
-=back
-
-If the shareable image isn't in any of these places, you'll need
-to define a logical name I<Extshortname>, where I<Extshortname>
-is the portion of the extension's name after the last C<::>, which
-translates to the full file specification of the shareable image.
-
-=head1 File specifications
-
-=head2 Syntax
-
-We have tried to make Perl aware of both VMS-style and Unix-style file
-specifications wherever possible.  You may use either style, or both,
-on the command line and in scripts, but you may not combine the two
-styles within a single file specification.  VMS Perl interprets Unix
-pathnames in much the same way as the CRTL (I<e.g.> the first component
-of an absolute path is read as the device name for the VMS file
-specification).  There are a set of functions provided in the
-C<VMS::Filespec> package for explicit interconversion between VMS and
-Unix syntax; its documentation provides more details.
-
-We've tried to minimize the dependence of Perl library
-modules on Unix syntax, but you may find that some of these,
-as well as some scripts written for Unix systems, will
-require that you use Unix syntax, since they will assume that
-'/' is the directory separator, I<etc.>  If you find instances
-of this in the Perl distribution itself, please let us know,
-so we can try to work around them.
-
-Also when working on Perl programs on VMS, if you need a syntax
-in a specific operating system format, then you need either to
-check the appropriate DECC$ feature logical, or call a conversion
-routine to force it to that format.
-
-The feature logical name DECC$FILENAME_UNIX_REPORT modifies traditional
-Perl behavior in the conversion of file specifications from UNIX to VMS
-format in order to follow the extended character handling rules now
-expected by the CRTL.  Specifically, when this feature is in effect, the
-C<./.../> in a UNIX path is now translated to C<[.^.^.^.]> instead of
-the traditional VMS C<[...]>.  To be compatible with what MakeMaker
-expects, if a VMS path cannot be translated to a UNIX path, it is
-passed through unchanged, so C<unixify("[...]")> will return C<[...]>.
-
-The handling of extended characters is largely complete in the
-VMS-specific C infrastructure of Perl, but more work is still needed to
-fully support extended syntax filenames in several core modules.  In
-particular, at this writing PathTools has only partial support for
-directories containing some extended characters.
-
-There are several ambiguous cases where a conversion routine cannot
-determine whether an input filename is in UNIX format or in VMS format,
-since now both VMS and UNIX file specifications may have characters in
-them that could be mistaken for syntax delimiters of the other type. So
-some pathnames simply cannot be used in a mode that allows either type
-of pathname to be present.  Perl will tend to assume that an ambiguous
-filename is in UNIX format.
-
-Allowing "." as a version delimiter is simply incompatible with
-determining whether a pathname is in VMS format or in UNIX format with
-extended file syntax.  There is no way to know whether "perl-5.8.6" is a
-UNIX "perl-5.8.6" or a VMS "perl-5.8;6" when passing it to unixify() or
-vmsify().
-
-The DECC$FILENAME_UNIX_REPORT logical name controls how Perl interprets
-filenames to the extent that Perl uses the CRTL internally for many
-purposes, and attempts to follow CRTL conventions for reporting
-filenames.  The DECC$FILENAME_UNIX_ONLY feature differs in that it
-expects all filenames passed to the C run-time to be already in UNIX
-format.  This feature is not yet supported in Perl since Perl uses
-traditional OpenVMS file specifications internally and in the test
-harness, and it is not yet clear whether this mode will be useful or
-useable.  The feature logical name DECC$POSIX_COMPLIANT_PATHNAMES is new
-with the RMS Symbolic Link SDK and included with OpenVMS v8.3, but is
-not yet supported in Perl.
-
-=head2 Filename Case
-
-Perl follows VMS defaults and override settings in preserving (or not
-preserving) filename case.  Case is not preserved on ODS-2 formatted
-volumes on any architecture.  On ODS-5 volumes, filenames may be case
-preserved depending on process and feature settings.  Perl now honors
-DECC$EFS_CASE_PRESERVE and DECC$ARGV_PARSE_STYLE on those systems where
-the CRTL supports these features.  When these features are not enabled
-or the CRTL does not support them, Perl follows the traditional CRTL
-behavior of downcasing command-line arguments and returning file
-specifications in lower case only.
-
-I<N. B.>  It is very easy to get tripped up using a mixture of other
-programs, external utilities, and Perl scripts that are in varying
-states of being able to handle case preservation.  For example, a file
-created by an older version of an archive utility or a build utility
-such as MMK or MMS may generate a filename in all upper case even on an
-ODS-5 volume.  If this filename is later retrieved by a Perl script or
-module in a case preserving environment, that upper case name may not
-match the mixed-case or lower-case expections of the Perl code.  Your
-best bet is to follow an all-or-nothing approach to case preservation:
-either don't use it at all, or make sure your entire toolchain and
-application environment support and use it.
-
-OpenVMS Alpha v7.3-1 and later and all version of OpenVMS I64 support
-case sensitivity as a process setting (see C<SET PROCESS
-/CASE_LOOKUP=SENSITIVE>). Perl does not currently suppport case
-sensitivity on VMS, but it may in the future, so Perl programs should
-use the C<File::Spec->case_tolerant> method to determine the state, and
-not the C<$^O> variable.
-
-=head2 Symbolic Links
-
-When built on an ODS-5 volume with symbolic links enabled, Perl by
-default supports symbolic links when the requisite support is available
-in the filesystem and CRTL (generally 64-bit OpenVMS v8.3 and later). 
-There are a number of limitations and caveats to be aware of when
-working with symbolic links on VMS.  Most notably, the target of a valid
-symbolic link must be expressed as a UNIX-style path and it must exist
-on a volume visible from your POSIX root (see the C<SHOW ROOT> command
-in DCL help).  For further details on symbolic link capabilities and
-requirements, see chapter 12 of the CRTL manual that ships with OpenVMS
-v8.3 or later.
-
-=head2 Wildcard expansion
-
-File specifications containing wildcards are allowed both on 
-the command line and within Perl globs (e.g. C<E<lt>*.cE<gt>>).  If
-the wildcard filespec uses VMS syntax, the resultant 
-filespecs will follow VMS syntax; if a Unix-style filespec is 
-passed in, Unix-style filespecs will be returned.
-Similar to the behavior of wildcard globbing for a Unix shell,
-one can escape command line wildcards with double quotation
-marks C<"> around a perl program command line argument.  However,
-owing to the stripping of C<"> characters carried out by the C
-handling of argv you will need to escape a construct such as
-this one (in a directory containing the files F<PERL.C>, F<PERL.EXE>,
-F<PERL.H>, and F<PERL.OBJ>):
-
-    $ perl -e "print join(' ',@ARGV)" perl.*
-    perl.c perl.exe perl.h perl.obj
-
-in the following triple quoted manner:
-
-    $ perl -e "print join(' ',@ARGV)" """perl.*"""
-    perl.*
-
-In both the case of unquoted command line arguments or in calls
-to C<glob()> VMS wildcard expansion is performed. (csh-style
-wildcard expansion is available if you use C<File::Glob::glob>.)
-If the wildcard filespec contains a device or directory 
-specification, then the resultant filespecs will also contain 
-a device and directory; otherwise, device and directory 
-information are removed.  VMS-style resultant filespecs will 
-contain a full device and directory, while Unix-style 
-resultant filespecs will contain only as much of a directory 
-path as was present in the input filespec.  For example, if 
-your default directory is Perl_Root:[000000], the expansion 
-of C<[.t]*.*> will yield filespecs  like 
-"perl_root:[t]base.dir", while the expansion of C<t/*/*> will 
-yield filespecs like "t/base.dir".  (This is done to match 
-the behavior of glob expansion performed by Unix shells.) 
-
-Similarly, the resultant filespec will contain the file version
-only if one was present in the input filespec.
-
-
-=head2 Pipes
-
-Input and output pipes to Perl filehandles are supported; the 
-"file name" is passed to lib$spawn() for asynchronous 
-execution.  You should be careful to close any pipes you have 
-opened in a Perl script, lest you leave any "orphaned" 
-subprocesses around when Perl exits. 
-
-You may also use backticks to invoke a DCL subprocess, whose 
-output is used as the return value of the expression.  The 
-string between the backticks is handled as if it were the
-argument to the C<system> operator (see below).  In this case,
-Perl will wait for the subprocess to complete before continuing. 
-
-The mailbox (MBX) that perl can create to communicate with a pipe
-defaults to a buffer size of 512.  The default buffer size is
-adjustable via the logical name PERL_MBX_SIZE provided that the
-value falls between 128 and the SYSGEN parameter MAXBUF inclusive.
-For example, to double the MBX size from the default within
-a Perl program, use C<$ENV{'PERL_MBX_SIZE'} = 1024;> and then
-open and use pipe constructs.  An alternative would be to issue
-the command:
-
-    $ Define PERL_MBX_SIZE 1024
-
-before running your wide record pipe program.  A larger value may
-improve performance at the expense of the BYTLM UAF quota.
-
-=head1 PERL5LIB and PERLLIB
-
-The PERL5LIB and PERLLIB logical names work as documented in L<perl>,
-except that the element separator is '|' instead of ':'.  The
-directory specifications may use either VMS or Unix syntax.
-
-=head1 The Perl Forked Debugger
-
-The Perl forked debugger places the debugger commands and output in a
-separate X-11 terminal window so that commands and output from multiple
-processes are not mixed together.
-
-Perl on VMS supports an emulation of the forked debugger when Perl is
-run on a VMS system that has X11 support installed.
-
-To use the forked debugger, you need to have the default display set to an
-X-11 Server and some environment variables set that Unix expects.
-
-The forked debugger requires the environment variable C<TERM> to be C<xterm>,
-and the environment variable C<DISPLAY> to exist.  C<xterm> must be in
-lower case.
-
-  $define TERM "xterm"
-
-  $define DISPLAY "hostname:0.0"
-
-Currently the value of C<DISPLAY> is ignored.  It is recommended that it be set
-to be the hostname of the display, the server and screen in UNIX notation.  In
-the future the value of DISPLAY may be honored by Perl instead of using the
-default display.
-
-It may be helpful to always use the forked debugger so that script I/O is
-separated from debugger I/O.  You can force the debugger to be forked by
-assigning a value to the logical name <PERLDB_PIDS> that is not a process
-identification number.
-
-  $define PERLDB_PIDS XXXX
-
-
-=head1 PERL_VMS_EXCEPTION_DEBUG
-
-The PERL_VMS_EXCEPTION_DEBUG being defined as "ENABLE" will cause the VMS
-debugger to be invoked if a fatal exception that is not otherwise
-handled is raised.  The purpose of this is to allow debugging of
-internal Perl problems that would cause such a condition.
-
-This allows the programmer to look at the execution stack and variables to
-find out the cause of the exception.  As the debugger is being invoked as
-the Perl interpreter is about to do a fatal exit, continuing the execution
-in debug mode is usally not practical.
-
-Starting Perl in the VMS debugger may change the program execution
-profile in a way that such problems are not reproduced.
-
-The C<kill> function can be used to test this functionality from within
-a program.
-
-In typical VMS style, only the first letter of the value of this logical
-name is actually checked in a case insensitive mode, and it is considered
-enabled if it is the value "T","1" or "E".
-
-This logical name must be defined before Perl is started.
-
-=head1 Command line
-
-=head2 I/O redirection and backgrounding
-
-Perl for VMS supports redirection of input and output on the 
-command line, using a subset of Bourne shell syntax:
-
-=over 4
-
-=item *
-
-C<E<lt>file> reads stdin from C<file>,
-
-=item *
-
-C<E<gt>file> writes stdout to C<file>,
-
-=item *
-
-C<E<gt>E<gt>file> appends stdout to C<file>,
-
-=item *
-
-C<2E<gt>file> writes stderr to C<file>,
-
-=item *
-
-C<2E<gt>E<gt>file> appends stderr to C<file>, and
-
-=item *
-
-C<< 2>&1 >> redirects stderr to stdout.
-
-=back
-
-In addition, output may be piped to a subprocess, using the  
-character '|'.  Anything after this character on the command 
-line is passed to a subprocess for execution; the subprocess 
-takes the output of Perl as its input.
-
-Finally, if the command line ends with '&', the entire 
-command is run in the background as an asynchronous 
-subprocess.
-
-=head2 Command line switches
-
-The following command line switches behave differently under
-VMS than described in L<perlrun>.  Note also that in order
-to pass uppercase switches to Perl, you need to enclose
-them in double-quotes on the command line, since the CRTL
-downcases all unquoted strings.
-
-On newer 64 bit versions of OpenVMS, a process setting now
-controls if the quoting is needed to preserve the case of
-command line arguments.
-
-=over 4
-
-=item -i
-
-If the C<-i> switch is present but no extension for a backup
-copy is given, then inplace editing creates a new version of
-a file; the existing copy is not deleted.  (Note that if
-an extension is given, an existing file is renamed to the backup
-file, as is the case under other operating systems, so it does
-not remain as a previous version under the original filename.)
-
-=item -S
-
-If the C<"-S"> or C<-"S"> switch is present I<and> the script
-name does not contain a directory, then Perl translates the
-logical name DCL$PATH as a searchlist, using each translation
-as a directory in which to look for the script.  In addition,
-if no file type is specified, Perl looks in each directory
-for a file matching the name specified, with a blank type,
-a type of F<.pl>, and a type of F<.com>, in that order.
-
-=item -u
-
-The C<-u> switch causes the VMS debugger to be invoked
-after the Perl program is compiled, but before it has
-run.  It does not create a core dump file.
-
-=back
-
-=head1 Perl functions
-
-As of the time this document was last revised, the following 
-Perl functions were implemented in the VMS port of Perl 
-(functions marked with * are discussed in more detail below):
-
-    file tests*, abs, alarm, atan, backticks*, binmode*, bless,
-    caller, chdir, chmod, chown, chomp, chop, chr,
-    close, closedir, cos, crypt*, defined, delete, die, do, dump*, 
-    each, endgrent, endpwent, eof, eval, exec*, exists, exit, exp, 
-    fileno, flock  getc, getgrent*, getgrgid*, getgrnam, getlogin, getppid,
-    getpwent*, getpwnam*, getpwuid*, glob, gmtime*, goto,
-    grep, hex, ioctl, import, index, int, join, keys, kill*,
-    last, lc, lcfirst, lchown*, length, link*, local, localtime, log, lstat, m//,
-    map, mkdir, my, next, no, oct, open, opendir, ord, pack,
-    pipe, pop, pos, print, printf, push, q//, qq//, qw//,
-    qx//*, quotemeta, rand, read, readdir, readlink*, redo, ref, rename,
-    require, reset, return, reverse, rewinddir, rindex,
-    rmdir, s///, scalar, seek, seekdir, select(internal),
-    select (system call)*, setgrent, setpwent, shift, sin, sleep,
-    socketpair, sort, splice, split, sprintf, sqrt, srand, stat,
-    study, substr, symlink*, sysread, system*, syswrite, tell,
-    telldir, tie, time, times*, tr///, uc, ucfirst, umask,
-    undef, unlink*, unpack, untie, unshift, use, utime*,
-    values, vec, wait, waitpid*, wantarray, warn, write, y///
-
-The following functions were not implemented in the VMS port, 
-and calling them produces a fatal error (usually) or 
-undefined behavior (rarely, we hope):
-
-    chroot, dbmclose, dbmopen, fork*, getpgrp, getpriority,  
-    msgctl, msgget, msgsend, msgrcv, semctl,
-    semget, semop, setpgrp, setpriority, shmctl, shmget,
-    shmread, shmwrite, syscall
-
-The following functions are available on Perls compiled with Dec C
-5.2 or greater and running VMS 7.0 or greater:
-
-    truncate
-
-The following functions are available on Perls built on VMS 7.2 or
-greater:
-
-    fcntl (without locking)
-
-The following functions may or may not be implemented, 
-depending on what type of socket support you've built into 
-your copy of Perl:
-
-    accept, bind, connect, getpeername,
-    gethostbyname, getnetbyname, getprotobyname,
-    getservbyname, gethostbyaddr, getnetbyaddr,
-    getprotobynumber, getservbyport, gethostent,
-    getnetent, getprotoent, getservent, sethostent,
-    setnetent, setprotoent, setservent, endhostent,
-    endnetent, endprotoent, endservent, getsockname,
-    getsockopt, listen, recv, select(system call)*,
-    send, setsockopt, shutdown, socket
-
-The following function is available on Perls built on 64 bit OpenVMS v8.2
-with hard links enabled on an ODS-5 formatted build disk.  CRTL support
-is in principle available as of OpenVMS v7.3-1, and better configuration
-support could detect this.
-
-    link
-
-The following functions are available on Perls built on 64 bit OpenVMS
-v8.2 and later.  CRTL support is in principle available as of OpenVMS
-v7.3-2, and better configuration support could detect this.
-
-   getgrgid, getgrnam, getpwnam, getpwuid,
-   setgrent, ttyname
-
-The following functions are available on Perls built on 64 bit OpenVMS v8.2
-and later.  
-
-   statvfs, socketpair
-
-=over 4
-
-=item File tests
-
-The tests C<-b>, C<-B>, C<-c>, C<-C>, C<-d>, C<-e>, C<-f>,
-C<-o>, C<-M>, C<-s>, C<-S>, C<-t>, C<-T>, and C<-z> work as
-advertised.  The return values for C<-r>, C<-w>, and C<-x>
-tell you whether you can actually access the file; this may
-not reflect the UIC-based file protections.  Since real and
-effective UIC don't differ under VMS, C<-O>, C<-R>, C<-W>,
-and C<-X> are equivalent to C<-o>, C<-r>, C<-w>, and C<-x>.
-Similarly, several other tests, including C<-A>, C<-g>, C<-k>,
-C<-l>, C<-p>, and C<-u>, aren't particularly meaningful under
-VMS, and the values returned by these tests reflect whatever
-your CRTL C<stat()> routine does to the equivalent bits in the
-st_mode field.  Finally, C<-d> returns true if passed a device
-specification without an explicit directory (e.g. C<DUA1:>), as
-well as if passed a directory.
-
-There are DECC feature logical names AND ODS-5 volume attributes that
-also control what values are returned for the date fields.
-
-Note: Some sites have reported problems when using the file-access
-tests (C<-r>, C<-w>, and C<-x>) on files accessed via DEC's DFS.
-Specifically, since DFS does not currently provide access to the
-extended file header of files on remote volumes, attempts to
-examine the ACL fail, and the file tests will return false,
-with C<$!> indicating that the file does not exist.  You can
-use C<stat> on these files, since that checks UIC-based protection
-only, and then manually check the appropriate bits, as defined by
-your C compiler's F<stat.h>, in the mode value it returns, if you
-need an approximation of the file's protections.
-
-=item backticks
-
-Backticks create a subprocess, and pass the enclosed string
-to it for execution as a DCL command.  Since the subprocess is
-created directly via C<lib$spawn()>, any valid DCL command string
-may be specified.
-
-=item binmode FILEHANDLE
-
-The C<binmode> operator will attempt to insure that no translation
-of carriage control occurs on input from or output to this filehandle.
-Since this involves reopening the file and then restoring its
-file position indicator, if this function returns FALSE, the
-underlying filehandle may no longer point to an open file, or may
-point to a different position in the file than before C<binmode>
-was called.
-
-Note that C<binmode> is generally not necessary when using normal
-filehandles; it is provided so that you can control I/O to existing
-record-structured files when necessary.  You can also use the
-C<vmsfopen> function in the VMS::Stdio extension to gain finer
-control of I/O to files and devices with different record structures.
-
-=item crypt PLAINTEXT, USER
-
-The C<crypt> operator uses the C<sys$hash_password> system
-service to generate the hashed representation of PLAINTEXT.
-If USER is a valid username, the algorithm and salt values
-are taken from that user's UAF record.  If it is not, then
-the preferred algorithm and a salt of 0 are used.  The
-quadword encrypted value is returned as an 8-character string.
-
-The value returned by C<crypt> may be compared against
-the encrypted password from the UAF returned by the C<getpw*>
-functions, in order to authenticate users.  If you're
-going to do this, remember that the encrypted password in
-the UAF was generated using uppercase username and
-password strings; you'll have to upcase the arguments to
-C<crypt> to insure that you'll get the proper value:
-
-    sub validate_passwd {
-        my($user,$passwd) = @_;
-        my($pwdhash);
-        if ( !($pwdhash = (getpwnam($user))[1]) ||
-               $pwdhash ne crypt("\U$passwd","\U$name") ) {
-            intruder_alert($name);
-        }
-        return 1;
-    }
-
-
-=item die
-
-C<die> will force the native VMS exit status to be an SS$_ABORT code
-if neither of the $! or $? status values are ones that would cause
-the native status to be interpreted as being what VMS classifies as
-SEVERE_ERROR severity for DCL error handling.
-
-When the future POSIX_EXIT mode is active, C<die>, the native VMS exit
-status value will have either one of the C<$!> or C<$?> or C<$^E> or
-the UNIX value 255 encoded into it in a way that the effective original
-value can be decoded by other programs written in C, including Perl
-and the GNV package.  As per the normal non-VMS behavior of C<die> if
-either C<$!> or C<$?> are non-zero, one of those values will be
-encoded into a native VMS status value.  If both of the UNIX status
-values are 0, and the C<$^E> value is set one of ERROR or SEVERE_ERROR
-severity, then the C<$^E> value will be used as the exit code as is.
-If none of the above apply, the UNIX value of 255 will be encoded into
-a native VMS exit status value.
-
-Please note a significant difference in the behavior of C<die> in
-the future POSIX_EXIT mode is that it does not force a VMS
-SEVERE_ERROR status on exit.  The UNIX exit values of 2 through
-255 will be encoded in VMS status values with severity levels of
-SUCCESS.  The UNIX exit value of 1 will be encoded in a VMS status
-value with a severity level of ERROR.  This is to be compatible with
-how the VMS C library encodes these values.
-
-The minimum severity level set by C<die> in a future POSIX_EXIT mode
-may be changed to be ERROR or higher before that mode becomes fully active
-depending on the results of testing and further review.  If this is
-done, the behavior of c<DIE> in the future POSIX_EXIT will close enough
-to the default mode that most DCL shell scripts will probably not notice
-a difference.
-
-See C<$?> for a description of the encoding of the UNIX value to
-produce a native VMS status containing it.
-
-
-=item dump
-
-Rather than causing Perl to abort and dump core, the C<dump>
-operator invokes the VMS debugger.  If you continue to
-execute the Perl program under the debugger, control will
-be transferred to the label specified as the argument to
-C<dump>, or, if no label was specified, back to the
-beginning of the program.  All other state of the program
-(I<e.g.> values of variables, open file handles) are not
-affected by calling C<dump>.
-
-=item exec LIST
-
-A call to C<exec> will cause Perl to exit, and to invoke the command
-given as an argument to C<exec> via C<lib$do_command>.  If the
-argument begins with '@' or '$' (other than as part of a filespec),
-then it is executed as a DCL command.  Otherwise, the first token on
-the command line is treated as the filespec of an image to run, and
-an attempt is made to invoke it (using F<.Exe> and the process
-defaults to expand the filespec) and pass the rest of C<exec>'s
-argument to it as parameters.  If the token has no file type, and
-matches a file with null type, then an attempt is made to determine
-whether the file is an executable image which should be invoked
-using C<MCR> or a text file which should be passed to DCL as a
-command procedure.
-
-=item fork
-
-While in principle the C<fork> operator could be implemented via
-(and with the same rather severe limitations as) the CRTL C<vfork()>
-routine, and while some internal support to do just that is in
-place, the implementation has never been completed, making C<fork>
-currently unavailable.  A true kernel C<fork()> is expected in a
-future version of VMS, and the pseudo-fork based on interpreter
-threads may be available in a future version of Perl on VMS (see
-L<perlfork>).  In the meantime, use C<system>, backticks, or piped
-filehandles to create subprocesses.
-
-=item getpwent
-
-=item getpwnam
-
-=item getpwuid
-
-These operators obtain the information described in L<perlfunc>,
-if you have the privileges necessary to retrieve the named user's
-UAF information via C<sys$getuai>.  If not, then only the C<$name>,
-C<$uid>, and C<$gid> items are returned.  The C<$dir> item contains
-the login directory in VMS syntax, while the C<$comment> item
-contains the login directory in Unix syntax. The C<$gcos> item
-contains the owner field from the UAF record.  The C<$quota>
-item is not used.
-
-=item gmtime
-
-The C<gmtime> operator will function properly if you have a
-working CRTL C<gmtime()> routine, or if the logical name
-SYS$TIMEZONE_DIFFERENTIAL is defined as the number of seconds
-which must be added to UTC to yield local time.  (This logical
-name is defined automatically if you are running a version of
-VMS with built-in UTC support.)  If neither of these cases is
-true, a warning message is printed, and C<undef> is returned.
-
-=item kill
-
-In most cases, C<kill> is implemented via the undocumented system
-service <$SIGPRC>, which has the same calling sequence as <$FORCEX>, but
-throws an exception in the target process rather than forcing it to call
-C<$EXIT>.  Generally speaking, C<kill> follows the behavior of the
-CRTL's C<kill()> function, but unlike that function can be called from
-within a signal handler.  Also, unlike the C<kill> in some versions of
-the CRTL, Perl's C<kill> checks the validity of the signal passed in and
-returns an error rather than attempting to send an unrecognized signal.
-
-Also, negative signal values don't do anything special under
-VMS; they're just converted to the corresponding positive value.
-
-=item qx//
-
-See the entry on C<backticks> above.
-
-=item select (system call)
-
-If Perl was not built with socket support, the system call
-version of C<select> is not available at all.  If socket
-support is present, then the system call version of
-C<select> functions only for file descriptors attached
-to sockets.  It will not provide information about regular
-files or pipes, since the CRTL C<select()> routine does not
-provide this functionality.
-
-=item stat EXPR
-
-Since VMS keeps track of files according to a different scheme
-than Unix, it's not really possible to represent the file's ID
-in the C<st_dev> and C<st_ino> fields of a C<struct stat>.  Perl
-tries its best, though, and the values it uses are pretty unlikely
-to be the same for two different files.  We can't guarantee this,
-though, so caveat scriptor.
-
-=item system LIST
-
-The C<system> operator creates a subprocess, and passes its 
-arguments to the subprocess for execution as a DCL command.  
-Since the subprocess is created directly via C<lib$spawn()>, any 
-valid DCL command string may be specified.  If the string begins with
-'@', it is treated as a DCL command unconditionally.  Otherwise, if
-the first token contains a character used as a delimiter in file
-specification (e.g. C<:> or C<]>), an attempt is made to expand it
-using  a default type of F<.Exe> and the process defaults, and if
-successful, the resulting file is invoked via C<MCR>. This allows you
-to invoke an image directly simply by passing the file specification
-to C<system>, a common Unixish idiom.  If the token has no file type,
-and matches a file with null type, then an attempt is made to
-determine whether the file is an executable image which should be
-invoked using C<MCR> or a text file which should be passed to DCL
-as a command procedure.
-
-If LIST consists of the empty string, C<system> spawns an
-interactive DCL subprocess, in the same fashion as typing
-B<SPAWN> at the DCL prompt.
-
-Perl waits for the subprocess to complete before continuing
-execution in the current process.  As described in L<perlfunc>,
-the return value of C<system> is a fake "status" which follows
-POSIX semantics unless the pragma C<use vmsish 'status'> is in
-effect; see the description of C<$?> in this document for more 
-detail.  
-
-=item time
-
-The value returned by C<time> is the offset in seconds from
-01-JAN-1970 00:00:00 (just like the CRTL's times() routine), in order
-to make life easier for code coming in from the POSIX/Unix world.
-
-=item times
-
-The array returned by the C<times> operator is divided up 
-according to the same rules the CRTL C<times()> routine.  
-Therefore, the "system time" elements will always be 0, since 
-there is no difference between "user time" and "system" time 
-under VMS, and the time accumulated by a subprocess may or may 
-not appear separately in the "child time" field, depending on 
-whether L<times> keeps track of subprocesses separately.  Note
-especially that the VAXCRTL (at least) keeps track only of
-subprocesses spawned using L<fork> and L<exec>; it will not
-accumulate the times of subprocesses spawned via pipes, L<system>,
-or backticks.
-
-=item unlink LIST
-
-C<unlink> will delete the highest version of a file only; in
-order to delete all versions, you need to say
-
-    1 while unlink LIST;
-
-You may need to make this change to scripts written for a
-Unix system which expect that after a call to C<unlink>,
-no files with the names passed to C<unlink> will exist.
-(Note: This can be changed at compile time; if you
-C<use Config> and C<$Config{'d_unlink_all_versions'}> is
-C<define>, then C<unlink> will delete all versions of a
-file on the first call.)
-
-C<unlink> will delete a file if at all possible, even if it
-requires changing file protection (though it won't try to
-change the protection of the parent directory).  You can tell
-whether you've got explicit delete access to a file by using the
-C<VMS::Filespec::candelete> operator.  For instance, in order
-to delete only files to which you have delete access, you could
-say something like
-
-    sub safe_unlink {
-        my($file,$num);
-        foreach $file (@_) {
-            next unless VMS::Filespec::candelete($file);
-            $num += unlink $file;
-        }
-        $num;
-    }
-
-(or you could just use C<VMS::Stdio::remove>, if you've installed
-the VMS::Stdio extension distributed with Perl). If C<unlink> has to
-change the file protection to delete the file, and you interrupt it
-in midstream, the file may be left intact, but with a changed ACL
-allowing you delete access.
-
-This behavior of C<unlink> is to be compatible with POSIX behavior
-and not traditional VMS behavior.
-
-=item utime LIST
-
-This operator changes only the modification time of the file (VMS 
-revision date) on ODS-2 volumes and ODS-5 volumes without access 
-dates enabled. On ODS-5 volumes with access dates enabled, the 
-true access time is modified.
-
-=item waitpid PID,FLAGS
-
-If PID is a subprocess started by a piped C<open()> (see L<open>), 
-C<waitpid> will wait for that subprocess, and return its final status
-value in C<$?>.  If PID is a subprocess created in some other way (e.g.
-SPAWNed before Perl was invoked), C<waitpid> will simply check once per
-second whether the process has completed, and return when it has.  (If
-PID specifies a process that isn't a subprocess of the current process,
-and you invoked Perl with the C<-w> switch, a warning will be issued.)
-
-Returns PID on success, -1 on error.  The FLAGS argument is ignored
-in all cases.
-
-=back
-
-=head1 Perl variables
-
-The following VMS-specific information applies to the indicated
-"special" Perl variables, in addition to the general information
-in L<perlvar>.  Where there is a conflict, this information
-takes precedence.
-
-=over 4
-
-=item %ENV 
-
-The operation of the C<%ENV> array depends on the translation
-of the logical name F<PERL_ENV_TABLES>.  If defined, it should
-be a search list, each element of which specifies a location
-for C<%ENV> elements.  If you tell Perl to read or set the
-element C<$ENV{>I<name>C<}>, then Perl uses the translations of
-F<PERL_ENV_TABLES> as follows:
-
-=over 4
-
-=item CRTL_ENV
-
-This string tells Perl to consult the CRTL's internal C<environ>
-array of key-value pairs, using I<name> as the key.  In most cases,
-this contains only a few keys, but if Perl was invoked via the C
-C<exec[lv]e()> function, as is the case for CGI processing by some
-HTTP servers, then the C<environ> array may have been populated by
-the calling program.
-
-=item CLISYM_[LOCAL]
-
-A string beginning with C<CLISYM_>tells Perl to consult the CLI's
-symbol tables, using I<name> as the name of the symbol.  When reading
-an element of C<%ENV>, the local symbol table is scanned first, followed
-by the global symbol table..  The characters following C<CLISYM_> are
-significant when an element of C<%ENV> is set or deleted: if the
-complete string is C<CLISYM_LOCAL>, the change is made in the local
-symbol table; otherwise the global symbol table is changed.
-
-=item Any other string
-
-If an element of F<PERL_ENV_TABLES> translates to any other string,
-that string is used as the name of a logical name table, which is
-consulted using I<name> as the logical name.  The normal search
-order of access modes is used.
-
-=back
-
-F<PERL_ENV_TABLES> is translated once when Perl starts up; any changes
-you make while Perl is running do not affect the behavior of C<%ENV>.
-If F<PERL_ENV_TABLES> is not defined, then Perl defaults to consulting
-first the logical name tables specified by F<LNM$FILE_DEV>, and then
-the CRTL C<environ> array.
-
-In all operations on %ENV, the key string is treated as if it 
-were entirely uppercase, regardless of the case actually 
-specified in the Perl expression.
-
-When an element of C<%ENV> is read, the locations to which
-F<PERL_ENV_TABLES> points are checked in order, and the value
-obtained from the first successful lookup is returned.  If the
-name of the C<%ENV> element contains a semi-colon, it and
-any characters after it are removed.  These are ignored when
-the CRTL C<environ> array or a CLI symbol table is consulted.
-However, the name is looked up in a logical name table, the
-suffix after the semi-colon is treated as the translation index
-to be used for the lookup.   This lets you look up successive values
-for search list logical names.  For instance, if you say
-
-   $  Define STORY  once,upon,a,time,there,was
-   $  perl -e "for ($i = 0; $i <= 6; $i++) " -
-   _$ -e "{ print $ENV{'story;'.$i},' '}"
-
-Perl will print C<ONCE UPON A TIME THERE WAS>, assuming, of course,
-that F<PERL_ENV_TABLES> is set up so that the logical name C<story>
-is found, rather than a CLI symbol or CRTL C<environ> element with
-the same name.
-
-When an element of C<%ENV> is set to a defined string, the
-corresponding definition is made in the location to which the
-first translation of F<PERL_ENV_TABLES> points.  If this causes a
-logical name to be created, it is defined in supervisor mode.
-(The same is done if an existing logical name was defined in
-executive or kernel mode; an existing user or supervisor mode
-logical name is reset to the new value.)  If the value is an empty
-string, the logical name's translation is defined as a single NUL
-(ASCII 00) character, since a logical name cannot translate to a
-zero-length string.  (This restriction does not apply to CLI symbols
-or CRTL C<environ> values; they are set to the empty string.)
-An element of the CRTL C<environ> array can be set only if your
-copy of Perl knows about the CRTL's C<setenv()> function.  (This is
-present only in some versions of the DECCRTL; check C<$Config{d_setenv}>
-to see whether your copy of Perl was built with a CRTL that has this
-function.)
-
-When an element of C<%ENV> is set to C<undef>,
-the element is looked up as if it were being read, and if it is
-found, it is deleted.  (An item "deleted" from the CRTL C<environ>
-array is set to the empty string; this can only be done if your
-copy of Perl knows about the CRTL C<setenv()> function.)  Using
-C<delete> to remove an element from C<%ENV> has a similar effect,
-but after the element is deleted, another attempt is made to
-look up the element, so an inner-mode logical name or a name in
-another location will replace the logical name just deleted.
-In either case, only the first value found searching PERL_ENV_TABLES
-is altered.  It is not possible at present to define a search list
-logical name via %ENV.
-
-The element C<$ENV{DEFAULT}> is special: when read, it returns
-Perl's current default device and directory, and when set, it
-resets them, regardless of the definition of F<PERL_ENV_TABLES>.
-It cannot be cleared or deleted; attempts to do so are silently
-ignored.
-
-Note that if you want to pass on any elements of the
-C-local environ array to a subprocess which isn't
-started by fork/exec, or isn't running a C program, you
-can "promote" them to logical names in the current
-process, which will then be inherited by all subprocesses,
-by saying
-
-    foreach my $key (qw[C-local keys you want promoted]) {
-        my $temp = $ENV{$key}; # read from C-local array
-        $ENV{$key} = $temp;    # and define as logical name
-    }
-
-(You can't just say C<$ENV{$key} = $ENV{$key}>, since the
-Perl optimizer is smart enough to elide the expression.)
-
-Don't try to clear C<%ENV> by saying C<%ENV = ();>, it will throw
-a fatal error.  This is equivalent to doing the following from DCL:
-
-    DELETE/LOGICAL *
-
-You can imagine how bad things would be if, for example, the SYS$MANAGER
-or SYS$SYSTEM logical names were deleted.
-
-At present, the first time you iterate over %ENV using
-C<keys>, or C<values>,  you will incur a time penalty as all
-logical names are read, in order to fully populate %ENV.
-Subsequent iterations will not reread logical names, so they
-won't be as slow, but they also won't reflect any changes
-to logical name tables caused by other programs.
-
-You do need to be careful with the logical names representing
-process-permanent files, such as C<SYS$INPUT> and C<SYS$OUTPUT>.
-The translations for these logical names are prepended with a
-two-byte binary value (0x1B 0x00) that needs to be stripped off
-if you wantto use it. (In previous versions of Perl it wasn't
-possible to get the values of these logical names, as the null
-byte acted as an end-of-string marker)
-
-=item $!
-
-The string value of C<$!> is that returned by the CRTL's
-strerror() function, so it will include the VMS message for
-VMS-specific errors.  The numeric value of C<$!> is the
-value of C<errno>, except if errno is EVMSERR, in which
-case C<$!> contains the value of vaxc$errno.  Setting C<$!>
-always sets errno to the value specified.  If this value is
-EVMSERR, it also sets vaxc$errno to 4 (NONAME-F-NOMSG), so
-that the string value of C<$!> won't reflect the VMS error
-message from before C<$!> was set.
-
-=item $^E
-
-This variable provides direct access to VMS status values
-in vaxc$errno, which are often more specific than the
-generic Unix-style error messages in C<$!>.  Its numeric value
-is the value of vaxc$errno, and its string value is the
-corresponding VMS message string, as retrieved by sys$getmsg().
-Setting C<$^E> sets vaxc$errno to the value specified.
-
-While Perl attempts to keep the vaxc$errno value to be current, if
-errno is not EVMSERR, it may not be from the current operation.
-
-=item $?
-
-The "status value" returned in C<$?> is synthesized from the
-actual exit status of the subprocess in a way that approximates
-POSIX wait(5) semantics, in order to allow Perl programs to
-portably test for successful completion of subprocesses.  The
-low order 8 bits of C<$?> are always 0 under VMS, since the
-termination status of a process may or may not have been
-generated by an exception.
-
-The next 8 bits contain the termination status of the program.
-
-If the child process follows the convention of C programs
-compiled with the _POSIX_EXIT macro set, the status value will
-contain the actual value of 0 to 255 returned by that program
-on a normal exit.
-
-With the _POSIX_EXIT macro set, the UNIX exit value of zero is
-represented as a VMS native status of 1, and the UNIX values
-from 2 to 255 are encoded by the equation:
-
-   VMS_status = 0x35a000 + (unix_value * 8) + 1.
-
-And in the special case of unix value 1 the encoding is:
-
-   VMS_status = 0x35a000 + 8 + 2 + 0x10000000.
-
-For other termination statuses, the severity portion of the
-subprocess' exit status is used: if the severity was success or
-informational, these bits are all 0; if the severity was
-warning, they contain a value of 1; if the severity was
-error or fatal error, they contain the actual severity bits,
-which turns out to be a value of 2 for error and 4 for severe_error.
-Fatal is another term for the severe_error status.
-
-As a result, C<$?> will always be zero if the subprocess' exit
-status indicated successful completion, and non-zero if a
-warning or error occurred or a program compliant with encoding
-_POSIX_EXIT values was run and set a status.
-
-How can you tell the difference between a non-zero status that is
-the result of a VMS native error status or an encoded UNIX status?
-You can not unless you look at the ${^CHILD_ERROR_NATIVE} value.
-The ${^CHILD_ERROR_NATIVE} value returns the actual VMS status value
-and check the severity bits. If the severity bits are equal to 1,
-then if the numeric value for C<$?> is between 2 and 255 or 0, then
-C<$?> accurately reflects a value passed back from a UNIX application.
-If C<$?> is 1, and the severity bits indicate a VMS error (2), then
-C<$?> is from a UNIX application exit value.
-
-In practice, Perl scripts that call programs that return _POSIX_EXIT
-type status values will be expecting those values, and programs that
-call traditional VMS programs will either be expecting the previous
-behavior or just checking for a non-zero status.
-
-And success is always the value 0 in all behaviors.
-
-When the actual VMS termination status of the child is an error,
-internally the C<$!> value will be set to the closest UNIX errno
-value to that error so that Perl scripts that test for error
-messages will see the expected UNIX style error message instead
-of a VMS message.
-
-Conversely, when setting C<$?> in an END block, an attempt is made
-to convert the POSIX value into a native status intelligible to
-the operating system upon exiting Perl.  What this boils down to
-is that setting C<$?> to zero results in the generic success value
-SS$_NORMAL, and setting C<$?> to a non-zero value results in the
-generic failure status SS$_ABORT.  See also L<perlport/exit>.
-
-With the future POSIX_EXIT mode set, setting C<$?> will cause the
-new value to also be encoded into C<$^E> so that the either the
-original parent or child exit status values of 0 to 255
-can be automatically recovered by C programs expecting _POSIX_EXIT
-behavior.  If both a parent and a child exit value are non-zero, then it
-will be assumed that this is actually a VMS native status value to
-be passed through.  The special value of 0xFFFF is almost a NOOP as
-it will cause the current native VMS status in the C library to
-become the current native Perl VMS status, and is handled this way
-as consequence of it known to not be a valid native VMS status value.
-It is recommend that only values in range of normal UNIX parent or
-child status numbers, 0 to 255 are used.
-
-The pragma C<use vmsish 'status'> makes C<$?> reflect the actual 
-VMS exit status instead of the default emulation of POSIX status 
-described above.  This pragma also disables the conversion of
-non-zero values to SS$_ABORT when setting C<$?> in an END
-block (but zero will still be converted to SS$_NORMAL).
-
-Do not use the pragma C<use vmsish 'status'> with the future
-POSIX_EXIT mode, as they are at times requesting conflicting
-actions and the consequence of ignoring this advice will be
-undefined to allow future improvements in the POSIX exit handling.
-
-=item $|
-
-Setting C<$|> for an I/O stream causes data to be flushed
-all the way to disk on each write (I<i.e.> not just to
-the underlying RMS buffers for a file).  In other words,
-it's equivalent to calling fflush() and fsync() from C.
-
-=back
-
-=head1 Standard modules with VMS-specific differences
-
-=head2 SDBM_File
-
-SDBM_File works properly on VMS. It has, however, one minor
-difference. The database directory file created has a F<.sdbm_dir>
-extension rather than a F<.dir> extension. F<.dir> files are VMS filesystem
-directory files, and using them for other purposes could cause unacceptable
-problems.
-
-=head1 Revision date
-
-This document was last updated on 3-Dec-2007, for Perl 5,
-patchlevel 10.
-
-=head1 AUTHOR
-
-Charles Bailey  bailey@cor.newman.upenn.edu
-Craig Berry  craigberry@mac.com
-Dan Sugalski  dan@sidhe.org
-John Malmberg wb8tyw@qsl.net
diff --git a/gnu/usr.bin/perl/vms/vms.c b/gnu/usr.bin/perl/vms/vms.c
index a579d37ff41..a3151de7168 100644
--- a/gnu/usr.bin/perl/vms/vms.c
+++ b/gnu/usr.bin/perl/vms/vms.c
@@ -12,14 +12,15 @@
  */
 
 /*
- *               Yet small as was their hunted band
- *               still fell and fearless was each hand,
- *               and strong deeds they wrought yet oft,
- *               and loved the woods, whose ways more soft
- *               them seemed than thralls of that black throne
- *               to live and languish in halls of stone.
+ *   Yet small as was their hunted band
+ *   still fell and fearless was each hand,
+ *   and strong deeds they wrought yet oft,
+ *   and loved the woods, whose ways more soft
+ *   them seemed than thralls of that black throne
+ *   to live and languish in halls of stone.
+ *        "The Lay of Leithian", Canto II, lines 135-40
  *
- *                           The Lay of Leithian, 135-40
+ *     [p.162 of _The Lays of Beleriand_]
  */
  
 #include <acedef.h>
@@ -218,6 +219,17 @@ return 0;
 #  define RTL_USES_UTC 1
 #endif
 
+#if !defined(__VAX) && __CRTL_VER >= 80200000
+#ifdef lstat
+#undef lstat
+#endif
+#else
+#ifdef lstat
+#undef lstat
+#endif
+#define lstat(_x, _y) stat(_x, _y)
+#endif
+
 /* Routine to create a decterm for use with the Perl debugger */
 /* No headers, this information was found in the Programming Concepts Manual */
 
@@ -295,6 +307,16 @@ static char *mp_do_tounixpath(pTHX_ const char *path, char *buf, int ts, int *);
 static char *mp_do_tounixspec(pTHX_ const char *, char *, int, int *);
 static char *mp_do_pathify_dirspec(pTHX_ const char *dir,char *buf, int ts, int *);
 
+static char *  int_rmsexpand_vms(
+    const char * filespec, char * outbuf, unsigned opts);
+static char * int_rmsexpand_tovms(
+    const char * filespec, char * outbuf, unsigned opts);
+static char *int_tovmsspec
+   (const char *path, char *buf, int dir_flag, int * utf8_flag);
+static char * int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl);
+static char * int_tounixspec(const char *spec, char *buf, int * utf8_fl);
+static char * int_tovmspath(const char *path, char *buf, int * utf8_fl);
+
 /* see system service docs for $TRNLNM -- NOT the same as LNM$_MAX_INDEX */
 #define PERL_LNM_MAX_ALLOWED_INDEX 127
 
@@ -343,6 +365,7 @@ static int decc_disable_to_vms_logname_translation = 1;
 static int decc_disable_posix_root = 1;
 int decc_efs_case_preserve = 0;
 static int decc_efs_charset = 0;
+static int decc_efs_charset_index = -1;
 static int decc_filename_unix_no_version = 0;
 static int decc_filename_unix_only = 0;
 int decc_filename_unix_report = 0;
@@ -352,14 +375,48 @@ static int vms_process_case_tolerant = 1;
 int vms_vtf7_filenames = 0;
 int gnv_unix_shell = 0;
 static int vms_unlink_all_versions = 0;
+static int vms_posix_exit = 0;
 
 /* bug workarounds if needed */
-int decc_bug_readdir_efs1 = 0;
 int decc_bug_devnull = 1;
-int decc_bug_fgetname = 0;
 int decc_dir_barename = 0;
+int vms_bug_stat_filename = 0;
 
 static int vms_debug_on_exception = 0;
+static int vms_debug_fileify = 0;
+
+/* Simple logical name translation */
+static int simple_trnlnm
+   (const char * logname,
+    char * value,
+    int value_len)
+{
+    const $DESCRIPTOR(table_dsc, "LNM$FILE_DEV");
+    const unsigned long attr = LNM$M_CASE_BLIND;
+    struct dsc$descriptor_s name_dsc;
+    int status;
+    unsigned short result;
+    struct itmlst_3 itlst[2] = {{value_len, LNM$_STRING, value, &result},
+                                {0, 0, 0, 0}};
+
+    name_dsc.dsc$w_length = strlen(logname);
+    name_dsc.dsc$a_pointer = (char *)logname;
+    name_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
+    name_dsc.dsc$b_class = DSC$K_CLASS_S;
+
+    status = sys$trnlnm(&attr, &table_dsc, &name_dsc, 0, itlst);
+
+    if ($VMS_STATUS_SUCCESS(status)) {
+
+	 /* Null terminate and return the string */
+	/*--------------------------------------*/
+	value[result] = 0;
+        return result;
+    }
+
+    return 0;
+}
+
 
 /* Is this a UNIX file specification?
  *   No longer a simple check with EFS file specs
@@ -594,10 +651,11 @@ int utf8_flag;
     case ']':
     case '%':
     case '^':
+    case '\\':
         /* Don't escape again if following character is 
          * already something we escape.
          */
-        if (strchr(".~!#&\'`()+@{},;[]%^=_", *(inspec+1))) {
+        if (strchr(".~!#&\'`()+@{},;[]%^=_\\", *(inspec+1))) {
 	    *outspec = *inspec;
 	    *output_cnt = 1;
 	    return 1;
@@ -885,6 +943,37 @@ const int verspec = 7;
     return ret_stat;
 }
 
+/* Routine to determine if the file specification ends with .dir */
+static int is_dir_ext(char * e_spec, int e_len, char * vs_spec, int vs_len) {
+
+    /* e_len must be 4, and version must be <= 2 characters */
+    if (e_len != 4 || vs_len > 2)
+        return 0;
+
+    /* If a version number is present, it needs to be one */
+    if ((vs_len == 2) && (vs_spec[1] != '1'))
+        return 0;
+
+    /* Look for the DIR on the extension */
+    if (vms_process_case_tolerant) {
+        if ((toupper(e_spec[1]) == 'D') &&
+            (toupper(e_spec[2]) == 'I') &&
+            (toupper(e_spec[3]) == 'R')) {
+            return 1;
+        }
+    } else {
+        /* Directory extensions are supposed to be in upper case only */
+        /* I would not be surprised if this rule can not be enforced */
+        /* if and when someone fully debugs the case sensitive mode */
+        if ((e_spec[1] == 'D') &&
+            (e_spec[2] == 'I') &&
+            (e_spec[3] == 'R')) {
+            return 1;
+        }
+    }
+    return 0;
+}
+
 
 /* my_maxidx
  * Routine to retrieve the maximum equivalence index for an input
@@ -966,7 +1055,13 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
           int i;
           if (!environ) {
             ivenv = 1; 
-            Perl_warn(aTHX_ "Can't read CRTL environ\n");
+#if defined(PERL_IMPLICIT_CONTEXT)
+            if (aTHX == NULL) {
+                fprintf(stderr,
+                    "Can't read CRTL environ\n");
+            } else
+#endif
+                Perl_warn(aTHX_ "Can't read CRTL environ\n");
             continue;
           }
           retsts = SS$_NOLOGNAM;
@@ -990,7 +1085,7 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
           unsigned short int deflen = LNM$C_NAMLENGTH;
           struct dsc$descriptor_d eqvdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
           /* dynamic dsc to accomodate possible long value */
-          _ckvmssts(lib$sget1_dd(&deflen,&eqvdsc));
+          _ckvmssts_noperl(lib$sget1_dd(&deflen,&eqvdsc));
           retsts = lib$get_symbol(&lnmdsc,&eqvdsc,&eqvlen,0);
           if (retsts & 1) { 
             if (eqvlen > MAX_DCL_SYMBOL) {
@@ -1000,13 +1095,19 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
 	      /* fully initialized, in which case either thr or PL_curcop */
 	      /* might be bogus. We have to check, since ckWARN needs them */
 	      /* both to be valid if running threaded */
+#if defined(PERL_IMPLICIT_CONTEXT)
+              if (aTHX == NULL) {
+                  fprintf(stderr,
+                     "Value of CLI symbol \"%s\" too long",lnm);
+              } else
+#endif
 		if (ckWARN(WARN_MISC)) {
 		  Perl_warner(aTHX_ packWARN(WARN_MISC),"Value of CLI symbol \"%s\" too long",lnm);
 		}
             }
             strncpy(eqv,eqvdsc.dsc$a_pointer,eqvlen);
           }
-          _ckvmssts(lib$sfree1_dd(&eqvdsc));
+          _ckvmssts_noperl(lib$sfree1_dd(&eqvdsc));
           if (retsts == LIB$_INVSYMNAM) { ivsym = 1; continue; }
           if (retsts == LIB$_NOSUCHSYM) continue;
           break;
@@ -1056,7 +1157,7 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
              retsts == SS$_NOLOGNAM) {
       set_errno(EINVAL);  set_vaxc_errno(retsts);
     }
-    else _ckvmssts(retsts);
+    else _ckvmssts_noperl(retsts);
     return 0;
 }  /* end of vmstrnenv */
 /*}}}*/
@@ -1065,13 +1166,17 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
 /* Define as a function so we can access statics. */
 int Perl_my_trnlnm(pTHX_ const char *lnm, char *eqv, unsigned long int idx)
 {
-  return vmstrnenv(lnm,eqv,idx,fildev,                                   
+    int flags = 0;
+
+#if defined(PERL_IMPLICIT_CONTEXT)
+    if (aTHX != NULL)
+#endif
 #ifdef SECURE_INTERNAL_GETENV
-                   (PL_curinterp ? PL_tainting : will_taint) ? PERL__TRNENV_SECURE : 0
-#else
-                   0
+        flags = (PL_curinterp ? PL_tainting : will_taint) ?
+                 PERL__TRNENV_SECURE : 0;
 #endif
-                                                                              );
+
+    return vmstrnenv(lnm, eqv, idx, fildev, flags);
 }
 /*}}}*/
 
@@ -1178,7 +1283,7 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys)
        * for an optional name, and this "error" often shows up as the
        * (bogus) exit status for a die() call later on.  */
       if (sys && vaxc$errno == SS$_NOLOGNAM) SETERRNO(saverr,savvmserr);
-      return success ? eqv : Nullch;
+      return success ? eqv : NULL;
     }
 
 }  /* end of my_getenv() */
@@ -1284,13 +1389,13 @@ Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys)
        * for an optional name, and this "error" often shows up as the
        * (bogus) exit status for a die() call later on.  */
       if (sys && vaxc$errno == SS$_NOLOGNAM) SETERRNO(saverr,savvmserr);
-      return *len ? buf : Nullch;
+      return *len ? buf : NULL;
     }
 
 }  /* end of my_getenv_len() */
 /*}}}*/
 
-static void create_mbx(pTHX_ unsigned short int *, struct dsc$descriptor_s *);
+static void create_mbx(unsigned short int *, struct dsc$descriptor_s *);
 
 static void riseandshine(unsigned long int dummy) { sys$wake(0,0); }
 
@@ -1304,7 +1409,7 @@ prime_env_iter(void)
   static int primed = 0;
   HV *seenhv = NULL, *envhv;
   SV *sv = NULL;
-  char cmd[LNM$C_NAMLENGTH+24], mbxnam[LNM$C_NAMLENGTH], *buf = Nullch;
+  char cmd[LNM$C_NAMLENGTH+24], mbxnam[LNM$C_NAMLENGTH], *buf = NULL;
   unsigned short int chan;
 #ifndef CLI$M_TRUSTED
 #  define CLI$M_TRUSTED 0x40  /* Missing from VAXC headers */
@@ -1334,6 +1439,12 @@ prime_env_iter(void)
     if (PL_curinterp) {
       aTHX = PERL_GET_INTERP;
     } else {
+      /* we never get here because the NULL pointer will cause the */
+      /* several of the routines called by this routine to access violate */
+
+      /* This routine is only called by hv.c/hv_iterinit which has a */
+      /* context, so the real fix may be to pass it through instead of */
+      /* the hoops above */
       aTHX = NULL;
     }
 #endif
@@ -1718,6 +1829,11 @@ Perl_my_setenv(pTHX_ const char *lnm, const char *eqv)
 /*  vmssetuserlnm
  *  sets a user-mode logical in the process logical name table
  *  used for redirection of sys$error
+ *
+ *  Fix-me: The pTHX is not needed for this routine, however doio.c
+ *          is calling it with one instead of using a macro.
+ *          A macro needs to be added to vmsish.h and doio.c updated to use it.
+ *
  */
 void
 Perl_vmssetuserlnm(pTHX_ const char *name, const char *eqv)
@@ -1866,15 +1982,9 @@ mp_do_kill_file(pTHX_ const char *name, int dirflag)
      * system services won't do this by themselves, so we may miss
      * a file "hiding" behind a logical name or search list. */
     vmsname = PerlMem_malloc(NAM$C_MAXRSS+1);
-    if (vmsname == NULL) _ckvmssts(SS$_INSFMEM);
+    if (vmsname == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 
-    rslt = do_rmsexpand(name,
-			vmsname,
-			0,
-			NULL,
-			PERL_RMSEXPAND_M_VMS | PERL_RMSEXPAND_M_SYMLINK,
-			NULL,
-			NULL);
+    rslt = int_rmsexpand_tovms(name, vmsname, PERL_RMSEXPAND_M_SYMLINK);
     if (rslt == NULL) {
         PerlMem_free(vmsname);
 	return -1;
@@ -1900,7 +2010,7 @@ mp_do_kill_file(pTHX_ const char *name, int dirflag)
      * and the insert an ACE at the head of the ACL which allows us
      * to delete the file.
      */
-    _ckvmssts(lib$getjpi(&jpicode,0,0,&(oldace.myace$l_ident),0,0));
+    _ckvmssts_noperl(lib$getjpi(&jpicode,0,0,&(oldace.myace$l_ident),0,0));
     fildsc.dsc$w_length = strlen(vmsname);
     fildsc.dsc$a_pointer = vmsname;
     cxt = 0;
@@ -1919,7 +2029,7 @@ mp_do_kill_file(pTHX_ const char *name, int dirflag)
         case RMS$_PRV:
           set_errno(EACCES); break;
         default:
-          _ckvmssts(aclsts);
+          _ckvmssts_noperl(aclsts);
       }
       set_vaxc_errno(aclsts);
       PerlMem_free(vmsname);
@@ -1979,23 +2089,48 @@ Perl_do_rmdir(pTHX_ const char *name)
     int retval;
     Stat_t st;
 
-    dirfile = PerlMem_malloc(VMS_MAXRSS + 1);
-    if (dirfile == NULL)
-	_ckvmssts(SS$_INSFMEM);
+    /* lstat returns a VMS fileified specification of the name */
+    /* that is looked up, and also lets verifies that this is a directory */
 
-    /* Force to a directory specification */
-    if (do_fileify_dirspec(name, dirfile, 0, NULL) == NULL) {
-	PerlMem_free(dirfile);
-	return -1;
+    retval = flex_lstat(name, &st);
+    if (retval != 0) {
+        char * ret_spec;
+
+        /* Due to a historical feature, flex_stat/lstat can not see some */
+        /* Unix format file names that the rest of the CRTL can see */
+        /* Fixing that feature will cause some perl tests to fail */
+        /* So try this one more time. */
+
+        retval = lstat(name, &st.crtl_stat);
+        if (retval != 0)
+            return -1;
+
+        /* force it to a file spec for the kill file to work. */
+        ret_spec = do_fileify_dirspec(name, st.st_devnam, 0, NULL);
+        if (ret_spec == NULL) {
+            errno = EIO;
+            return -1;
+        }
     }
-    if (Perl_flex_lstat(aTHX_ dirfile, &st) || !S_ISDIR(st.st_mode)) {
+
+    if (!S_ISDIR(st.st_mode)) {
 	errno = ENOTDIR;
 	retval = -1;
     }
-    else
+    else {
+        dirfile = st.st_devnam;
+
+        /* It may be possible for flex_stat to find a file and vmsify() to */
+        /* fail with ODS-2 specifications.  mp_do_kill_file can not deal */
+        /* with that case, so fail it */
+        if (dirfile[0] == 0) {
+            errno = EIO;
+            return -1;
+        }
+
 	retval = mp_do_kill_file(aTHX_ dirfile, 1);
+    }
 
-    PerlMem_free(dirfile);
     return retval;
 
 }  /* end of do_rmdir */
@@ -2013,21 +2148,66 @@ Perl_do_rmdir(pTHX_ const char *name)
 int
 Perl_kill_file(pTHX_ const char *name)
 {
-    char rspec[NAM$C_MAXRSS+1];
-    char *tspec;
+    char * vmsfile;
     Stat_t st;
     int rmsts;
 
-   /* Remove() is allowed to delete directories, according to the X/Open
-    * specifications.
-    * This may need special handling to work with the ACL hacks.
+    /* Convert the filename to VMS format and see if it is a directory */
+    /* flex_lstat returns a vmsified file specification */
+    rmsts = flex_lstat(name, &st);
+    if (rmsts != 0) {
+
+        /* Due to a historical feature, flex_stat/lstat can not see some */
+        /* Unix format file names that the rest of the CRTL can see when */
+        /* ODS-2 file specifications are in use. */
+        /* Fixing that feature will cause some perl tests to fail */
+        /* [.lib.ExtUtils.t]Manifest.t is one of them */
+        st.st_mode = 0;
+        vmsfile = (char *) name; /* cast ok */
+
+    } else {
+        vmsfile = st.st_devnam;
+        if (vmsfile[0] == 0) {
+            /* It may be possible for flex_stat to find a file and vmsify() */
+            /* to fail with ODS-2 specifications.  mp_do_kill_file can not */
+            /* deal with that case, so fail it */
+            errno = EIO;
+            return -1;
+        }
+    }
+
+    /* Remove() is allowed to delete directories, according to the X/Open
+     * specifications.
+     * This may need special handling to work with the ACL hacks.
      */
-   if ((flex_lstat(name, &st) == 0) && S_ISDIR(st.st_mode)) {
-	rmsts = Perl_do_rmdir(aTHX_ name);
-	return rmsts;
+    if (S_ISDIR(st.st_mode)) {
+        rmsts = mp_do_kill_file(aTHX_ vmsfile, 1);
+        return rmsts;
     }
 
-   rmsts = mp_do_kill_file(aTHX_ name, 0);
+    rmsts = mp_do_kill_file(aTHX_ vmsfile, 0);
+
+    /* Need to delete all versions ? */
+    if ((rmsts == 0) && (vms_unlink_all_versions == 1)) {
+        int i = 0;
+
+        /* Just use lstat() here as do not need st_dev */
+        /* and we know that the file is in VMS format or that */
+        /* because of a historical bug, flex_stat can not see the file */
+        while (lstat(vmsfile, (stat_t *)&st) == 0) {
+            rmsts = mp_do_kill_file(aTHX_ vmsfile, 0);
+            if (rmsts != 0)
+                break;
+            i++;
+
+            /* Make sure that we do not loop forever */
+            if (i > 32767) {
+                errno = EIO;
+                rmsts = -1;
+                break;
+            }
+        }
+    }
 
     return rmsts;
 
@@ -2083,13 +2263,19 @@ Perl_my_chdir(pTHX_ const char *dir)
    * null file name/type.  However, it's commonplace under Unix,
    * so we'll allow it for a gain in portability.
    *
-   * - Preview- '/' will be valid soon on VMS
+   *  '/' is valid when SYS$POSIX_ROOT or POSIX compliant pathnames are active.
    */
   if ((dirlen > 1) && (dir1[dirlen-1] == '/')) {
-    char *newdir = savepvn(dir1,dirlen-1);
-    int ret = chdir(newdir);
-    Safefree(newdir);
-    return ret;
+      char *newdir;
+      int ret;
+      newdir = PerlMem_malloc(dirlen);
+      if (newdir ==NULL)
+          _ckvmssts_noperl(SS$_INSFMEM);
+      strncpy(newdir, dir1, dirlen-1);
+      newdir[dirlen-1] = '\0';
+      ret = chdir(newdir);
+      PerlMem_free(newdir);
+      return ret;
   }
   else return chdir(dir1);
 }  /* end of my_chdir */
@@ -2100,6 +2286,9 @@ Perl_my_chdir(pTHX_ const char *dir)
 int
 Perl_my_chmod(pTHX_ const char *file_spec, mode_t mode)
 {
+  Stat_t st;
+  int ret = -1;
+  char * changefile;
   STRLEN speclen = strlen(file_spec);
 
   /* zero length string sometimes gives ACCVIO */
@@ -2112,41 +2301,26 @@ Perl_my_chmod(pTHX_ const char *file_spec, mode_t mode)
    * Tests are showing that chmod() on VMS 8.3 is only accepting directories
    * in VMS file.dir notation.
    */
-  if ((speclen > 1) && (file_spec[speclen-1] == '/')) {
-    char *vms_src, *vms_dir, *rslt;
-    int ret = -1;
-    errno = EIO;
+  changefile = (char *) file_spec; /* cast ok */
+  ret = flex_lstat(file_spec, &st);
+  if (ret != 0) {
 
-    /* First convert this to a VMS format specification */
-    vms_src = PerlMem_malloc(VMS_MAXRSS);
-    if (vms_src == NULL)
-	_ckvmssts(SS$_INSFMEM);
+        /* Due to a historical feature, flex_stat/lstat can not see some */
+        /* Unix format file names that the rest of the CRTL can see when */
+        /* ODS-2 file specifications are in use. */
+        /* Fixing that feature will cause some perl tests to fail */
+        /* [.lib.ExtUtils.t]Manifest.t is one of them */
+        st.st_mode = 0;
 
-    rslt = do_tovmsspec(file_spec, vms_src, 0, NULL);
-    if (rslt == NULL) {
-	/* If we fail, then not a file specification */
-	PerlMem_free(vms_src);
-	errno = EIO;
-	return -1;
-    }
-
-    /* Now make it a directory spec so chmod is happy */
-    vms_dir = PerlMem_malloc(VMS_MAXRSS + 1);
-    if (vms_dir == NULL)
-	_ckvmssts(SS$_INSFMEM);
-    rslt = do_fileify_dirspec(vms_src, vms_dir, 0, NULL);
-    PerlMem_free(vms_src);
-
-    /* Now do it */
-    if (rslt != NULL) {
-	ret = chmod(vms_dir, mode);
-    } else {
-	errno = EIO;
-    }
-    PerlMem_free(vms_dir);
-    return ret;
+  } else {
+      /* It may be possible to get here with nothing in st_devname */
+      /* chmod still may work though */
+      if (st.st_devnam[0] != 0) {
+          changefile = st.st_devnam;
+      }
   }
-  else return chmod(file_spec, mode);
+  ret = chmod(changefile, mode);
+  return ret;
 }  /* end of my_chmod */
 /*}}}*/
 
@@ -2372,7 +2546,7 @@ Perl_my_kill(int pid, int sig)
       case SS$_INSFMEM:
         set_errno(ENOMEM); break;
       default:
-        _ckvmssts(iss);
+        _ckvmssts_noperl(iss);
         set_errno(EVMSERR);
     } 
     set_vaxc_errno(iss);
@@ -2568,6 +2742,9 @@ int unix_status;
 	case RMS$_WLK:	/* Device write locked */
 		unix_status = EACCES;
 		break;
+	case RMS$_MKD:  /* Failed to mark for delete */
+		unix_status = EPERM;
+		break;
 	/* case RMS$_NMF: */  /* No more files */
 	}
     }
@@ -2712,7 +2889,7 @@ int test_unix_status;
 
 
 static void
-create_mbx(pTHX_ unsigned short int *chan, struct dsc$descriptor_s *namdsc)
+create_mbx(unsigned short int *chan, struct dsc$descriptor_s *namdsc)
 {
   unsigned long int mbxbufsiz;
   static unsigned long int syssize = 0;
@@ -2730,7 +2907,7 @@ create_mbx(pTHX_ unsigned short int *chan, struct dsc$descriptor_s *namdsc)
      * keep the size between 128 and MAXBUF.
      *
      */
-    _ckvmssts(lib$getsyi(&syiitm, &syssize, 0, 0, 0, 0));
+    _ckvmssts_noperl(lib$getsyi(&syiitm, &syssize, 0, 0, 0, 0));
   }
 
   if (vmstrnenv("PERL_MBX_SIZE", csize, 0, fildev, 0)) {
@@ -2741,9 +2918,10 @@ create_mbx(pTHX_ unsigned short int *chan, struct dsc$descriptor_s *namdsc)
   if (mbxbufsiz < 128) mbxbufsiz = 128;
   if (mbxbufsiz > syssize) mbxbufsiz = syssize;
 
-  _ckvmssts(sts = sys$crembx(0,chan,mbxbufsiz,mbxbufsiz,0,0,0));
+  _ckvmssts_noperl(sts = sys$crembx(0,chan,mbxbufsiz,mbxbufsiz,0,0,0));
 
-  _ckvmssts(sts = lib$getdvi(&dviitm, chan, NULL, NULL, namdsc, &namdsc->dsc$w_length));
+  sts = lib$getdvi(&dviitm, chan, NULL, NULL, namdsc, &namdsc->dsc$w_length);
+  _ckvmssts_noperl(sts);
   namdsc->dsc$a_pointer[namdsc->dsc$w_length] = '\0';
 
 }  /* end of create_mbx() */
@@ -2866,7 +3044,7 @@ static $DESCRIPTOR(nl_desc, "NL:");
 
 
 static unsigned long int
-pipe_exit_routine(pTHX)
+pipe_exit_routine()
 {
     pInfo info;
     unsigned long int retsts = SS$_NORMAL, abort = SS$_TIMEOUT;
@@ -2880,6 +3058,17 @@ pipe_exit_routine(pTHX)
     info = open_pipes;
     while (info) {
         if (info->fp) {
+#if defined(PERL_IMPLICIT_CONTEXT)
+           /* We need to use the Perl context of the thread that created */
+           /* the pipe. */
+           pTHX;
+           if (info->err)
+               aTHX = info->err->thx;
+           else if (info->out)
+               aTHX = info->out->thx;
+           else if (info->in)
+               aTHX = info->in->thx;
+#endif
            if (!info->useFILE
 #if defined(USE_ITHREADS)
              && my_perl
@@ -2904,7 +3093,7 @@ pipe_exit_routine(pTHX)
       _ckvmssts_noperl(sys$setast(0));
       if (info->in && !info->in->shut_on_empty) {
         _ckvmssts_noperl(sys$qio(0,info->in->chan_in,IO$_WRITEOF,0,0,0,
-                          0, 0, 0, 0, 0, 0));
+                                 0, 0, 0, 0, 0, 0));
         info->waiting = 1;
         did_stuff = 1;
       }
@@ -2974,6 +3163,18 @@ pipe_exit_routine(pTHX)
     }
 
     while(open_pipes) {
+
+#if defined(PERL_IMPLICIT_CONTEXT)
+      /* We need to use the Perl context of the thread that created */
+      /* the pipe. */
+      pTHX;
+      if (open_pipes->err)
+          aTHX = open_pipes->err->thx;
+      else if (open_pipes->out)
+          aTHX = open_pipes->out->thx;
+      else if (open_pipes->in)
+          aTHX = open_pipes->in->thx;
+#endif
       if ((sts = my_pclose(open_pipes->fp)) == -1) retsts = vaxc$errno;
       else if (!(sts & 1)) retsts = sts;
     }
@@ -3136,11 +3337,11 @@ pipe_tochild_setup(pTHX_ char *rmbx, char *wmbx)
     int j, n;
 
     n = sizeof(Pipe);
-    _ckvmssts(lib$get_vm(&n, &p));
+    _ckvmssts_noperl(lib$get_vm(&n, &p));
 
-    create_mbx(aTHX_ &p->chan_in , &d_mbx1);
-    create_mbx(aTHX_ &p->chan_out, &d_mbx2);
-    _ckvmssts(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
+    create_mbx(&p->chan_in , &d_mbx1);
+    create_mbx(&p->chan_out, &d_mbx2);
+    _ckvmssts_noperl(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
 
     p->buf           = 0;
     p->shut_on_empty = FALSE;
@@ -3161,9 +3362,9 @@ pipe_tochild_setup(pTHX_ char *rmbx, char *wmbx)
     n = sizeof(CBuf) + p->bufsize;
 
     for (j = 0; j < INITIAL_TOCHILDQUEUE; j++) {
-        _ckvmssts(lib$get_vm(&n, &b));
+        _ckvmssts_noperl(lib$get_vm(&n, &b));
         b->buf = (char *) b + sizeof(CBuf);
-        _ckvmssts(lib$insqhi(b, &p->free));
+        _ckvmssts_noperl(lib$insqhi(b, &p->free));
     }
 
     pipe_tochild2_ast(p);
@@ -3190,17 +3391,17 @@ pipe_tochild1_ast(pPipe p)
         if (eof) {
             p->shut_on_empty = TRUE;
             b->eof     = TRUE;
-            _ckvmssts(sys$dassgn(p->chan_in));
+            _ckvmssts_noperl(sys$dassgn(p->chan_in));
         } else  {
-            _ckvmssts(iss);
+            _ckvmssts_noperl(iss);
         }
 
         b->eof  = eof;
         b->size = p->iosb.count;
-        _ckvmssts(sts = lib$insqhi(b, &p->wait));
+        _ckvmssts_noperl(sts = lib$insqhi(b, &p->wait));
         if (p->need_wake) {
             p->need_wake = FALSE;
-            _ckvmssts(sys$dclast(pipe_tochild2_ast,p,0));
+            _ckvmssts_noperl(sys$dclast(pipe_tochild2_ast,p,0));
         }
     } else {
         p->retry = 1;   /* initial call */
@@ -3211,18 +3412,18 @@ pipe_tochild1_ast(pPipe p)
         while (1) {
             iss = lib$remqti(&p->free, &b);
             if (iss == LIB$_QUEWASEMP) return;
-            _ckvmssts(iss);
-            _ckvmssts(lib$free_vm(&n, &b));
+            _ckvmssts_noperl(iss);
+            _ckvmssts_noperl(lib$free_vm(&n, &b));
         }
     }
 
     iss = lib$remqti(&p->free, &b);
     if (iss == LIB$_QUEWASEMP) {
         int n = sizeof(CBuf) + p->bufsize;
-        _ckvmssts(lib$get_vm(&n, &b));
+        _ckvmssts_noperl(lib$get_vm(&n, &b));
         b->buf = (char *) b + sizeof(CBuf);
     } else {
-       _ckvmssts(iss);
+       _ckvmssts_noperl(iss);
     }
 
     p->curr = b;
@@ -3231,7 +3432,7 @@ pipe_tochild1_ast(pPipe p)
              &p->iosb,
              pipe_tochild1_ast, p, b->buf, p->bufsize, 0, 0, 0, 0);
     if (iss == SS$_ENDOFFILE && p->shut_on_empty) iss = SS$_NORMAL;
-    _ckvmssts(iss);
+    _ckvmssts_noperl(iss);
 }
 
 
@@ -3253,9 +3454,9 @@ pipe_tochild2_ast(pPipe p)
     do {
         if (p->type) {         /* type=1 has old buffer, dispose */
             if (p->shut_on_empty) {
-                _ckvmssts(lib$free_vm(&n, &b));
+                _ckvmssts_noperl(lib$free_vm(&n, &b));
             } else {
-                _ckvmssts(lib$insqhi(b, &p->free));
+                _ckvmssts_noperl(lib$insqhi(b, &p->free));
             }
             p->type = 0;
         }
@@ -3264,11 +3465,11 @@ pipe_tochild2_ast(pPipe p)
         if (iss == LIB$_QUEWASEMP) {
             if (p->shut_on_empty) {
                 if (done) {
-                    _ckvmssts(sys$dassgn(p->chan_out));
+                    _ckvmssts_noperl(sys$dassgn(p->chan_out));
                     *p->pipe_done = TRUE;
-                    _ckvmssts(sys$setef(pipe_ef));
+                    _ckvmssts_noperl(sys$setef(pipe_ef));
                 } else {
-                    _ckvmssts(sys$qio(0,p->chan_out,IO$_WRITEOF,
+                    _ckvmssts_noperl(sys$qio(0,p->chan_out,IO$_WRITEOF,
                         &p->iosb2, pipe_tochild2_ast, p, 0, 0, 0, 0, 0, 0));
                 }
                 return;
@@ -3276,17 +3477,17 @@ pipe_tochild2_ast(pPipe p)
             p->need_wake = TRUE;
             return;
         }
-        _ckvmssts(iss);
+        _ckvmssts_noperl(iss);
         p->type = 1;
     } while (done);
 
 
     p->curr2 = b;
     if (b->eof) {
-        _ckvmssts(sys$qio(0,p->chan_out,IO$_WRITEOF,
+        _ckvmssts_noperl(sys$qio(0,p->chan_out,IO$_WRITEOF,
             &p->iosb2, pipe_tochild2_ast, p, 0, 0, 0, 0, 0, 0));
     } else {
-        _ckvmssts(sys$qio(0,p->chan_out,IO$_WRITEVBLK,
+        _ckvmssts_noperl(sys$qio(0,p->chan_out,IO$_WRITEVBLK,
             &p->iosb2, pipe_tochild2_ast, p, b->buf, b->size, 0, 0, 0, 0));
     }
 
@@ -3307,13 +3508,13 @@ pipe_infromchild_setup(pTHX_ char *rmbx, char *wmbx)
     unsigned int dviitm = DVI$_DEVBUFSIZ;
 
     int n = sizeof(Pipe);
-    _ckvmssts(lib$get_vm(&n, &p));
-    create_mbx(aTHX_ &p->chan_in , &d_mbx1);
-    create_mbx(aTHX_ &p->chan_out, &d_mbx2);
+    _ckvmssts_noperl(lib$get_vm(&n, &p));
+    create_mbx(&p->chan_in , &d_mbx1);
+    create_mbx(&p->chan_out, &d_mbx2);
 
-    _ckvmssts(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
+    _ckvmssts_noperl(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
     n = p->bufsize * sizeof(char);
-    _ckvmssts(lib$get_vm(&n, &p->buf));
+    _ckvmssts_noperl(lib$get_vm(&n, &p->buf));
     p->shut_on_empty = FALSE;
     p->info   = 0;
     p->type   = 0;
@@ -3340,7 +3541,7 @@ pipe_infromchild_ast(pPipe p)
 #endif
 
     if (p->info && p->info->closing && p->chan_out)  {           /* output shutdown */
-        _ckvmssts(sys$dassgn(p->chan_out));
+        _ckvmssts_noperl(sys$dassgn(p->chan_out));
         p->chan_out = 0;
     }
 
@@ -3354,22 +3555,22 @@ pipe_infromchild_ast(pPipe p)
     if (p->type == 1) {
         p->type = 0;
         if (myeof && p->chan_in) {                  /* input shutdown */
-            _ckvmssts(sys$dassgn(p->chan_in));
+            _ckvmssts_noperl(sys$dassgn(p->chan_in));
             p->chan_in = 0;
         }
 
         if (p->chan_out) {
             if (myeof || kideof) {      /* pass EOF to parent */
-                _ckvmssts(sys$qio(0,p->chan_out,IO$_WRITEOF, &p->iosb,
-                              pipe_infromchild_ast, p,
-                              0, 0, 0, 0, 0, 0));
+                _ckvmssts_noperl(sys$qio(0,p->chan_out,IO$_WRITEOF, &p->iosb,
+                                         pipe_infromchild_ast, p,
+                                         0, 0, 0, 0, 0, 0));
                 return;
             } else if (eof) {       /* eat EOF --- fall through to read*/
 
             } else {                /* transmit data */
-                _ckvmssts(sys$qio(0,p->chan_out,IO$_WRITEVBLK,&p->iosb,
-                              pipe_infromchild_ast,p,
-                              p->buf, p->iosb.count, 0, 0, 0, 0));
+                _ckvmssts_noperl(sys$qio(0,p->chan_out,IO$_WRITEVBLK,&p->iosb,
+                                         pipe_infromchild_ast,p,
+                                         p->buf, p->iosb.count, 0, 0, 0, 0));
                 return;
             }
         }
@@ -3379,7 +3580,7 @@ pipe_infromchild_ast(pPipe p)
 
     if (!p->chan_in && !p->chan_out) {
         *p->pipe_done = TRUE;
-        _ckvmssts(sys$setef(pipe_ef));
+        _ckvmssts_noperl(sys$setef(pipe_ef));
         return;
     }
 
@@ -3397,13 +3598,13 @@ pipe_infromchild_ast(pPipe p)
                           pipe_infromchild_ast,p,
                           p->buf, p->bufsize, 0, 0, 0, 0);
             if (p->shut_on_empty && iss == SS$_ENDOFFILE) iss = SS$_NORMAL;
-            _ckvmssts(iss);
+            _ckvmssts_noperl(iss);
         } else {           /* send EOFs for extra reads */
             p->iosb.status = SS$_ENDOFFILE;
             p->iosb.dvispec = 0;
-            _ckvmssts(sys$qio(0,p->chan_out,IO$_SETMODE|IO$M_READATTN,
-                      0, 0, 0,
-                      pipe_infromchild_ast, p, 0, 0, 0, 0));
+            _ckvmssts_noperl(sys$qio(0,p->chan_out,IO$_SETMODE|IO$M_READATTN,
+                                     0, 0, 0,
+                                     pipe_infromchild_ast, p, 0, 0, 0, 0));
         }
     }
 }
@@ -3431,7 +3632,7 @@ pipe_mbxtofd_setup(pTHX_ int fd, char *out)
 	unsigned short dvi_iosb[4];
 
 	cptr = getname(fd, out, 1);
-	if (cptr == NULL) _ckvmssts(SS$_NOSUCHDEV);
+	if (cptr == NULL) _ckvmssts_noperl(SS$_NOSUCHDEV);
 	d_dev.dsc$a_pointer = out;
 	d_dev.dsc$w_length = strlen(out);
 	d_dev.dsc$b_dtype = DSC$K_DTYPE_T;
@@ -3450,7 +3651,7 @@ pipe_mbxtofd_setup(pTHX_ int fd, char *out)
 
 	status = sys$getdviw
 	        (NO_EFN, 0, &d_dev, items, dvi_iosb, NULL, NULL, NULL);
-	_ckvmssts(status);
+	_ckvmssts_noperl(status);
 	if ($VMS_STATUS_SUCCESS(dvi_iosb[0])) {
 	    device[dev_len] = 0;
 
@@ -3461,20 +3662,20 @@ pipe_mbxtofd_setup(pTHX_ int fd, char *out)
 	}
     }
 
-    _ckvmssts(lib$get_vm(&n, &p));
+    _ckvmssts_noperl(lib$get_vm(&n, &p));
     p->fd_out = dup(fd);
-    create_mbx(aTHX_ &p->chan_in, &d_mbx);
-    _ckvmssts(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
+    create_mbx(&p->chan_in, &d_mbx);
+    _ckvmssts_noperl(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
     n = (p->bufsize+1) * sizeof(char);
-    _ckvmssts(lib$get_vm(&n, &p->buf));
+    _ckvmssts_noperl(lib$get_vm(&n, &p->buf));
     p->shut_on_empty = FALSE;
     p->retry = 0;
     p->info  = 0;
     strcpy(out, mbx);
 
-    _ckvmssts(sys$qio(0, p->chan_in, IO$_READVBLK, &p->iosb,
-                  pipe_mbxtofd_ast, p,
-                  p->buf, p->bufsize, 0, 0, 0, 0));
+    _ckvmssts_noperl(sys$qio(0, p->chan_in, IO$_READVBLK, &p->iosb,
+                             pipe_mbxtofd_ast, p,
+                             p->buf, p->bufsize, 0, 0, 0, 0));
 
     return p;
 }
@@ -3496,7 +3697,7 @@ pipe_mbxtofd_ast(pPipe p)
         close(p->fd_out);
         sys$dassgn(p->chan_in);
         *p->pipe_done = TRUE;
-        _ckvmssts(sys$setef(pipe_ef));
+        _ckvmssts_noperl(sys$setef(pipe_ef));
         return;
     }
 
@@ -3506,13 +3707,13 @@ pipe_mbxtofd_ast(pPipe p)
         if (iss2 < 0) {
             p->retry++;
             if (p->retry < MAX_RETRY) {
-                _ckvmssts(sys$setimr(0,delaytime,pipe_mbxtofd_ast,p));
+                _ckvmssts_noperl(sys$setimr(0,delaytime,pipe_mbxtofd_ast,p));
                 return;
             }
         }
         p->retry = 0;
     } else if (err) {
-        _ckvmssts(iss);
+        _ckvmssts_noperl(iss);
     }
 
 
@@ -3520,7 +3721,7 @@ pipe_mbxtofd_ast(pPipe p)
           pipe_mbxtofd_ast, p,
           p->buf, p->bufsize, 0, 0, 0, 0);
     if (p->shut_on_empty && (iss == SS$_ENDOFFILE)) iss = SS$_NORMAL;
-    _ckvmssts(iss);
+    _ckvmssts_noperl(iss);
 }
 
 
@@ -3567,7 +3768,7 @@ store_pipelocs(pTHX)
 /*  the . directory from @INC comes last */
 
     p = (pPLOC) PerlMem_malloc(sizeof(PLOC));
-    if (p == NULL) _ckvmssts(SS$_INSFMEM);
+    if (p == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     p->next = head_PLOC;
     head_PLOC = p;
     strcpy(p->dir,"./");
@@ -3575,7 +3776,7 @@ store_pipelocs(pTHX)
 /*  get the directory from $^X */
 
     unixdir = PerlMem_malloc(VMS_MAXRSS);
-    if (unixdir == NULL) _ckvmssts(SS$_INSFMEM);
+    if (unixdir == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 
 #ifdef PERL_IMPLICIT_CONTEXT
     if (aTHX && PL_origargv && PL_origargv[0]) {    /* maybe nul if embedded Perl */
@@ -3599,9 +3800,9 @@ store_pipelocs(pTHX)
 	  temp[1] = '\0';
 	}
 
-        if ((tounixpath_utf8(temp, unixdir, NULL)) != Nullch) {
+        if ((tounixpath_utf8(temp, unixdir, NULL)) != NULL) {
             p = (pPLOC) PerlMem_malloc(sizeof(PLOC));
-	    if (p == NULL) _ckvmssts(SS$_INSFMEM);
+	    if (p == NULL) _ckvmssts_noperl(SS$_INSFMEM);
             p->next = head_PLOC;
             head_PLOC = p;
             strncpy(p->dir,unixdir,sizeof(p->dir)-1);
@@ -3622,7 +3823,7 @@ store_pipelocs(pTHX)
         if (SvROK(dirsv)) continue;
         dir = SvPVx(dirsv,n_a);
         if (strcmp(dir,".") == 0) continue;
-        if ((tounixpath_utf8(dir, unixdir, NULL)) == Nullch)
+        if ((tounixpath_utf8(dir, unixdir, NULL)) == NULL)
             continue;
 
         p = (pPLOC) PerlMem_malloc(sizeof(PLOC));
@@ -3635,9 +3836,9 @@ store_pipelocs(pTHX)
 /* most likely spot (ARCHLIB) put first in the list */
 
 #ifdef ARCHLIB_EXP
-    if ((tounixpath_utf8(ARCHLIB_EXP, unixdir, NULL)) != Nullch) {
+    if ((tounixpath_utf8(ARCHLIB_EXP, unixdir, NULL)) != NULL) {
         p = (pPLOC) PerlMem_malloc(sizeof(PLOC));
-	if (p == NULL) _ckvmssts(SS$_INSFMEM);
+	if (p == NULL) _ckvmssts_noperl(SS$_INSFMEM);
         p->next = head_PLOC;
         head_PLOC = p;
         strncpy(p->dir,unixdir,sizeof(p->dir)-1);
@@ -3688,8 +3889,7 @@ find_vmspipe(pTHX)
             file[NAM$C_MAXRSS] = '\0';
             p = p->next;
 
-            exp_res = do_rmsexpand
-		(file, vmspipe_file, 0, NULL, PERL_RMSEXPAND_M_VMS, NULL, NULL);
+            exp_res = int_rmsexpand_tovms(file, vmspipe_file, 0);
             if (!exp_res) continue;
 
             if (cando_by_name_int
@@ -3780,14 +3980,14 @@ vmspipe_tempfile(pTHX)
     fsync(fileno(fp));
 
     fgetname(fp, file, 1);
-    fstat(fileno(fp), (struct stat *)&s0);
+    fstat(fileno(fp), &s0.crtl_stat);
     fclose(fp);
 
     if (decc_filename_unix_only)
-	do_tounixspec(file, file, 0, NULL);
+	int_tounixspec(file, file, NULL);
     fp = fopen(file,"r","shr=get");
     if (!fp) return 0;
-    fstat(fileno(fp), (struct stat *)&s1);
+    fstat(fileno(fp), &s1.crtl_stat);
 
     cmp_result = VMS_INO_T_COMPARE(s0.crtl_stat.st_ino, s1.crtl_stat.st_ino);
     if ((cmp_result != 0) && (s0.st_ctime != s1.st_ctime))  {
@@ -4013,7 +4213,7 @@ static PerlIO * create_forked_xterm(pTHX_ const char *cmd, const char *mode)
     info->in         = 0;
     info->out        = 0;
     info->err        = 0;
-    info->fp         = Nullfp;
+    info->fp         = NULL;
     info->useFILE    = 0;
     info->waiting    = 0;
     info->in_done    = TRUE;
@@ -4035,7 +4235,7 @@ static PerlIO * create_forked_xterm(pTHX_ const char *cmd, const char *mode)
 
     /* Now create a mailbox to be read by the application */
 
-    create_mbx(aTHX_ &p_chan, &d_mbx1);
+    create_mbx(&p_chan, &d_mbx1);
 
     /* write the name of the created terminal to the mailbox */
     status = sys$qiow(NO_EFN, p_chan, IO$_WRITEVBLK|IO$M_NOW,
@@ -4054,7 +4254,7 @@ static PerlIO * create_forked_xterm(pTHX_ const char *cmd, const char *mode)
     /* If any errors, then clean up */
     if (!info->fp) {
        	n = sizeof(Info);
-	_ckvmssts(lib$free_vm(&n, &info));
+	_ckvmssts_noperl(lib$free_vm(&n, &info));
 	return NULL;
         }
 
@@ -4062,10 +4262,13 @@ static PerlIO * create_forked_xterm(pTHX_ const char *cmd, const char *mode)
     return info->fp;
 }
 
+static I32 my_pclose_pinfo(pTHX_ pInfo info);
+
 static PerlIO *
 safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
 {
     static int handler_set_up = FALSE;
+    PerlIO * ret_fp;
     unsigned long int sts, flags = CLI$M_NOWAIT;
     /* The use of a GLOBAL table (as was done previously) rendered
      * Perl's qx() or `` unusable from a C<$ SET SYMBOL/SCOPE=NOGLOBAL> DCL
@@ -4097,8 +4300,14 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
     if (*in_mode == 'r') {
         PerlIO * xterm_fd;
 
+#if defined(PERL_IMPLICIT_CONTEXT)
+        /* Can not fork an xterm with a NULL context */
+        /* This probably could never happen */
+        xterm_fd = NULL;
+        if (aTHX != NULL)
+#endif
 	xterm_fd = create_forked_xterm(aTHX_ cmd, in_mode);
-	if (xterm_fd != Nullfp)
+	if (xterm_fd != NULL)
 	    return xterm_fd;
     }
 
@@ -4115,19 +4324,19 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
     */
 
     if (!pipe_ef) {
-        _ckvmssts(sys$setast(0));
+        _ckvmssts_noperl(sys$setast(0));
         if (!pipe_ef) {
             unsigned long int pidcode = JPI$_PID;
             $DESCRIPTOR(d_delay, RETRY_DELAY);
-            _ckvmssts(lib$get_ef(&pipe_ef));
-            _ckvmssts(lib$getjpi(&pidcode,0,0,&mypid,0,0));
-            _ckvmssts(sys$bintim(&d_delay, delaytime));
+            _ckvmssts_noperl(lib$get_ef(&pipe_ef));
+            _ckvmssts_noperl(lib$getjpi(&pidcode,0,0,&mypid,0,0));
+            _ckvmssts_noperl(sys$bintim(&d_delay, delaytime));
         }
         if (!handler_set_up) {
-          _ckvmssts(sys$dclexh(&pipe_exitblock));
+          _ckvmssts_noperl(sys$dclexh(&pipe_exitblock));
           handler_set_up = TRUE;
         }
-        _ckvmssts(sys$setast(1));
+        _ckvmssts_noperl(sys$setast(1));
     }
 
     /* see if we can find a VMSPIPE.COM */
@@ -4142,7 +4351,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
             if (ckWARN(WARN_PIPE)) {
                 Perl_warner(aTHX_ packWARN(WARN_PIPE),"unable to find VMSPIPE.COM for i/o piping");
             }
-        return Nullfp;
+        return NULL;
         }
         fgetname(tpipe,tfilebuf+1,1);
     }
@@ -4165,7 +4374,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
         case CLI$_BUFOVF: case RMS$_RTB: case CLI$_TKNOVF: case CLI$_RSLOVF:
           set_errno(E2BIG); break;
         case LIB$_INVARG: case LIB$_INVSTRDES: case SS$_ACCVIO: /* shouldn't happen */
-          _ckvmssts(sts); /* fall through */
+          _ckvmssts_noperl(sts); /* fall through */
         default:  /* SS$_DUPLNAM, SS$_CLI, resource exhaustion, etc. */
           set_errno(EVMSERR); 
       }
@@ -4174,10 +4383,10 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
         Perl_warner(aTHX_ packWARN(WARN_PIPE),"Can't pipe \"%*s\": %s", strlen(cmd), cmd, Strerror(errno));
       }
       *psts = sts;
-      return Nullfp; 
+      return NULL; 
     }
     n = sizeof(Info);
-    _ckvmssts(lib$get_vm(&n, &info));
+    _ckvmssts_noperl(lib$get_vm(&n, &info));
         
     strcpy(mode,in_mode);
     info->mode = *mode;
@@ -4187,7 +4396,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
     info->in         = 0;
     info->out        = 0;
     info->err        = 0;
-    info->fp         = Nullfp;
+    info->fp         = NULL;
     info->useFILE    = 0;
     info->waiting    = 0;
     info->in_done    = TRUE;
@@ -4197,11 +4406,11 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
     info->xchan_valid = 0;
 
     in = PerlMem_malloc(VMS_MAXRSS);
-    if (in == NULL) _ckvmssts(SS$_INSFMEM);
+    if (in == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     out = PerlMem_malloc(VMS_MAXRSS);
-    if (out == NULL) _ckvmssts(SS$_INSFMEM);
+    if (out == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     err = PerlMem_malloc(VMS_MAXRSS);
-    if (err == NULL) _ckvmssts(SS$_INSFMEM);
+    if (err == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 
     in[0] = out[0] = err[0] = '\0';
 
@@ -4234,23 +4443,23 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
         
             while (!info->out_done) {
                 int done;
-                _ckvmssts(sys$setast(0));
+                _ckvmssts_noperl(sys$setast(0));
                 done = info->out_done;
-                if (!done) _ckvmssts(sys$clref(pipe_ef));
-                _ckvmssts(sys$setast(1));
-                if (!done) _ckvmssts(sys$waitfr(pipe_ef));
+                if (!done) _ckvmssts_noperl(sys$clref(pipe_ef));
+                _ckvmssts_noperl(sys$setast(1));
+                if (!done) _ckvmssts_noperl(sys$waitfr(pipe_ef));
             }
 
             if (info->out->buf) {
                 n = info->out->bufsize * sizeof(char);
-                _ckvmssts(lib$free_vm(&n, &info->out->buf));
+                _ckvmssts_noperl(lib$free_vm(&n, &info->out->buf));
             }
             n = sizeof(Pipe);
-            _ckvmssts(lib$free_vm(&n, &info->out));
+            _ckvmssts_noperl(lib$free_vm(&n, &info->out));
             n = sizeof(Info);
-            _ckvmssts(lib$free_vm(&n, &info));
+            _ckvmssts_noperl(lib$free_vm(&n, &info));
             *psts = RMS$_FNF;
-            return Nullfp;
+            return NULL;
         }
 
         info->err = pipe_mbxtofd_setup(aTHX_ fileno(stderr), err);
@@ -4293,28 +4502,28 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
         /* error cleanup */
         if (!info->fp && info->in) {
             info->done = TRUE;
-            _ckvmssts(sys$qiow(0,info->in->chan_in, IO$_WRITEOF, 0,
-                              0, 0, 0, 0, 0, 0, 0, 0));
+            _ckvmssts_noperl(sys$qiow(0,info->in->chan_in, IO$_WRITEOF, 0,
+                                      0, 0, 0, 0, 0, 0, 0, 0));
 
             while (!info->in_done) {
                 int done;
-                _ckvmssts(sys$setast(0));
+                _ckvmssts_noperl(sys$setast(0));
                 done = info->in_done;
-                if (!done) _ckvmssts(sys$clref(pipe_ef));
-                _ckvmssts(sys$setast(1));
-                if (!done) _ckvmssts(sys$waitfr(pipe_ef));
+                if (!done) _ckvmssts_noperl(sys$clref(pipe_ef));
+                _ckvmssts_noperl(sys$setast(1));
+                if (!done) _ckvmssts_noperl(sys$waitfr(pipe_ef));
             }
 
             if (info->in->buf) {
                 n = info->in->bufsize * sizeof(char);
-                _ckvmssts(lib$free_vm(&n, &info->in->buf));
+                _ckvmssts_noperl(lib$free_vm(&n, &info->in->buf));
             }
             n = sizeof(Pipe);
-            _ckvmssts(lib$free_vm(&n, &info->in));
+            _ckvmssts_noperl(lib$free_vm(&n, &info->in));
             n = sizeof(Info);
-            _ckvmssts(lib$free_vm(&n, &info));
+            _ckvmssts_noperl(lib$free_vm(&n, &info));
             *psts = RMS$_FNF;
-            return Nullfp;
+            return NULL;
         }
         
 
@@ -4338,15 +4547,15 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
 
     strncpy(symbol, in, MAX_DCL_SYMBOL);
     d_symbol.dsc$w_length = strlen(symbol);
-    _ckvmssts(lib$set_symbol(&d_sym_in, &d_symbol, &table));
+    _ckvmssts_noperl(lib$set_symbol(&d_sym_in, &d_symbol, &table));
 
     strncpy(symbol, err, MAX_DCL_SYMBOL);
     d_symbol.dsc$w_length = strlen(symbol);
-    _ckvmssts(lib$set_symbol(&d_sym_err, &d_symbol, &table));
+    _ckvmssts_noperl(lib$set_symbol(&d_sym_err, &d_symbol, &table));
 
     strncpy(symbol, out, MAX_DCL_SYMBOL);
     d_symbol.dsc$w_length = strlen(symbol);
-    _ckvmssts(lib$set_symbol(&d_sym_out, &d_symbol, &table));
+    _ckvmssts_noperl(lib$set_symbol(&d_sym_out, &d_symbol, &table));
 
     /* Done with the names for the pipes */
     PerlMem_free(err);
@@ -4364,7 +4573,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
 
     strncpy(symbol, p, MAX_DCL_SYMBOL);
     d_symbol.dsc$w_length = strlen(symbol);
-    _ckvmssts(lib$set_symbol(&d_sym_cmd, &d_symbol, &table));
+    _ckvmssts_noperl(lib$set_symbol(&d_sym_cmd, &d_symbol, &table));
 
         if (strlen(p) > MAX_DCL_SYMBOL) {
             p += MAX_DCL_SYMBOL;
@@ -4372,15 +4581,15 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
             p += strlen(p);
         }
     }
-    _ckvmssts(sys$setast(0));
+    _ckvmssts_noperl(sys$setast(0));
     info->next=open_pipes;  /* prepend to list */
     open_pipes=info;
-    _ckvmssts(sys$setast(1));
+    _ckvmssts_noperl(sys$setast(1));
     /* Omit arg 2 (input file) so the child will get the parent's SYS$INPUT
      * and SYS$COMMAND.  vmspipe.com will redefine SYS$INPUT, but we'll still
      * have SYS$COMMAND if we need it.
      */
-    _ckvmssts(lib$spawn(&vmspipedsc, 0, &nl_desc, &flags,
+    _ckvmssts_noperl(lib$spawn(&vmspipedsc, 0, &nl_desc, &flags,
                       0, &info->pid, &info->completion,
                       0, popen_completion_ast,info,0,0,0));
 
@@ -4394,11 +4603,11 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
     for (j = 0; j < 4; j++) {
         sprintf(cmd_sym_name,"PERL_POPEN_CMD%d",j);
         d_sym_cmd.dsc$w_length = strlen(cmd_sym_name);
-    _ckvmssts(lib$delete_symbol(&d_sym_cmd, &table));
+    _ckvmssts_noperl(lib$delete_symbol(&d_sym_cmd, &table));
     }
-    _ckvmssts(lib$delete_symbol(&d_sym_in,  &table));
-    _ckvmssts(lib$delete_symbol(&d_sym_err, &table));
-    _ckvmssts(lib$delete_symbol(&d_sym_out, &table));
+    _ckvmssts_noperl(lib$delete_symbol(&d_sym_in,  &table));
+    _ckvmssts_noperl(lib$delete_symbol(&d_sym_err, &table));
+    _ckvmssts_noperl(lib$delete_symbol(&d_sym_out, &table));
     vms_execfree(vmscmd);
         
 #ifdef PERL_IMPLICIT_CONTEXT
@@ -4406,23 +4615,34 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
 #endif
     PL_forkprocess = info->pid;
 
+    ret_fp = info->fp;
     if (wait) {
+         dSAVEDERRNO;
          int done = 0;
          while (!done) {
-             _ckvmssts(sys$setast(0));
+             _ckvmssts_noperl(sys$setast(0));
              done = info->done;
-             if (!done) _ckvmssts(sys$clref(pipe_ef));
-             _ckvmssts(sys$setast(1));
-             if (!done) _ckvmssts(sys$waitfr(pipe_ef));
+             if (!done) _ckvmssts_noperl(sys$clref(pipe_ef));
+             _ckvmssts_noperl(sys$setast(1));
+             if (!done) _ckvmssts_noperl(sys$waitfr(pipe_ef));
          }
         *psts = info->completion;
 /* Caller thinks it is open and tries to close it. */
 /* This causes some problems, as it changes the error status */
 /*        my_pclose(info->fp); */
+
+         /* If we did not have a file pointer open, then we have to */
+         /* clean up here or eventually we will run out of something */
+         SAVE_ERRNO;
+         if (info->fp == NULL) {
+             my_pclose_pinfo(aTHX_ info);
+         }
+         RESTORE_ERRNO;
+
     } else { 
         *psts = info->pid;
     }
-    return info->fp;
+    return ret_fp;
 }  /* end of safe_popen */
 
 
@@ -4439,22 +4659,15 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
 
 /*}}}*/
 
-/*{{{  I32 my_pclose(PerlIO *fp)*/
-I32 Perl_my_pclose(pTHX_ PerlIO *fp)
-{
-    pInfo info, last = NULL;
+
+/* Routine to close and cleanup a pipe info structure */
+
+static I32 my_pclose_pinfo(pTHX_ pInfo info) {
+
     unsigned long int retsts;
     int done, iss, n;
     int status;
-    
-    for (info = open_pipes; info != NULL; last = info, info = info->next)
-        if (info->fp == fp) break;
-
-    if (info == NULL) {  /* no such pipe open */
-      set_errno(ECHILD); /* quoth POSIX */
-      set_vaxc_errno(SS$_NONEXPR);
-      return -1;
-    }
+    pInfo next, last;
 
     /* If we were writing to a subprocess, insure that someone reading from
      * the mailbox gets an EOF.  It looks like a simple fclose() doesn't
@@ -4517,8 +4730,16 @@ I32 Perl_my_pclose(pTHX_ PerlIO *fp)
 
     /* remove from list of open pipes */
     _ckvmssts(sys$setast(0));
-    if (last) last->next = info->next;
-    else open_pipes = info->next;
+    last = NULL;
+    for (next = open_pipes; next != NULL; last = next, next = next->next) {
+        if (next == info)
+            break;
+    }
+
+    if (last)
+        last->next = info->next;
+    else
+        open_pipes = info->next;
     _ckvmssts(sys$setast(1));
 
     /* free buffers and structures */
@@ -4551,6 +4772,28 @@ I32 Perl_my_pclose(pTHX_ PerlIO *fp)
     _ckvmssts(lib$free_vm(&n, &info));
 
     return retsts;
+}
+
+
+/*{{{  I32 my_pclose(PerlIO *fp)*/
+I32 Perl_my_pclose(pTHX_ PerlIO *fp)
+{
+    pInfo info, last = NULL;
+    I32 ret_status;
+    
+    /* Fixme - need ast and mutex protection here */
+    for (info = open_pipes; info != NULL; last = info, info = info->next)
+        if (info->fp == fp) break;
+
+    if (info == NULL) {  /* no such pipe open */
+      set_errno(ECHILD); /* quoth POSIX */
+      set_vaxc_errno(SS$_NONEXPR);
+      return -1;
+    }
+
+    ret_status = my_pclose_pinfo(aTHX_ info);
+
+    return ret_status;
 
 }  /* end of my_pclose() */
 
@@ -4838,12 +5081,6 @@ static int rms_erase(const char * vmsname)
   rms_set_fna(myfab, mynam, (char *)vmsname, strlen(vmsname)); /* cast ok */
   rms_bind_fab_nam(myfab, mynam);
 
-  /* Are we removing all versions? */
-  if (vms_unlink_all_versions == 1) {
-    const char * defspec = ";*";
-    rms_set_dna(myfab, mynam, (char *)defspec, strlen(defspec)); /* cast ok */
-  }
-
 #ifdef NAML$M_OPEN_SPECIAL
   rms_set_nam_nop(mynam, NAML$M_OPEN_SPECIAL);
 #endif
@@ -4904,13 +5141,9 @@ struct item_list_3
     if (vmsname == NULL)
 	return SS$_INSFMEM;
 
-    rslt = do_rmsexpand(vms_src_dsc->dsc$a_pointer,
+    rslt = int_rmsexpand_tovms(vms_src_dsc->dsc$a_pointer,
 			vmsname,
-			0,
-			NULL,
-			PERL_RMSEXPAND_M_VMS | PERL_RMSEXPAND_M_SYMLINK,
-			NULL,
-			NULL);
+			PERL_RMSEXPAND_M_SYMLINK);
     if (rslt == NULL) {
 	PerlMem_free(vmsname);
 	return SS$_INSFMEM;
@@ -4920,7 +5153,7 @@ struct item_list_3
      * and the insert an ACE at the head of the ACL which allows us
      * to delete the file.
      */
-    _ckvmssts(lib$getjpi(&jpicode,0,0,&(oldace.myace$l_ident),0,0));
+    _ckvmssts_noperl(lib$getjpi(&jpicode,0,0,&(oldace.myace$l_ident),0,0));
 
     fildsc.dsc$w_length = strlen(vmsname);
     fildsc.dsc$a_pointer = vmsname;
@@ -5044,6 +5277,11 @@ Stat_t dst_st;
 	/* No source file or other problem */
 	return src_sts;
     }
+    if (src_st.st_devnam[0] == 0)  {
+        /* This may be possible so fail if it is seen. */
+        errno = EIO;
+        return -1;
+    }
 
     dst_sts = flex_lstat(dst, &dst_st);
     if (dst_sts == 0) {
@@ -5089,7 +5327,28 @@ Stat_t dst_st;
 
 	if (!S_ISDIR(dst_st.st_mode) || S_ISDIR(src_st.st_mode)) {
 	    int d_sts;
-	    d_sts = mp_do_kill_file(aTHX_ dst, S_ISDIR(dst_st.st_mode));
+	    d_sts = mp_do_kill_file(aTHX_ dst_st.st_devnam,
+	                             S_ISDIR(dst_st.st_mode));
+
+           /* Need to delete all versions ? */
+           if ((d_sts == 0) && (vms_unlink_all_versions == 1)) {
+                int i = 0;
+
+                while (lstat(dst_st.st_devnam, &dst_st.crtl_stat) == 0) {
+                    d_sts = mp_do_kill_file(aTHX_ dst_st.st_devnam, 0);
+                    if (d_sts != 0)
+                        break;
+                    i++;
+
+                    /* Make sure that we do not loop forever */
+                    if (i > 32767) {
+                        errno = EIO;
+                        d_sts = -1;
+                        break;
+                    }
+                }
+           }
+
 	    if (d_sts != 0)
 		return d_sts;
 
@@ -5110,7 +5369,6 @@ Stat_t dst_st;
 	/* if the source is a directory, then need to fileify */
 	/*  and dest must be a directory or non-existant. */
 
-	char * vms_src;
 	char * vms_dst;
 	int sts;
 	char * ret_str;
@@ -5122,21 +5380,9 @@ Stat_t dst_st;
 	 * on if one or more of them are directories.
 	 */
 
-	vms_src = PerlMem_malloc(VMS_MAXRSS);
-	if (vms_src == NULL)
-	    _ckvmssts(SS$_INSFMEM);
-
-	/* Source is always a VMS format file */
-	ret_str = do_tovmsspec(src, vms_src, 0, NULL);
-	if (ret_str == NULL) {
-	    PerlMem_free(vms_src);
-	    errno = EIO;
-	    return -1;
-	}
-
 	vms_dst = PerlMem_malloc(VMS_MAXRSS);
 	if (vms_dst == NULL)
-	    _ckvmssts(SS$_INSFMEM);
+	    _ckvmssts_noperl(SS$_INSFMEM);
 
 	if (S_ISDIR(src_st.st_mode)) {
 	char * ret_str;
@@ -5144,26 +5390,13 @@ Stat_t dst_st;
 
 	    vms_dir_file = PerlMem_malloc(VMS_MAXRSS);
 	    if (vms_dir_file == NULL)
-		_ckvmssts(SS$_INSFMEM);
-
-	    /* The source must be a file specification */
-	    ret_str = do_fileify_dirspec(vms_src, vms_dir_file, 0, NULL);
-	    if (ret_str == NULL) {
-		PerlMem_free(vms_src);
-		PerlMem_free(vms_dst);
-		PerlMem_free(vms_dir_file);
-		errno = EIO;
-		return -1;
-	    }
-	    PerlMem_free(vms_src);
-	    vms_src = vms_dir_file;
+		_ckvmssts_noperl(SS$_INSFMEM);
 
 	    /* If the dest is a directory, we must remove it
 	    if (dst_sts == 0) {
 		int d_sts;
-		d_sts = mp_do_kill_file(aTHX_ dst, 1);
+		d_sts = mp_do_kill_file(aTHX_ dst_st.st_devnam, 1);
 		if (d_sts != 0) {
-		    PerlMem_free(vms_src);
 		    PerlMem_free(vms_dst);
 		    errno = EIO;
 		    return sts;
@@ -5173,9 +5406,8 @@ Stat_t dst_st;
 	    }
 
 	   /* The dest must be a VMS file specification */
-	   ret_str = do_tovmsspec(dst, vms_dst, 0, NULL);
+	   ret_str = int_tovmsspec(dst, vms_dst, 0, NULL);
 	   if (ret_str == NULL) {
-		PerlMem_free(vms_src);
 		PerlMem_free(vms_dst);
 		errno = EIO;
 		return -1;
@@ -5184,11 +5416,10 @@ Stat_t dst_st;
 	    /* The source must be a file specification */
 	    vms_dir_file = PerlMem_malloc(VMS_MAXRSS);
 	    if (vms_dir_file == NULL)
-		_ckvmssts(SS$_INSFMEM);
+		_ckvmssts_noperl(SS$_INSFMEM);
 
 	    ret_str = do_fileify_dirspec(vms_dst, vms_dir_file, 0, NULL);
 	    if (ret_str == NULL) {
-		PerlMem_free(vms_src);
 		PerlMem_free(vms_dst);
 		PerlMem_free(vms_dir_file);
 		errno = EIO;
@@ -5202,28 +5433,44 @@ Stat_t dst_st;
 
 	    if ((dst_sts == 0) && S_ISDIR(dst_st.st_mode)) {
 		/* VMS pathify a dir target */
-		ret_str = do_tovmspath(dst, vms_dst, 0, NULL);
+		ret_str = int_tovmspath(dst, vms_dst, NULL);
 		if (ret_str == NULL) {
-		    PerlMem_free(vms_src);
 		    PerlMem_free(vms_dst);
 		    errno = EIO;
 		    return -1;
 		}
 	    } else {
+                char * v_spec, * r_spec, * d_spec, * n_spec;
+                char * e_spec, * vs_spec;
+                int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
 
 		/* fileify a target VMS file specification */
-		ret_str = do_tovmsspec(dst, vms_dst, 0, NULL);
+		ret_str = int_tovmsspec(dst, vms_dst, 0, NULL);
 		if (ret_str == NULL) {
-		    PerlMem_free(vms_src);
 		    PerlMem_free(vms_dst);
 		    errno = EIO;
 		    return -1;
 		}
+
+		sts = vms_split_path(vms_dst, &v_spec, &v_len, &r_spec, &r_len,
+                             &d_spec, &d_len, &n_spec, &n_len, &e_spec,
+                             &e_len, &vs_spec, &vs_len);
+		if (sts == 0) {
+		     if (e_len == 0) {
+		         /* Get rid of the version */
+		         if (vs_len != 0) {
+		             *vs_spec = '\0';
+		         }
+		         /* Need to specify a '.' so that the extension */
+		         /* is not inherited */
+		         strcat(vms_dst,".");
+		     }
+		}
 	    }
 	}
 
-	old_file_dsc.dsc$a_pointer = vms_src;
-	old_file_dsc.dsc$w_length = strlen(vms_src);
+	old_file_dsc.dsc$a_pointer = src_st.st_devnam;
+	old_file_dsc.dsc$w_length = strlen(src_st.st_devnam);
 	old_file_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
 	old_file_dsc.dsc$b_class = DSC$K_CLASS_S;
 
@@ -5234,7 +5481,7 @@ Stat_t dst_st;
 
 	flags = 0;
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
-	flags |= 2; /* LIB$M_FIL_LONG_NAMES */
+	flags |= 4; /* LIB$M_FIL_LONG_NAMES (bit 2) */
 #endif
 
 	sts = lib$rename_file(&old_file_dsc,
@@ -5251,7 +5498,6 @@ Stat_t dst_st;
 	   sts = vms_rename_with_acl(aTHX_ &old_file_dsc, &new_file_dsc, flags);
 	}
 
-	PerlMem_free(vms_src);
 	PerlMem_free(vms_dst);
 	if (!$VMS_STATUS_SUCCESS(sts)) {
 	    errno = EIO;
@@ -5264,10 +5510,25 @@ Stat_t dst_st;
 	/* Now get rid of any previous versions of the source file that
 	 * might still exist
 	 */
-	int save_errno;
-	save_errno = errno;
-	src_sts = mp_do_kill_file(aTHX_ src, S_ISDIR(src_st.st_mode));
-	errno = save_errno;
+	int i = 0;
+	dSAVEDERRNO;
+	SAVE_ERRNO;
+	src_sts = mp_do_kill_file(aTHX_ src_st.st_devnam,
+	                           S_ISDIR(src_st.st_mode));
+	while (lstat(src_st.st_devnam, &src_st.crtl_stat) == 0) {
+	     src_sts = mp_do_kill_file(aTHX_ src_st.st_devnam,
+	                               S_ISDIR(src_st.st_mode));
+	     if (src_sts != 0)
+	         break;
+	     i++;
+
+	     /* Make sure that we do not loop forever */
+	     if (i > 32767) {
+	         src_sts = -1;
+	         break;
+	     }
+	}
+	RESTORE_ERRNO;
     }
 
     /* We deleted the destination, so must force the error to be EIO */
@@ -5300,19 +5561,20 @@ Stat_t dst_st;
 static char *mp_do_tounixspec(pTHX_ const char *, char *, int, int *);
 
 static char *
-mp_do_rmsexpand
-   (pTHX_ const char *filespec,
+int_rmsexpand
+   (const char *filespec,
     char *outbuf,
-    int ts,
     const char *defspec,
     unsigned opts,
     int * fs_utf8,
     int * dfs_utf8)
 {
-  static char __rmsexpand_retbuf[VMS_MAXRSS];
-  char * vmsfspec, *tmpfspec;
-  char * esa, *cp, *out = NULL;
-  char * tbuf;
+  char * ret_spec;
+  const char * in_spec;
+  char * spec_buf;
+  const char * def_spec;
+  char * vmsfspec, *vmsdefspec;
+  char * esa;
   char * esal = NULL;
   char * outbufl;
   struct FAB myfab = cc$rms_fab;
@@ -5329,68 +5591,81 @@ mp_do_rmsexpand
     set_vaxc_errno(LIB$_INVARG); set_errno(EINVAL);
     return NULL;
   }
-  if (!outbuf) {
-    if (ts) out = Newx(outbuf,VMS_MAXRSS,char);
-    else    outbuf = __rmsexpand_retbuf;
-  }
 
   vmsfspec = NULL;
-  tmpfspec = NULL;
+  vmsdefspec = NULL;
   outbufl = NULL;
 
+  in_spec = filespec;
   isunix = 0;
   if ((opts & PERL_RMSEXPAND_M_VMS_IN) == 0) {
-    isunix = is_unix_filespec(filespec);
-    if (isunix) {
-      vmsfspec = PerlMem_malloc(VMS_MAXRSS);
-      if (vmsfspec == NULL) _ckvmssts(SS$_INSFMEM);
-      if (do_tovmsspec(filespec,vmsfspec,0,fs_utf8) == NULL) {
-	PerlMem_free(vmsfspec);
-	if (out)
-	   Safefree(out);
-	return NULL;
-      }
-      filespec = vmsfspec;
+      char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec;
+      int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
+
+      /* If this is a UNIX file spec, convert it to VMS */
+      sts = vms_split_path(filespec, &v_spec, &v_len, &r_spec, &r_len,
+                           &d_spec, &d_len, &n_spec, &n_len, &e_spec,
+                           &e_len, &vs_spec, &vs_len);
+      if (sts != 0) {
+          isunix = 1;
+          char * ret_spec;
+
+          vmsfspec = PerlMem_malloc(VMS_MAXRSS);
+          if (vmsfspec == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+          ret_spec = int_tovmsspec(filespec, vmsfspec, 0, fs_utf8);
+          if (ret_spec == NULL) {
+              PerlMem_free(vmsfspec);
+              return NULL;
+          }
+          in_spec = (const char *)vmsfspec;
 
-      /* Unless we are forcing to VMS format, a UNIX input means
-       * UNIX output, and that requires long names to be used
-       */
+          /* Unless we are forcing to VMS format, a UNIX input means
+           * UNIX output, and that requires long names to be used
+           */
+          if ((opts & PERL_RMSEXPAND_M_VMS) == 0)
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
-      if ((opts & PERL_RMSEXPAND_M_VMS) == 0)
-	opts |= PERL_RMSEXPAND_M_LONG;
-      else
+              opts |= PERL_RMSEXPAND_M_LONG;
+#else
+              NOOP;
 #endif
-	isunix = 0;
+          else
+              isunix = 0;
       }
-    }
 
-  rms_set_fna(myfab, mynam, (char *)filespec, strlen(filespec)); /* cast ok */
+  }
+
+  rms_set_fna(myfab, mynam, (char *)in_spec, strlen(in_spec)); /* cast ok */
   rms_bind_fab_nam(myfab, mynam);
 
+  /* Process the default file specification if present */
+  def_spec = defspec;
   if (defspec && *defspec) {
     int t_isunix;
     t_isunix = is_unix_filespec(defspec);
     if (t_isunix) {
-      tmpfspec = PerlMem_malloc(VMS_MAXRSS);
-      if (tmpfspec == NULL) _ckvmssts(SS$_INSFMEM);
-      if (do_tovmsspec(defspec,tmpfspec,0,dfs_utf8) == NULL) {
-	PerlMem_free(tmpfspec);
-	if (vmsfspec != NULL)
-	    PerlMem_free(vmsfspec);
-	if (out)
-	   Safefree(out);
-	return NULL;
+      vmsdefspec = PerlMem_malloc(VMS_MAXRSS);
+      if (vmsdefspec == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+      ret_spec = int_tovmsspec(defspec, vmsdefspec, 0, dfs_utf8);
+
+      if (ret_spec == NULL) {
+          /* Clean up and bail */
+          PerlMem_free(vmsdefspec);
+          if (vmsfspec != NULL)
+              PerlMem_free(vmsfspec);
+              return NULL;
+          }
+          def_spec = (const char *)vmsdefspec;
       }
-      defspec = tmpfspec;
-    }
-    rms_set_dna(myfab, mynam, (char *)defspec, strlen(defspec)); /* cast ok */
+      rms_set_dna(myfab, mynam,
+                  (char *)def_spec, strlen(def_spec)); /* cast ok */
   }
 
+  /* Now we need the expansion buffers */
   esa = PerlMem_malloc(NAM$C_MAXRSS + 1);
-  if (esa == NULL) _ckvmssts(SS$_INSFMEM);
+  if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
   esal = PerlMem_malloc(VMS_MAXRSS);
-  if (esal == NULL) _ckvmssts(SS$_INSFMEM);
+  if (esal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 #endif
   rms_set_esal(mynam, esa, NAM$C_MAXRSS, esal, VMS_MAXRSS-1);
 
@@ -5399,7 +5674,7 @@ mp_do_rmsexpand
    */
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
   outbufl = PerlMem_malloc(VMS_MAXRSS);
-  if (outbufl == NULL) _ckvmssts(SS$_INSFMEM);
+  if (outbufl == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 #endif
    rms_set_rsal(mynam, outbuf, NAM$C_MAXRSS, outbufl, (VMS_MAXRSS - 1));
 
@@ -5420,17 +5695,19 @@ mp_do_rmsexpand
 
     /* Could not find the file, try as syntax only if error is not fatal */
     rms_set_nam_nop(mynam, NAM$M_SYNCHK);
-    if (retsts == RMS$_DNF || retsts == RMS$_DIR || retsts == RMS$_DEV) {
+    if (retsts == RMS$_DNF ||
+        retsts == RMS$_DIR ||
+        retsts == RMS$_DEV ||
+        retsts == RMS$_PRV) {
       retsts = sys$parse(&myfab,0,0);
-      if (retsts & STS$K_SUCCESS) goto expanded;
+      if (retsts & STS$K_SUCCESS) goto int_expanded;
     }  
 
      /* Still could not parse the file specification */
     /*----------------------------------------------*/
     sts = rms_free_search_context(&myfab); /* Free search context */
-    if (out) Safefree(out);
-    if (tmpfspec != NULL)
-	PerlMem_free(tmpfspec);
+    if (vmsdefspec != NULL)
+	PerlMem_free(vmsdefspec);
     if (vmsfspec != NULL)
 	PerlMem_free(vmsfspec);
     if (outbufl != NULL)
@@ -5448,9 +5725,8 @@ mp_do_rmsexpand
   retsts = sys$search(&myfab,0,0);
   if (!(retsts & STS$K_SUCCESS) && retsts != RMS$_FNF) {
     sts = rms_free_search_context(&myfab); /* Free search context */
-    if (out) Safefree(out);
-    if (tmpfspec != NULL)
-	PerlMem_free(tmpfspec);
+    if (vmsdefspec != NULL)
+	PerlMem_free(vmsdefspec);
     if (vmsfspec != NULL)
 	PerlMem_free(vmsfspec);
     if (outbufl != NULL)
@@ -5466,35 +5742,41 @@ mp_do_rmsexpand
 
   /* If the input filespec contained any lowercase characters,
    * downcase the result for compatibility with Unix-minded code. */
-  expanded:
+int_expanded:
   if (!decc_efs_case_preserve) {
+    char * tbuf;
     for (tbuf = rms_get_fna(myfab, mynam); *tbuf; tbuf++)
       if (islower(*tbuf)) { haslower = 1; break; }
   }
 
    /* Is a long or a short name expected */
   /*------------------------------------*/
+  spec_buf = NULL;
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
   if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
     if (rms_nam_rsll(mynam)) {
-	tbuf = outbufl;
+	spec_buf = outbufl;
 	speclen = rms_nam_rsll(mynam);
     }
     else {
-	tbuf = esal; /* Not esa */
+	spec_buf = esal; /* Not esa */
 	speclen = rms_nam_esll(mynam);
     }
   }
   else {
+#endif
     if (rms_nam_rsl(mynam)) {
-	tbuf = outbuf;
+	spec_buf = outbuf;
 	speclen = rms_nam_rsl(mynam);
     }
     else {
-	tbuf = esa; /* Not esal */
+	spec_buf = esa; /* Not esal */
 	speclen = rms_nam_esl(mynam);
     }
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
   }
-  tbuf[speclen] = '\0';
+#endif
+  spec_buf[speclen] = '\0';
 
   /* Trim off null fields added by $PARSE
    * If type > 1 char, must have been specified in original or default spec
@@ -5515,11 +5797,11 @@ mp_do_rmsexpand
       char *defesa = NULL;
       defesa = PerlMem_malloc(VMS_MAXRSS + 1);
       if (defesa != NULL) {
+        struct FAB deffab = cc$rms_fab;
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
         defesal = PerlMem_malloc(VMS_MAXRSS + 1);
-        if (defesal == NULL) _ckvmssts(SS$_INSFMEM);
+        if (defesal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 #endif
-	struct FAB deffab = cc$rms_fab;
 	rms_setup_nam(defnam);
      
 	rms_bind_fab_nam(deffab, defnam);
@@ -5552,34 +5834,36 @@ mp_do_rmsexpand
 	if (defesal != NULL)
 	    PerlMem_free(defesal);
 	PerlMem_free(defesa);
+      } else {
+          _ckvmssts_noperl(SS$_INSFMEM);
       }
     }
     if (trimver) {
       if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
 	if (*(rms_nam_verl(mynam)) != '\"')
-	  speclen = rms_nam_verl(mynam) - tbuf;
+	  speclen = rms_nam_verl(mynam) - spec_buf;
       }
       else {
 	if (*(rms_nam_ver(mynam)) != '\"')
-	  speclen = rms_nam_ver(mynam) - tbuf;
+	  speclen = rms_nam_ver(mynam) - spec_buf;
       }
     }
     if (trimtype) {
       /* If we didn't already trim version, copy down */
       if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
-	if (speclen > rms_nam_verl(mynam) - tbuf)
+	if (speclen > rms_nam_verl(mynam) - spec_buf)
 	  memmove
 	   (rms_nam_typel(mynam),
 	    rms_nam_verl(mynam),
-	    speclen - (rms_nam_verl(mynam) - tbuf));
+	    speclen - (rms_nam_verl(mynam) - spec_buf));
 	  speclen -= rms_nam_verl(mynam) - rms_nam_typel(mynam);
       }
       else {
-	if (speclen > rms_nam_ver(mynam) - tbuf)
+	if (speclen > rms_nam_ver(mynam) - spec_buf)
 	  memmove
 	   (rms_nam_type(mynam),
 	    rms_nam_ver(mynam),
-	    speclen - (rms_nam_ver(mynam) - tbuf));
+	    speclen - (rms_nam_ver(mynam) - spec_buf));
 	  speclen -= rms_nam_ver(mynam) - rms_nam_type(mynam);
       }
     }
@@ -5589,8 +5873,8 @@ mp_do_rmsexpand
   /*-------------------------------------------*/
   if (vmsfspec != NULL)
 	PerlMem_free(vmsfspec);
-  if (tmpfspec != NULL)
-	PerlMem_free(tmpfspec);
+  if (vmsdefspec != NULL)
+	PerlMem_free(vmsdefspec);
 
   /* If we just had a directory spec on input, $PARSE "helpfully"
    * adds an empty name and type for us */
@@ -5599,7 +5883,7 @@ mp_do_rmsexpand
     if (rms_nam_namel(mynam) == rms_nam_typel(mynam) &&
 	rms_nam_verl(mynam)  == rms_nam_typel(mynam) + 1 &&
 	!(rms_is_nam_fnb(mynam, NAM$M_EXP_NAME)))
-      speclen = rms_nam_namel(mynam) - tbuf;
+      speclen = rms_nam_namel(mynam) - spec_buf;
   }
   else
 #endif
@@ -5607,20 +5891,20 @@ mp_do_rmsexpand
     if (rms_nam_name(mynam) == rms_nam_type(mynam) &&
 	rms_nam_ver(mynam)  == rms_nam_ver(mynam) + 1 &&
 	!(rms_is_nam_fnb(mynam, NAM$M_EXP_NAME)))
-      speclen = rms_nam_name(mynam) - tbuf;
+      speclen = rms_nam_name(mynam) - spec_buf;
   }
 
   /* Posix format specifications must have matching quotes */
   if (speclen < (VMS_MAXRSS - 1)) {
-    if (decc_posix_compliant_pathnames && (tbuf[0] == '\"')) {
-      if ((speclen > 1) && (tbuf[speclen-1] != '\"')) {
-        tbuf[speclen] = '\"';
+    if (decc_posix_compliant_pathnames && (spec_buf[0] == '\"')) {
+      if ((speclen > 1) && (spec_buf[speclen-1] != '\"')) {
+        spec_buf[speclen] = '\"';
         speclen++;
       }
     }
   }
-  tbuf[speclen] = '\0';
-  if (haslower && !decc_efs_case_preserve) __mystrtolower(tbuf);
+  spec_buf[speclen] = '\0';
+  if (haslower && !decc_efs_case_preserve) __mystrtolower(spec_buf);
 
   /* Have we been working with an expanded, but not resultant, spec? */
   /* Also, convert back to Unix syntax if necessary. */
@@ -5636,44 +5920,118 @@ mp_do_rmsexpand
       rsl = rms_nam_rsl(mynam);
     }
     if (!rsl) {
+      /* rsl is not present, it means that spec_buf is either */
+      /* esa or esal, and needs to be copied to outbuf */
+      /* convert to Unix if desired */
       if (isunix) {
-        if (do_tounixspec(tbuf, outbuf ,0 , fs_utf8) == NULL) {
-	  if (out) Safefree(out);
-	  if (esal != NULL)
-	    PerlMem_free(esal);
-	  PerlMem_free(esa);
-	  if (outbufl != NULL)
-	    PerlMem_free(outbufl);
-	  return NULL;
-        }
+        ret_spec = int_tounixspec(spec_buf, outbuf, fs_utf8);
+      } else {
+        /* VMS file specs are not in UTF-8 */
+        if (fs_utf8 != NULL)
+            *fs_utf8 = 0;
+        strcpy(outbuf, spec_buf);
+        ret_spec = outbuf;
       }
-      else strcpy(outbuf, tbuf);
     }
-    else if (isunix) {
-      tmpfspec = PerlMem_malloc(VMS_MAXRSS);
-      if (tmpfspec == NULL) _ckvmssts(SS$_INSFMEM);
-      if (do_tounixspec(tbuf,tmpfspec,0,fs_utf8) == NULL) {
-	if (out) Safefree(out);
-	PerlMem_free(esa);
-	if (esal != NULL)
-	    PerlMem_free(esal);
-	PerlMem_free(tmpfspec);
-	if (outbufl != NULL)
-	    PerlMem_free(outbufl);
-	return NULL;
+    else {
+      /* Now spec_buf is either outbuf or outbufl */
+      /* We need the result into outbuf */
+      if (isunix) {
+           /* If we need this in UNIX, then we need another buffer */
+           /* to keep things in order */
+           char * src;
+           char * new_src = NULL;
+           if (spec_buf == outbuf) {
+               new_src = PerlMem_malloc(VMS_MAXRSS);
+               strcpy(new_src, spec_buf);
+           } else {
+               src = spec_buf;
+           }
+           ret_spec = int_tounixspec(src, outbuf, fs_utf8);
+           if (new_src) {
+               PerlMem_free(new_src);
+           }
+      } else {
+           /* VMS file specs are not in UTF-8 */
+           if (fs_utf8 != NULL)
+               *fs_utf8 = 0;
+
+           /* Copy the buffer if needed */
+           if (outbuf != spec_buf)
+               strcpy(outbuf, spec_buf);
+           ret_spec = outbuf;
       }
-      strcpy(outbuf,tmpfspec);
-      PerlMem_free(tmpfspec);
     }
   }
+
+  /* Need to clean up the search context */
   rms_set_rsal(mynam, NULL, 0, NULL, 0);
   sts = rms_free_search_context(&myfab); /* Free search context */
-  PerlMem_free(esa);
+
+  /* Clean up the extra buffers */
   if (esal != NULL)
-     PerlMem_free(esal);
+      PerlMem_free(esal);
+  PerlMem_free(esa);
   if (outbufl != NULL)
      PerlMem_free(outbufl);
-  return outbuf;
+
+  /* Return the result */
+  return ret_spec;
+}
+
+/* Common simple case - Expand an already VMS spec */
+static char * 
+int_rmsexpand_vms(const char * filespec, char * outbuf, unsigned opts) {
+    opts |= PERL_RMSEXPAND_M_VMS_IN;
+    return int_rmsexpand(filespec, outbuf, NULL, opts, NULL, NULL); 
+}
+
+/* Common simple case - Expand to a VMS spec */
+static char * 
+int_rmsexpand_tovms(const char * filespec, char * outbuf, unsigned opts) {
+    opts |= PERL_RMSEXPAND_M_VMS;
+    return int_rmsexpand(filespec, outbuf, NULL, opts, NULL, NULL); 
+}
+
+
+/* Entry point used by perl routines */
+static char *
+mp_do_rmsexpand
+   (pTHX_ const char *filespec,
+    char *outbuf,
+    int ts,
+    const char *defspec,
+    unsigned opts,
+    int * fs_utf8,
+    int * dfs_utf8)
+{
+    static char __rmsexpand_retbuf[VMS_MAXRSS];
+    char * expanded, *ret_spec, *ret_buf;
+
+    expanded = NULL;
+    ret_buf = outbuf;
+    if (ret_buf == NULL) {
+        if (ts) {
+            Newx(expanded, VMS_MAXRSS, char);
+            if (expanded == NULL)
+                _ckvmssts(SS$_INSFMEM);
+            ret_buf = expanded;
+        } else {
+            ret_buf = __rmsexpand_retbuf;
+        }
+    }
+
+
+    ret_spec = int_rmsexpand(filespec, ret_buf, defspec,
+                             opts, fs_utf8,  dfs_utf8);
+
+    if (ret_spec == NULL) {
+       /* Cleanup on isle 5, if this is thread specific we need to deallocate */
+       if (expanded)
+           Safefree(expanded);
+    }
+
+    return ret_spec;
 }
 /*}}}*/
 /* External entry points */
@@ -5726,14 +6084,16 @@ char *Perl_rmsexpand_utf8_ts
 ** found in the Perl standard distribution.
  */
 
-/*{{{ char *fileify_dirspec[_ts](char *dir, char *buf, int * utf8_fl)*/
-static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *utf8_fl)
+/*{{{ char * int_fileify_dirspec[_ts](char *dir, char *buf, int * utf8_fl)*/
+static char *
+int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl)
 {
-    static char __fileify_retbuf[VMS_MAXRSS];
     unsigned long int dirlen, retlen, addmfd = 0, hasfilename = 0;
-    char *retspec, *cp1, *cp2, *lastdir;
+    char *cp1, *cp2, *lastdir;
     char *trndir, *vmsdir;
     unsigned short int trnlnm_iter_count;
+    int is_vms = 0;
+    int is_unix = 0;
     int sts;
     if (utf8_fl != NULL)
 	*utf8_fl = 0;
@@ -5756,12 +6116,12 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
       return NULL;
     }
     trndir = PerlMem_malloc(VMS_MAXRSS + 1);
-    if (trndir == NULL) _ckvmssts(SS$_INSFMEM);
+    if (trndir == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     if (!strpbrk(dir+1,"/]>:")  &&
 	(!decc_posix_compliant_pathnames && decc_disable_posix_root)) {
       strcpy(trndir,*dir == '/' ? dir + 1: dir);
       trnlnm_iter_count = 0;
-      while (!strpbrk(trndir,"/]>:") && my_trnlnm(trndir,trndir,0)) {
+      while (!strpbrk(trndir,"/]>:") && simple_trnlnm(trndir,trndir,VMS_MAXRSS-1)) {
         trnlnm_iter_count++; 
         if (trnlnm_iter_count >= PERL_LNM_MAX_ITER) break;
       }
@@ -5812,20 +6172,45 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
     }
 
     vmsdir = PerlMem_malloc(VMS_MAXRSS + 1);
-    if (vmsdir == NULL) _ckvmssts(SS$_INSFMEM);
+    if (vmsdir == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     cp1 = strpbrk(trndir,"]:>");
-    if (hasfilename || !cp1) { /* Unix-style path or filename */
+    if (hasfilename || !cp1) { /* filename present or not VMS */
+
+      if (decc_efs_charset && !cp1) {
+
+          /* EFS handling for UNIX mode */
+
+          /* Just remove the trailing '/' and we should be done */
+          STRLEN trndir_len;
+          trndir_len = strlen(trndir);
+
+          if (trndir_len > 1) {
+              trndir_len--;
+              if (trndir[trndir_len] == '/') {
+                  trndir[trndir_len] = '\0';
+              }
+          }
+          strcpy(buf, trndir);
+          PerlMem_free(trndir);
+          PerlMem_free(vmsdir);
+          return buf;
+      }
+
+      /* For non-EFS mode, this is left for backwards compatibility */
+      /* For EFS mode, this is only done for VMS format filespecs as */
+      /* Perl programs generally have problems when a UNIX format spec */
+      /* returns a VMS format spec */
       if (trndir[0] == '.') {
         if (trndir[1] == '\0' || (trndir[1] == '/' && trndir[2] == '\0')) {
 	  PerlMem_free(trndir);
 	  PerlMem_free(vmsdir);
-          return do_fileify_dirspec("[]",buf,ts,NULL);
+          return int_fileify_dirspec("[]", buf, NULL);
 	}
         else if (trndir[1] == '.' &&
                (trndir[2] == '\0' || (trndir[2] == '/' && trndir[3] == '\0'))) {
 	  PerlMem_free(trndir);
 	  PerlMem_free(vmsdir);
-          return do_fileify_dirspec("[-]",buf,ts,NULL);
+          return int_fileify_dirspec("[-]", buf, NULL);
 	}
       }
       if (dirlen && trndir[dirlen-1] == '/') {    /* path ends with '/'; just add .dir;1 */
@@ -5840,13 +6225,13 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
           if (*(cp1+2) == '.') cp1++;
           if (*(cp1+2) == '/' || *(cp1+2) == '\0') {
 	    char * ret_chr;
-            if (do_tovmsspec(trndir,vmsdir,0,NULL) == NULL) {
+            if (int_tovmsspec(trndir, vmsdir, 0, utf8_fl) == NULL) {
 		PerlMem_free(trndir);
 		PerlMem_free(vmsdir);
 		return NULL;
 	    }
             if (strchr(vmsdir,'/') != NULL) {
-              /* If do_tovmsspec() returned it, it must have VMS syntax
+              /* If int_tovmsspec() returned it, it must have VMS syntax
                * delimiters in it, so it's a mixed VMS/Unix spec.  We take
                * the time to check this here only so we avoid a recursion
                * loop; otherwise, gigo.
@@ -5856,12 +6241,12 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
               set_errno(EINVAL);  set_vaxc_errno(RMS$_SYN);
 	      return NULL;
             }
-            if (do_fileify_dirspec(vmsdir,trndir,0,NULL) == NULL) {
+            if (int_fileify_dirspec(vmsdir, trndir, NULL) == NULL) {
 		PerlMem_free(trndir);
 		PerlMem_free(vmsdir);
 		return NULL;
 	    }
-	    ret_chr = do_tounixspec(trndir,buf,ts,NULL);
+	    ret_chr = int_tounixspec(trndir, buf, utf8_fl);
 	    PerlMem_free(trndir);
 	    PerlMem_free(vmsdir);
             return ret_chr;
@@ -5882,17 +6267,17 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
          */
 
         trndir[dirlen] = '/'; trndir[dirlen+1] = '\0';
-        if (do_tovmsspec(trndir,vmsdir,0,NULL) == NULL) {
+        if (int_tovmsspec(trndir, vmsdir, 0, NULL) == NULL) {
 	    PerlMem_free(trndir);
 	    PerlMem_free(vmsdir);
 	    return NULL;
 	}
-        if (do_fileify_dirspec(vmsdir,trndir,0,NULL) == NULL) {
+        if (int_fileify_dirspec(vmsdir, trndir, NULL) == NULL) {
 	    PerlMem_free(trndir);
 	    PerlMem_free(vmsdir);
 	    return NULL;
 	}
-	ret_chr = do_tounixspec(trndir,buf,ts,NULL);
+	ret_chr = int_tounixspec(trndir, buf, utf8_fl);
 	PerlMem_free(trndir);
 	PerlMem_free(vmsdir);
         return ret_chr;
@@ -5902,61 +6287,95 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
         if ( !(lastdir = cp1 = strrchr(trndir,'/')) &&
              !(lastdir = cp1 = strrchr(trndir,']')) &&
              !(lastdir = cp1 = strrchr(trndir,'>'))) cp1 = trndir;
-        if ((cp2 = strchr(cp1,'.'))) {  /* look for explicit type */
-          int ver; char *cp3;
 
-	  /* For EFS or ODS-5 look for the last dot */
-	  if (decc_efs_charset) {
-	      cp2 = strrchr(cp1,'.');
-	  }
-	  if (vms_process_case_tolerant) {
-              if (!*(cp2+1) || toupper(*(cp2+1)) != 'D' ||  /* Wrong type. */
-                  !*(cp2+2) || toupper(*(cp2+2)) != 'I' ||  /* Bzzt. */
-                  !*(cp2+3) || toupper(*(cp2+3)) != 'R' ||
-                  (*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.')  ||
-                  (*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
-                            (ver || *cp3)))))) {
-		  PerlMem_free(trndir);
-		  PerlMem_free(vmsdir);
-                  set_errno(ENOTDIR);
-                  set_vaxc_errno(RMS$_DIR);
-                  return NULL;
-	      }
-	  }
-	  else {
-              if (!*(cp2+1) || *(cp2+1) != 'D' ||  /* Wrong type. */
-                  !*(cp2+2) || *(cp2+2) != 'I' ||  /* Bzzt. */
-                  !*(cp2+3) || *(cp2+3) != 'R' ||
-                  (*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.')  ||
-                  (*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
-                            (ver || *cp3)))))) {
-		 PerlMem_free(trndir);
-		 PerlMem_free(vmsdir);
-                 set_errno(ENOTDIR);
-                 set_vaxc_errno(RMS$_DIR);
-                 return NULL;
-	      }
-          }
-          dirlen = cp2 - trndir;
+        cp2 = strrchr(cp1,'.');
+        if (cp2) {
+            int e_len, vs_len = 0;
+            int is_dir = 0;
+            char * cp3;
+            cp3 = strchr(cp2,';');
+            e_len = strlen(cp2);
+            if (cp3) {
+                vs_len = strlen(cp3);
+                e_len = e_len - vs_len;
+            }
+            is_dir = is_dir_ext(cp2, e_len, cp3, vs_len);
+            if (!is_dir) {
+                if (!decc_efs_charset) {
+                    /* If this is not EFS, then not a directory */
+                    PerlMem_free(trndir);
+                    PerlMem_free(vmsdir);
+                    set_errno(ENOTDIR);
+                    set_vaxc_errno(RMS$_DIR);
+                    return NULL;
+                }
+            } else {
+                /* Ok, here we have an issue, technically if a .dir shows */
+                /* from inside a directory, then we should treat it as */
+                /* xxx^.dir.dir.  But we do not have that context at this */
+                /* point unless this is totally restructured, so we remove */
+                /* The .dir for now, and fix this better later */
+                dirlen = cp2 - trndir;
+            }
         }
+
       }
 
       retlen = dirlen + 6;
-      if (buf) retspec = buf;
-      else if (ts) Newx(retspec,retlen+1,char);
-      else retspec = __fileify_retbuf;
-      memcpy(retspec,trndir,dirlen);
-      retspec[dirlen] = '\0';
+      memcpy(buf, trndir, dirlen);
+      buf[dirlen] = '\0';
 
       /* We've picked up everything up to the directory file name.
          Now just add the type and version, and we're set. */
-      if ((!decc_efs_case_preserve) && vms_process_case_tolerant)
-	strcat(retspec,".dir;1");
-      else
-	strcat(retspec,".DIR;1");
+
+      /* We should only add type for VMS syntax, but historically Perl
+         has added it for UNIX style also */
+
+      /* Fix me - we should not be using the same routine for VMS and
+         UNIX format files.  Things are too tangled so we need to lookup
+         what syntax the output is */
+
+      is_unix = 0;
+      is_vms = 0;
+      lastdir = strrchr(trndir,'/');
+      if (lastdir) {
+          is_unix = 1;
+      } else {
+          lastdir = strpbrk(trndir,"]:>");
+          if (lastdir) {
+              is_vms = 1;
+          }
+      }
+
+      if ((is_vms == 0) && (is_unix == 0)) {
+          /* We still do not  know? */
+          is_unix = decc_filename_unix_report;
+          if (is_unix == 0)
+              is_vms = 1;
+      }
+
+      if ((is_unix && !decc_efs_charset) || is_vms) {
+
+           /* It is a bug to add a .dir to a UNIX format directory spec */
+           /* However Perl on VMS may have programs that expect this so */
+           /* If not using EFS character specifications allow it. */
+
+           if ((!decc_efs_case_preserve) && vms_process_case_tolerant) {
+               /* Traditionally Perl expects filenames in lower case */
+               strcat(buf, ".dir");
+           } else {
+               /* VMS expects the .DIR to be in upper case */
+               strcat(buf, ".DIR");
+           }
+
+           /* It is also a bug to put a VMS format version on a UNIX file */
+           /* specification.  Perl self tests are looking for this */
+           if (is_vms || !(decc_efs_charset || decc_filename_unix_report))
+               strcat(buf, ";1");
+      }
       PerlMem_free(trndir);
       PerlMem_free(vmsdir);
-      return retspec;
+      return buf;
     }
     else {  /* VMS-style directory spec */
 
@@ -5971,11 +6390,11 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
       rms_setup_nam(dirnam);
 
       esa = PerlMem_malloc(NAM$C_MAXRSS + 1);
-      if (esa == NULL) _ckvmssts(SS$_INSFMEM);
+      if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
       esal = NULL;
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
       esal = PerlMem_malloc(VMS_MAXRSS);
-      if (esal == NULL) _ckvmssts(SS$_INSFMEM);
+      if (esal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 #endif
       rms_set_fna(dirfab, dirnam, trndir, strlen(trndir));
       rms_bind_fab_nam(dirfab, dirnam);
@@ -5989,9 +6408,11 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
       for (cp = trndir; *cp; cp++)
         if (islower(*cp)) { haslower = 1; break; }
       if (!((sts = sys$parse(&dirfab)) & STS$K_SUCCESS)) {
-        if ((dirfab.fab$l_sts == RMS$_DIR) || (dirfab.fab$l_sts == RMS$_DNF)) {
-	  rms_set_nam_nop(dirnam, NAM$M_SYNCHK);
-          sts = sys$parse(&dirfab) & STS$K_SUCCESS;
+        if ((dirfab.fab$l_sts == RMS$_DIR) ||
+            (dirfab.fab$l_sts == RMS$_DNF) ||
+            (dirfab.fab$l_sts == RMS$_PRV)) {
+            rms_set_nam_nop(dirnam, NAM$M_SYNCHK);
+            sts = sys$parse(&dirfab);
         }
         if (!sts) {
 	  PerlMem_free(esa);
@@ -6009,7 +6430,7 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
 	/* Does the file really exist? */
         if (sys$search(&dirfab)& STS$K_SUCCESS) { 
           /* Yes; fake the fnb bits so we'll check type below */
-	rms_set_nam_fnb(dirnam, (NAM$M_EXP_TYPE | NAM$M_EXP_VER));
+          rms_set_nam_fnb(dirnam, (NAM$M_EXP_TYPE | NAM$M_EXP_VER));
         }
         else { /* No; just work with potential name */
           if (dirfab.fab$l_sts == RMS$_FNF) dirnam = savnam;
@@ -6029,13 +6450,17 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
       }
 
       /* Make sure we are using the right buffer */
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
       if (esal != NULL) {
 	my_esa = esal;
 	my_esa_len = rms_nam_esll(dirnam);
       } else {
+#endif
 	my_esa = esa;
         my_esa_len = rms_nam_esl(dirnam);
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
       }
+#endif
       my_esa[my_esa_len] = '\0';
       if (!rms_is_nam_fnb(dirnam, (NAM$M_EXP_DEV | NAM$M_EXP_DIR))) {
         cp1 = strchr(my_esa,']');
@@ -6064,17 +6489,14 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
 
       if (rms_is_nam_fnb(dirnam, NAM$M_EXP_NAME)) {
         /* They provided at least the name; we added the type, if necessary, */
-        if (buf) retspec = buf;                            /* in sys$parse() */
-        else if (ts) Newx(retspec, my_esa_len + 1, char);
-        else retspec = __fileify_retbuf;
-        strcpy(retspec,my_esa);
+        strcpy(buf, my_esa);
 	sts = rms_free_search_context(&dirfab);
 	PerlMem_free(trndir);
 	PerlMem_free(esa);
 	if (esal != NULL)
 	    PerlMem_free(esal);
 	PerlMem_free(vmsdir);
-        return retspec;
+        return buf;
       }
       if ((cp1 = strstr(esa,".][000000]")) != NULL) {
         for (cp2 = cp1 + 9; *cp2; cp1++,cp2++) *cp1 = *cp2;
@@ -6112,10 +6534,7 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
       if ((cp1) != NULL) {
         /* There's more than one directory in the path.  Just roll back. */
         *cp1 = term;
-        if (buf) retspec = buf;
-        else if (ts) Newx(retspec,retlen+7,char);
-        else retspec = __fileify_retbuf;
-        strcpy(retspec,my_esa);
+        strcpy(buf, my_esa);
       }
       else {
         if (rms_is_nam_fnb(dirnam, NAM$M_ROOT_DIR)) {
@@ -6145,18 +6564,15 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
 	  }
 
           retlen = my_esa_len - 9; /* esa - '][' - '].DIR;1' */
-          if (buf) retspec = buf;
-          else if (ts) Newx(retspec,retlen+16,char);
-          else retspec = __fileify_retbuf;
           cp1 = strstr(my_esa,"][");
           if (!cp1) cp1 = strstr(my_esa,"]<");
           dirlen = cp1 - my_esa;
-          memcpy(retspec,my_esa,dirlen);
+          memcpy(buf, my_esa, dirlen);
           if (!strncmp(cp1+2,"000000]",7)) {
-            retspec[dirlen-1] = '\0';
+            buf[dirlen-1] = '\0';
 	    /* fix-me Not full ODS-5, just extra dots in directories for now */
-	    cp1 = retspec + dirlen - 1;
-	    while (cp1 > retspec)
+	    cp1 = buf + dirlen - 1;
+	    while (cp1 > buf)
 	    {
 	      if (*cp1 == '[')
 		break;
@@ -6168,36 +6584,33 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
 	    }
             if (*cp1 == '.') *cp1 = ']';
             else {
-              memmove(cp1+8,cp1+1,retspec+dirlen-cp1);
+              memmove(cp1+8, cp1+1, buf+dirlen-cp1);
               memmove(cp1+1,"000000]",7);
             }
           }
           else {
-            memmove(retspec+dirlen,cp1+2,retlen-dirlen);
-            retspec[retlen] = '\0';
+            memmove(buf+dirlen, cp1+2, retlen-dirlen);
+            buf[retlen] = '\0';
             /* Convert last '.' to ']' */
-            cp1 = retspec+retlen-1;
+            cp1 = buf+retlen-1;
 	    while (*cp != '[') {
 	      cp1--;
 	      if (*cp1 == '.') {
 		/* Do not trip on extra dots in ODS-5 directories */
-		if ((cp1 == retspec) || (*(cp1-1) != '^'))
+		if ((cp1 == buf) || (*(cp1-1) != '^'))
 		break;
 	      }
 	    }
             if (*cp1 == '.') *cp1 = ']';
             else {
-              memmove(cp1+8,cp1+1,retspec+dirlen-cp1);
+              memmove(cp1+8, cp1+1, buf+dirlen-cp1);
               memmove(cp1+1,"000000]",7);
             }
           }
         }
         else {  /* This is a top-level dir.  Add the MFD to the path. */
-          if (buf) retspec = buf;
-          else if (ts) Newx(retspec,retlen+16,char);
-          else retspec = __fileify_retbuf;
           cp1 = my_esa;
-          cp2 = retspec;
+          cp2 = buf;
           while ((*cp1 != ':')  && (*cp1 != '\0')) *(cp2++) = *(cp1++);
           strcpy(cp2,":[000000]");
           cp1 += 2;
@@ -6207,20 +6620,52 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
       sts = rms_free_search_context(&dirfab);
       /* We've set up the string up through the filename.  Add the
          type and version, and we're done. */
-      strcat(retspec,".DIR;1");
+      strcat(buf,".DIR;1");
 
       /* $PARSE may have upcased filespec, so convert output to lower
        * case if input contained any lowercase characters. */
-      if (haslower && !decc_efs_case_preserve) __mystrtolower(retspec);
+      if (haslower && !decc_efs_case_preserve) __mystrtolower(buf);
       PerlMem_free(trndir);
       PerlMem_free(esa);
       if (esal != NULL)
 	PerlMem_free(esal);
       PerlMem_free(vmsdir);
-      return retspec;
+      return buf;
     }
+}  /* end of int_fileify_dirspec() */
+
+
+/*{{{ char *fileify_dirspec[_ts](char *dir, char *buf, int * utf8_fl)*/
+static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *utf8_fl)
+{
+    static char __fileify_retbuf[VMS_MAXRSS];
+    char * fileified, *ret_spec, *ret_buf;
+
+    fileified = NULL;
+    ret_buf = buf;
+    if (ret_buf == NULL) {
+        if (ts) {
+            Newx(fileified, VMS_MAXRSS, char);
+            if (fileified == NULL)
+                _ckvmssts(SS$_INSFMEM);
+            ret_buf = fileified;
+        } else {
+            ret_buf = __fileify_retbuf;
+        }
+    }
+
+    ret_spec = int_fileify_dirspec(dir, ret_buf, utf8_fl);
+
+    if (ret_spec == NULL) {
+       /* Cleanup on isle 5, if this is thread specific we need to deallocate */
+       if (fileified)
+           Safefree(fileified);
+    }
+
+    return ret_spec;
 }  /* end of do_fileify_dirspec() */
 /*}}}*/
+
 /* External entry points */
 char *Perl_fileify_dirspec(pTHX_ const char *dir, char *buf)
 { return do_fileify_dirspec(dir,buf,0,NULL); }
@@ -6231,281 +6676,419 @@ char *Perl_fileify_dirspec_utf8(pTHX_ const char *dir, char *buf, int * utf8_fl)
 char *Perl_fileify_dirspec_utf8_ts(pTHX_ const char *dir, char *buf, int * utf8_fl)
 { return do_fileify_dirspec(dir,buf,1,utf8_fl); }
 
-/*{{{ char *pathify_dirspec[_ts](char *path, char *buf)*/
-static char *mp_do_pathify_dirspec(pTHX_ const char *dir,char *buf, int ts, int * utf8_fl)
+static char * int_pathify_dirspec_simple(const char * dir, char * buf,
+    char * v_spec, int v_len, char * r_spec, int r_len,
+    char * d_spec, int d_len, char * n_spec, int n_len,
+    char * e_spec, int e_len, char * vs_spec, int vs_len) {
+
+    /* VMS specification - Try to do this the simple way */
+    if ((v_len + r_len > 0) || (d_len > 0)) {
+        int is_dir;
+
+        /* No name or extension component, already a directory */
+        if ((n_len + e_len + vs_len) == 0) {
+            strcpy(buf, dir);
+            return buf;
+        }
+
+        /* Special case, we may get [.foo]bar instead of [.foo]bar.dir */
+        /* This results from catfile() being used instead of catdir() */
+        /* So even though it should not work, we need to allow it */
+
+        /* If this is .DIR;1 then do a simple conversion */
+        is_dir = is_dir_ext(e_spec, e_len, vs_spec, vs_len);
+        if (is_dir || (e_len == 0) && (d_len > 0)) {
+             int len;
+             len = v_len + r_len + d_len - 1;
+             char dclose = d_spec[d_len - 1];
+             strncpy(buf, dir, len);
+             buf[len] = '.';
+             len++;
+             strncpy(&buf[len], n_spec, n_len);
+             len += n_len;
+             buf[len] = dclose;
+             buf[len + 1] = '\0';
+             return buf;
+        }
+
+#ifdef HAS_SYMLINK
+        else if (d_len > 0) {
+            /* In the olden days, a directory needed to have a .DIR */
+            /* extension to be a valid directory, but now it could  */
+            /* be a symbolic link */
+            int len;
+            len = v_len + r_len + d_len - 1;
+            char dclose = d_spec[d_len - 1];
+            strncpy(buf, dir, len);
+            buf[len] = '.';
+            len++;
+            strncpy(&buf[len], n_spec, n_len);
+            len += n_len;
+            if (e_len > 0) {
+                if (decc_efs_charset) {
+                    buf[len] = '^';
+                    len++;
+                    strncpy(&buf[len], e_spec, e_len);
+                    len += e_len;
+                } else {
+                    set_vaxc_errno(RMS$_DIR);
+                    set_errno(ENOTDIR);
+                    return NULL;
+                }
+            }
+            buf[len] = dclose;
+            buf[len + 1] = '\0';
+            return buf;
+        }
+#else
+        else {
+            set_vaxc_errno(RMS$_DIR);
+            set_errno(ENOTDIR);
+            return NULL;
+        }
+#endif
+    }
+    set_vaxc_errno(RMS$_DIR);
+    set_errno(ENOTDIR);
+    return NULL;
+}
+
+
+/* Internal routine to make sure or convert a directory to be in a */
+/* path specification.  No utf8 flag because it is not changed or used */
+static char *int_pathify_dirspec(const char *dir, char *buf)
 {
-    static char __pathify_retbuf[VMS_MAXRSS];
-    unsigned long int retlen;
-    char *retpath, *cp1, *cp2, *trndir;
+    char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec;
+    int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
+    char * exp_spec, *ret_spec;
+    char * trndir;
     unsigned short int trnlnm_iter_count;
     STRLEN trnlen;
-    int sts;
-    if (utf8_fl != NULL)
-	*utf8_fl = 0;
+    int need_to_lower;
+
+    if (vms_debug_fileify) {
+        if (dir == NULL)
+            fprintf(stderr, "int_pathify_dirspec: dir = NULL\n");
+        else
+            fprintf(stderr, "int_pathify_dirspec: dir = %s\n", dir);
+    }
+
+    /* We may need to lower case the result if we translated  */
+    /* a logical name or got the current working directory */
+    need_to_lower = 0;
 
     if (!dir || !*dir) {
-      set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL;
+      set_errno(EINVAL);
+      set_vaxc_errno(SS$_BADPARAM);
+      return NULL;
     }
 
     trndir = PerlMem_malloc(VMS_MAXRSS);
-    if (trndir == NULL) _ckvmssts(SS$_INSFMEM);
-    if (*dir) strcpy(trndir,dir);
-    else getcwd(trndir,VMS_MAXRSS - 1);
+    if (trndir == NULL)
+        _ckvmssts_noperl(SS$_INSFMEM);
+
+    /* If no directory specified use the current default */
+    if (*dir)
+        strcpy(trndir, dir);
+    else {
+        getcwd(trndir, VMS_MAXRSS - 1);
+        need_to_lower = 1;
+    }
 
+    /* now deal with bare names that could be logical names */
     trnlnm_iter_count = 0;
     while (!strpbrk(trndir,"/]:>") && !no_translate_barewords
-	   && my_trnlnm(trndir,trndir,0)) {
-      trnlnm_iter_count++; 
-      if (trnlnm_iter_count >= PERL_LNM_MAX_ITER) break;
-      trnlen = strlen(trndir);
-
-      /* Trap simple rooted lnms, and return lnm:[000000] */
-      if (!strcmp(trndir+trnlen-2,".]")) {
-        if (buf) retpath = buf;
-        else if (ts) Newx(retpath,strlen(dir)+10,char);
-        else retpath = __pathify_retbuf;
-        strcpy(retpath,dir);
-        strcat(retpath,":[000000]");
-	PerlMem_free(trndir);
-        return retpath;
-      }
+           && simple_trnlnm(trndir, trndir, VMS_MAXRSS)) {
+        trnlnm_iter_count++; 
+        need_to_lower = 1;
+        if (trnlnm_iter_count >= PERL_LNM_MAX_ITER)
+            break;
+        trnlen = strlen(trndir);
+
+        /* Trap simple rooted lnms, and return lnm:[000000] */
+        if (!strcmp(trndir+trnlen-2,".]")) {
+            strcpy(buf, dir);
+            strcat(buf, ":[000000]");
+            PerlMem_free(trndir);
+
+            if (vms_debug_fileify) {
+                fprintf(stderr, "int_pathify_dirspec: buf = %s\n", buf);
+            }
+            return buf;
+        }
     }
 
-    /* At this point we do not work with *dir, but the copy in
-     * *trndir that is modifiable.
-     */
+    /* At this point we do not work with *dir, but the copy in  *trndir */
 
-    if (!strpbrk(trndir,"]:>")) { /* Unix-style path or plain name */
-      if (*trndir == '.' && (*(trndir+1) == '\0' ||
-                          (*(trndir+1) == '.' && *(trndir+2) == '\0')))
-        retlen = 2 + (*(trndir+1) != '\0');
-      else {
-        if ( !(cp1 = strrchr(trndir,'/')) &&
-             !(cp1 = strrchr(trndir,']')) &&
-             !(cp1 = strrchr(trndir,'>')) ) cp1 = trndir;
-        if ((cp2 = strchr(cp1,'.')) != NULL &&
-            (*(cp2-1) != '/' ||                /* Trailing '.', '..', */
-             !(*(cp2+1) == '\0' ||             /* or '...' are dirs.  */
-              (*(cp2+1) == '.' && *(cp2+2) == '\0') ||
-              (*(cp2+1) == '.' && *(cp2+2) == '.' && *(cp2+3) == '\0')))) {
-          int ver; char *cp3;
-
-	  /* For EFS or ODS-5 look for the last dot */
-	  if (decc_efs_charset) {
-	    cp2 = strrchr(cp1,'.');
-	  }
-	  if (vms_process_case_tolerant) {
-              if (!*(cp2+1) || toupper(*(cp2+1)) != 'D' ||  /* Wrong type. */
-                  !*(cp2+2) || toupper(*(cp2+2)) != 'I' ||  /* Bzzt. */
-                  !*(cp2+3) || toupper(*(cp2+3)) != 'R' ||
-                  (*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.')  ||
-                  (*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
-                            (ver || *cp3)))))) {
-		PerlMem_free(trndir);
-                set_errno(ENOTDIR);
-                set_vaxc_errno(RMS$_DIR);
-                return NULL;
-              }
-	  }
-	  else {
-              if (!*(cp2+1) || *(cp2+1) != 'D' ||  /* Wrong type. */
-                  !*(cp2+2) || *(cp2+2) != 'I' ||  /* Bzzt. */
-                  !*(cp2+3) || *(cp2+3) != 'R' ||
-                  (*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.')  ||
-                  (*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
-                            (ver || *cp3)))))) {
-		PerlMem_free(trndir);
-                set_errno(ENOTDIR);
-                set_vaxc_errno(RMS$_DIR);
-                return NULL;
-              }
-	  }
-          retlen = cp2 - trndir + 1;
-        }
-        else {  /* No file type present.  Treat the filename as a directory. */
-          retlen = strlen(trndir) + 1;
+    if (need_to_lower && !decc_efs_case_preserve) {
+        /* Legacy mode, lower case the returned value */
+        __mystrtolower(trndir);
+    }
+
+
+    /* Some special cases, '..', '.' */
+    sts = 0;
+    if ((trndir[0] == '.') && ((trndir[1] == '.') || (trndir[1] == '\0'))) {
+       /* Force UNIX filespec */
+       sts = 1;
+
+    } else {
+        /* Is this Unix or VMS format? */
+        sts = vms_split_path(trndir, &v_spec, &v_len, &r_spec, &r_len,
+                             &d_spec, &d_len, &n_spec, &n_len, &e_spec,
+                             &e_len, &vs_spec, &vs_len);
+        if (sts == 0) {
+
+            /* Just a filename? */
+            if ((v_len + r_len + d_len) == 0) {
+
+                /* Now we have a problem, this could be Unix or VMS */
+                /* We have to guess.  .DIR usually means VMS */
+
+                /* In UNIX report mode, the .DIR extension is removed */
+                /* if one shows up, it is for a non-directory or a directory */
+                /* in EFS charset mode */
+
+                /* So if we are in Unix report mode, assume that this */
+                /* is a relative Unix directory specification */
+
+                sts = 1;
+                if (!decc_filename_unix_report && decc_efs_charset) {
+                    int is_dir;
+                    is_dir = is_dir_ext(e_spec, e_len, vs_spec, vs_len);
+
+                    if (is_dir) {
+                        /* Traditional mode, assume .DIR is directory */
+                        buf[0] = '[';
+                        buf[1] = '.';
+                        strncpy(&buf[2], n_spec, n_len);
+                        buf[n_len + 2] = ']';
+                        buf[n_len + 3] = '\0';
+                        PerlMem_free(trndir);
+                        if (vms_debug_fileify) {
+                            fprintf(stderr,
+                                    "int_pathify_dirspec: buf = %s\n",
+                                    buf);
+                        }
+                        return buf;
+                    }
+                }
+            }
         }
-      }
-      if (buf) retpath = buf;
-      else if (ts) Newx(retpath,retlen+1,char);
-      else retpath = __pathify_retbuf;
-      strncpy(retpath, trndir, retlen-1);
-      if (retpath[retlen-2] != '/') { /* If the path doesn't already end */
-        retpath[retlen-1] = '/';      /* with '/', add it. */
-        retpath[retlen] = '\0';
-      }
-      else retpath[retlen-1] = '\0';
     }
-    else {  /* VMS-style directory spec */
-      char *esa, *esal, *cp;
-      char *my_esa;
-      int my_esa_len;
-      unsigned long int sts, cmplen, haslower;
-      struct FAB dirfab = cc$rms_fab;
-      int dirlen;
-      rms_setup_nam(savnam);
-      rms_setup_nam(dirnam);
+    if (sts == 0) {
+        ret_spec = int_pathify_dirspec_simple(trndir, buf,
+            v_spec, v_len, r_spec, r_len,
+            d_spec, d_len, n_spec, n_len,
+            e_spec, e_len, vs_spec, vs_len);
+
+        if (ret_spec != NULL) {
+            PerlMem_free(trndir);
+            if (vms_debug_fileify) {
+                fprintf(stderr,
+                        "int_pathify_dirspec: ret_spec = %s\n", ret_spec);
+            }
+            return ret_spec;
+        }
 
-      /* If we've got an explicit filename, we can just shuffle the string. */
-      if ( ( (cp1 = strrchr(trndir,']')) != NULL ||
-             (cp1 = strrchr(trndir,'>')) != NULL     ) && *(cp1+1)) {
-        if ((cp2 = strchr(cp1,'.')) != NULL) {
-          int ver; char *cp3;
-	  if (vms_process_case_tolerant) {
-              if (!*(cp2+1) || toupper(*(cp2+1)) != 'D' ||  /* Wrong type. */
-                  !*(cp2+2) || toupper(*(cp2+2)) != 'I' ||  /* Bzzt. */
-                  !*(cp2+3) || toupper(*(cp2+3)) != 'R' ||
-                  (*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.')  ||
-                  (*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
-                            (ver || *cp3)))))) {
-	       PerlMem_free(trndir);
-               set_errno(ENOTDIR);
-               set_vaxc_errno(RMS$_DIR);
-               return NULL;
-             }
-	  }
-	  else {
-              if (!*(cp2+1) || *(cp2+1) != 'D' ||  /* Wrong type. */
-                  !*(cp2+2) || *(cp2+2) != 'I' ||  /* Bzzt. */
-                  !*(cp2+3) || *(cp2+3) != 'R' ||
-                  (*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.')  ||
-                  (*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
-                            (ver || *cp3)))))) {
-	       PerlMem_free(trndir);
-               set_errno(ENOTDIR);
-               set_vaxc_errno(RMS$_DIR);
-               return NULL;
-             }
-	  }
+        /* Simple way did not work, which means that a logical name */
+        /* was present for the directory specification.             */
+        /* Need to use an rmsexpand variant to decode it completely */
+        exp_spec = PerlMem_malloc(VMS_MAXRSS);
+        if (exp_spec == NULL)
+            _ckvmssts_noperl(SS$_INSFMEM);
+
+        ret_spec = int_rmsexpand_vms(trndir, exp_spec, PERL_RMSEXPAND_M_LONG);
+        if (ret_spec != NULL) {
+            sts = vms_split_path(exp_spec, &v_spec, &v_len,
+                                 &r_spec, &r_len, &d_spec, &d_len,
+                                 &n_spec, &n_len, &e_spec,
+                                 &e_len, &vs_spec, &vs_len);
+            if (sts == 0) {
+                ret_spec = int_pathify_dirspec_simple(
+                    exp_spec, buf, v_spec, v_len, r_spec, r_len,
+                    d_spec, d_len, n_spec, n_len,
+                    e_spec, e_len, vs_spec, vs_len);
+
+                if ((ret_spec != NULL) && (!decc_efs_case_preserve)) {
+                    /* Legacy mode, lower case the returned value */
+                    __mystrtolower(ret_spec);
+                }
+            } else {
+                set_vaxc_errno(RMS$_DIR);
+                set_errno(ENOTDIR);
+                ret_spec = NULL;
+            }
         }
-        else {  /* No file type, so just draw name into directory part */
-          for (cp2 = cp1; *cp2; cp2++) ;
+        PerlMem_free(exp_spec);
+        PerlMem_free(trndir);
+        if (vms_debug_fileify) {
+            if (ret_spec == NULL)
+                fprintf(stderr, "int_pathify_dirspec: ret_spec = NULL\n");
+            else
+                fprintf(stderr,
+                        "int_pathify_dirspec: ret_spec = %s\n", ret_spec);
         }
-        *cp2 = *cp1;
-        *(cp2+1) = '\0';  /* OK; trndir is guaranteed to be long enough */
-        *cp1 = '.';
-        /* We've now got a VMS 'path'; fall through */
-      }
+        return ret_spec;
 
-      dirlen = strlen(trndir);
-      if (trndir[dirlen-1] == ']' ||
-          trndir[dirlen-1] == '>' ||
-          trndir[dirlen-1] == ':') { /* It's already a VMS 'path' */
-        if (buf) retpath = buf;
-        else if (ts) Newx(retpath,strlen(trndir)+1,char);
-        else retpath = __pathify_retbuf;
-        strcpy(retpath,trndir);
-	PerlMem_free(trndir);
-        return retpath;
-      }
-      rms_set_fna(dirfab, dirnam, trndir, dirlen);
-      esa = PerlMem_malloc(VMS_MAXRSS);
-      if (esa == NULL) _ckvmssts(SS$_INSFMEM);
-      esal = NULL;
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
-      esal = PerlMem_malloc(VMS_MAXRSS);
-      if (esal == NULL) _ckvmssts(SS$_INSFMEM);
-#endif
-      rms_set_dna(dirfab, dirnam, ".DIR;1", 6);
-      rms_bind_fab_nam(dirfab, dirnam);
-      rms_set_esal(dirnam, esa, NAM$C_MAXRSS, esal, VMS_MAXRSS-1);
-#ifdef NAM$M_NO_SHORT_UPCASE
-      if (decc_efs_case_preserve)
-	  rms_set_nam_nop(dirnam, NAM$M_NO_SHORT_UPCASE);
-#endif
+    } else {
+        /* Unix specification, Could be trivial conversion */
+        STRLEN dir_len;
+        dir_len = strlen(trndir);
+
+        /* If the extended file character set is in effect */
+        /* then pathify is simple */
+
+        if (!decc_efs_charset) {
+            /* Have to deal with traiing '.dir' or extra '.' */
+            /* that should not be there in legacy mode, but is */
+
+            char * lastdot;
+            char * lastslash;
+            int is_dir;
+
+            lastslash = strrchr(trndir, '/');
+            if (lastslash == NULL)
+                lastslash = trndir;
+            else
+                lastslash++;
+
+            lastdot = NULL;
+
+            /* '..' or '.' are valid directory components */
+            is_dir = 0;
+            if (lastslash[0] == '.') {
+                if (lastslash[1] == '\0') {
+                   is_dir = 1;
+                } else if (lastslash[1] == '.') {
+                    if (lastslash[2] == '\0') {
+                        is_dir = 1;
+                    } else {
+                        /* And finally allow '...' */
+                        if ((lastslash[2] == '.') && (lastslash[3] == '\0')) {
+                            is_dir = 1;
+                        }
+                    }
+                }
+            }
 
-      for (cp = trndir; *cp; cp++)
-        if (islower(*cp)) { haslower = 1; break; }
+            if (!is_dir) {
+               lastdot = strrchr(lastslash, '.');
+            }
+            if (lastdot != NULL) {
+                STRLEN e_len;
+
+                /* '.dir' is discarded, and any other '.' is invalid */
+                e_len = strlen(lastdot);
+
+                is_dir = is_dir_ext(lastdot, e_len, NULL, 0);
 
-      if (!(sts = (sys$parse(&dirfab)& STS$K_SUCCESS))) {
-        if ((dirfab.fab$l_sts == RMS$_DIR) || (dirfab.fab$l_sts == RMS$_DNF)) {
-	  rms_set_nam_nop(dirnam, NAM$M_SYNCHK);
-          sts = sys$parse(&dirfab) & STS$K_SUCCESS;
+                if (is_dir) {
+                    dir_len = dir_len - 4;
+
+                }
+            }
         }
-        if (!sts) {
-	  PerlMem_free(trndir);
-	  PerlMem_free(esa);
-	  if (esal != NULL)
-	    PerlMem_free(esal);
-          set_errno(EVMSERR);
-          set_vaxc_errno(dirfab.fab$l_sts);
-          return NULL;
+
+        strcpy(buf, trndir);
+        if (buf[dir_len - 1] != '/') {
+            buf[dir_len] = '/';
+            buf[dir_len + 1] = '\0';
         }
-      }
-      else {
-        savnam = dirnam;
-	/* Does the file really exist? */
-        if (!(sys$search(&dirfab)&STS$K_SUCCESS)) {
-          if (dirfab.fab$l_sts != RMS$_FNF) {
-	    int sts1;
-	    sts1 = rms_free_search_context(&dirfab);
-	    PerlMem_free(trndir);
-	    PerlMem_free(esa);
-	    if (esal != NULL)
-		PerlMem_free(esal);
-            set_errno(EVMSERR);
-            set_vaxc_errno(dirfab.fab$l_sts);
-            return NULL;
-          }
-          dirnam = savnam; /* No; just work with potential name */
+
+        /* Under ODS-2 rules, '.' becomes '_', so fix it up */
+        if (!decc_efs_charset) {
+             int dir_start = 0;
+             char * str = buf;
+             if (str[0] == '.') {
+                 char * dots = str;
+                 int cnt = 1;
+                 while ((dots[cnt] == '.') && (cnt < 3))
+                     cnt++;
+                 if (cnt <= 3) {
+                     if ((dots[cnt] == '\0') || (dots[cnt] == '/')) {
+                         dir_start = 1;
+                         str += cnt;
+                     }
+                 }
+             }
+             for (; *str; ++str) {
+                 while (*str == '/') {
+                     dir_start = 1;
+                     *str++;
+                 }
+                 if (dir_start) {
+
+                     /* Have to skip up to three dots which could be */
+                     /* directories, 3 dots being a VMS extension for Perl */
+                     char * dots = str;
+                     int cnt = 0;
+                     while ((dots[cnt] == '.') && (cnt < 3)) {
+                         cnt++;
+                     }
+                     if (dots[cnt] == '\0')
+                         break;
+                     if ((cnt > 1) && (dots[cnt] != '/')) {
+                         dir_start = 0;
+                     } else {
+                         str += cnt;
+                     }
+
+                     /* too many dots? */
+                     if ((cnt == 0) || (cnt > 3)) {
+                         dir_start = 0;
+                     }
+                 }
+                 if (!dir_start && (*str == '.')) {
+                     *str = '_';
+                 }                 
+             }
         }
-      }
-      if (rms_is_nam_fnb(dirnam, NAM$M_EXP_TYPE)) {  /* Was type specified? */
-        /* Yep; check version while we're at it, if it's there. */
-        cmplen = rms_is_nam_fnb(dirnam, NAM$M_EXP_VER) ? 6 : 4;
-        if (strncmp(rms_nam_typel(dirnam),".DIR;1",cmplen)) {
-	  int sts2;
-          /* Something other than .DIR[;1].  Bzzt. */
-	  sts2 = rms_free_search_context(&dirfab);
-	  PerlMem_free(trndir);
-	  PerlMem_free(esa);
-	  if (esal != NULL)
-	     PerlMem_free(esal);
-          set_errno(ENOTDIR);
-          set_vaxc_errno(RMS$_DIR);
-          return NULL;
+        PerlMem_free(trndir);
+        ret_spec = buf;
+        if (vms_debug_fileify) {
+            if (ret_spec == NULL)
+                fprintf(stderr, "int_pathify_dirspec: ret_spec = NULL\n");
+            else
+                fprintf(stderr,
+                        "int_pathify_dirspec: ret_spec = %s\n", ret_spec);
         }
-      }
-      /* Make sure we are using the right buffer */
-      if (esal != NULL) {
-	/* We only need one, clean up the other */
-	my_esa = esal;
-	my_esa_len = rms_nam_esll(dirnam);
-      } else {
-	my_esa = esa;
-        my_esa_len = rms_nam_esl(dirnam);
-      }
+        return ret_spec;
+    }
+}
 
-      /* Null terminate the buffer */
-      my_esa[my_esa_len] = '\0';
+/*{{{ char *pathify_dirspec[_ts](char *path, char *buf)*/
+static char *mp_do_pathify_dirspec(pTHX_ const char *dir,char *buf, int ts, int * utf8_fl)
+{
+    static char __pathify_retbuf[VMS_MAXRSS];
+    char * pathified, *ret_spec, *ret_buf;
+    
+    pathified = NULL;
+    ret_buf = buf;
+    if (ret_buf == NULL) {
+        if (ts) {
+            Newx(pathified, VMS_MAXRSS, char);
+            if (pathified == NULL)
+                _ckvmssts(SS$_INSFMEM);
+            ret_buf = pathified;
+        } else {
+            ret_buf = __pathify_retbuf;
+        }
+    }
 
-      /* OK, the type was fine.  Now pull any file name into the
-         directory path. */
-      if ((cp1 = strrchr(my_esa,']'))) *(rms_nam_typel(dirnam)) = ']';
-      else {
-        cp1 = strrchr(my_esa,'>');
-        *(rms_nam_typel(dirnam)) = '>';
-      }
-      *cp1 = '.';
-      *(rms_nam_typel(dirnam) + 1) = '\0';
-      retlen = (rms_nam_typel(dirnam)) - my_esa + 2;
-      if (buf) retpath = buf;
-      else if (ts) Newx(retpath,retlen,char);
-      else retpath = __pathify_retbuf;
-      strcpy(retpath,my_esa);
-      PerlMem_free(esa);
-      if (esal != NULL)
-	  PerlMem_free(esal);
-      sts = rms_free_search_context(&dirfab);
-      /* $PARSE may have upcased filespec, so convert output to lower
-       * case if input contained any lowercase characters. */
-      if (haslower && !decc_efs_case_preserve) __mystrtolower(retpath);
+    ret_spec = int_pathify_dirspec(dir, ret_buf);
+
+    if (ret_spec == NULL) {
+       /* Cleanup on isle 5, if this is thread specific we need to deallocate */
+       if (pathified)
+           Safefree(pathified);
     }
 
-    PerlMem_free(trndir);
-    return retpath;
+    return ret_spec;
+
 }  /* end of do_pathify_dirspec() */
-/*}}}*/
+
+
 /* External entry points */
 char *Perl_pathify_dirspec(pTHX_ const char *dir, char *buf)
 { return do_pathify_dirspec(dir,buf,0,NULL); }
@@ -6516,11 +7099,11 @@ char *Perl_pathify_dirspec_utf8(pTHX_ const char *dir, char *buf, int *utf8_fl)
 char *Perl_pathify_dirspec_utf8_ts(pTHX_ const char *dir, char *buf, int *utf8_fl)
 { return do_pathify_dirspec(dir,buf,1,utf8_fl); }
 
-/*{{{ char *tounixspec[_ts](char *spec, char *buf, int *)*/
-static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * utf8_fl)
+/* Internal tounixspec routine that does not use a thread context */
+/*{{{ char *int_tounixspec[_ts](char *spec, char *buf, int *)*/
+static char *int_tounixspec(const char *spec, char *rslt, int * utf8_fl)
 {
-  static char __tounixspec_retbuf[VMS_MAXRSS];
-  char *dirend, *rslt, *cp1, *cp3, *tmp;
+  char *dirend, *cp1, *cp3, *tmp;
   const char *cp2;
   int devlen, dirlen, retlen = VMS_MAXRSS;
   int expand = 1; /* guarantee room for leading and trailing slashes */
@@ -6529,13 +7112,24 @@ static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * u
   if (utf8_fl != NULL)
     *utf8_fl = 0;
 
-  if (spec == NULL) return NULL;
-  if (strlen(spec) > (VMS_MAXRSS-1)) return NULL;
-  if (buf) rslt = buf;
-  else if (ts) {
-    Newx(rslt, VMS_MAXRSS, char);
+  if (vms_debug_fileify) {
+      if (spec == NULL)
+          fprintf(stderr, "int_tounixspec: spec = NULL\n");
+      else
+          fprintf(stderr, "int_tounixspec: spec = %s\n", spec);
+  }
+
+
+  if (spec == NULL) {
+      set_errno(EINVAL);
+      set_vaxc_errno(SS$_BADPARAM);
+      return NULL;
+  }
+  if (strlen(spec) > (VMS_MAXRSS-1)) {
+      set_errno(E2BIG);
+      set_vaxc_errno(SS$_BUFFEROVF);
+      return NULL;
   }
-  else rslt = __tounixspec_retbuf;
 
   /* New VMS specific format needs translation
    * glob passes filenames with trailing '\n' and expects this preserved.
@@ -6548,7 +7142,7 @@ static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * u
       int nl_flag;
 
       tunix = PerlMem_malloc(VMS_MAXRSS);
-      if (tunix == NULL) _ckvmssts(SS$_INSFMEM);
+      if (tunix == NULL) _ckvmssts_noperl(SS$_INSFMEM);
       strcpy(tunix, spec);
       tunix_len = strlen(tunix);
       nl_flag = 0;
@@ -6609,6 +7203,9 @@ static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * u
   /* This is already UNIX or at least nothing VMS understands */
   if (cmp_rslt) {
     strcpy(rslt,spec);
+    if (vms_debug_fileify) {
+        fprintf(stderr, "int_tounixspec: rslt = %s\n", rslt);
+    }
     return rslt;
   }
 
@@ -6619,6 +7216,9 @@ static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * u
   if (dirend == NULL) dirend = strchr(spec,':');
   if (dirend == NULL) {
     strcpy(rslt,spec);
+    if (vms_debug_fileify) {
+        fprintf(stderr, "int_tounixspec: rslt = %s\n", rslt);
+    }
     return rslt;
   }
 
@@ -6661,11 +7261,11 @@ static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * u
   cmp_rslt = strncasecmp(spec,"SYS$SCRATCH:", 12);
 #endif
   tmp = PerlMem_malloc(VMS_MAXRSS);
-  if (tmp == NULL) _ckvmssts(SS$_INSFMEM);
+  if (tmp == NULL) _ckvmssts_noperl(SS$_INSFMEM);
   if (cmp_rslt == 0) {
   int islnm;
 
-    islnm = my_trnlnm(tmp, "TMP", 0);
+    islnm = simple_trnlnm("TMP", tmp, VMS_MAXRSS-1);
     if (!islnm) {
       strcpy(rslt, "/tmp");
       cp1 = cp1 + 4;
@@ -6690,8 +7290,10 @@ static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * u
     }
     else if ( *cp2 != '^' && *cp2 != '.' && *cp2 != '-') { /* add the implied device */
       if (getcwd(tmp, VMS_MAXRSS-1 ,1) == NULL) {
-        if (ts) Safefree(rslt);
 	PerlMem_free(tmp);
+        if (vms_debug_fileify) {
+            fprintf(stderr, "int_tounixspec: rslt = NULL\n");
+        }
         return NULL;
       }
       trnlnm_iter_count = 0;
@@ -6703,18 +7305,18 @@ static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * u
         trnlnm_iter_count++; 
         if (trnlnm_iter_count >= PERL_LNM_MAX_ITER+1) break;
       } while (vmstrnenv(tmp,tmp,0,fildev,0));
-      if (ts && !buf &&
-          ((devlen = strlen(tmp)) + (dirlen = strlen(cp2)) + 1 > retlen)) {
-        retlen = devlen + dirlen;
-        Renew(rslt,retlen+1+2*expand,char);
-        cp1 = rslt;
-      }
+      cp1 = rslt;
       cp3 = tmp;
       *(cp1++) = '/';
       while (*cp3) {
         *(cp1++) = *(cp3++);
-        if (cp1 - rslt > (VMS_MAXRSS - 1) && !ts && !buf) {
+        if (cp1 - rslt > (VMS_MAXRSS - 1)) {
 	    PerlMem_free(tmp);
+            set_errno(ENAMETOOLONG);
+            set_vaxc_errno(SS$_BUFFEROVF);
+            if (vms_debug_fileify) {
+                fprintf(stderr, "int_tounixspec: rslt = NULL\n");
+            }
 	    return NULL; /* No room */
 	}
       }
@@ -6744,7 +7346,7 @@ static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * u
     }
     if (*cp2 == ':') {
       *(cp1++) = '/';
-      if (*(cp2+1) == '[') cp2++;
+      if (*(cp2+1) == '[' || *(cp2+1) == '<') cp2++;
     }
     else if (*cp2 == ']' || *cp2 == '>') {
       if (*(cp1-1) != '/') *(cp1++) = '/'; /* Don't double after ellipsis */
@@ -6769,8 +7371,11 @@ static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * u
           *(cp1++) = '.'; *(cp1++) = '.'; *(cp1++) = '/';
         }
         if (*cp2 != '.' && *cp2 != ']' && *cp2 != '>') { /* we don't allow */
-          if (ts) Safefree(rslt);                        /* filespecs like */
+                                                         /* filespecs like */
           set_errno(EINVAL); set_vaxc_errno(RMS$_SYN);   /* [fred.--foo.bar] */
+          if (vms_debug_fileify) {
+              fprintf(stderr, "int_tounixspec: rslt = NULL\n");
+          }
           return NULL;
         }
       }
@@ -6778,9 +7383,77 @@ static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * u
     }
     else *(cp1++) = *cp2;
   }
+  /* Translate the rest of the filename. */
   while (*cp2) {
-    if ((*cp2 == '^') && (*(cp2+1) == '.')) cp2++;  /* '^.' --> '.' */
-    *(cp1++) = *(cp2++);
+      int dot_seen;
+      dot_seen = 0;
+      switch(*cp2) {
+      /* Fixme - for compatibility with the CRTL we should be removing */
+      /* spaces from the file specifications, but this may show that */
+      /* some tests that were appearing to pass are not really passing */
+      case '%':
+          cp2++;
+          *(cp1++) = '?';
+          break;
+      case '^':
+          /* Fix me hex expansions not implemented */
+          cp2++;  /* '^.' --> '.' and other. */
+          if (*cp2) {
+              if (*cp2 == '_') {
+                  cp2++;
+                  *(cp1++) = ' ';
+              } else {
+                  *(cp1++) = *(cp2++);
+              }
+          }
+          break;
+      case ';':
+          if (decc_filename_unix_no_version) {
+              /* Easy, drop the version */
+              while (*cp2)
+                  cp2++;
+              break;
+          } else {
+              /* Punt - passing the version as a dot will probably */
+              /* break perl in weird ways, but so did passing */
+              /* through the ; as a version.  Follow the CRTL and */
+              /* hope for the best. */
+              cp2++;
+              *(cp1++) = '.';
+          }
+          break;
+      case '.':
+          if (dot_seen) {
+              /* We will need to fix this properly later */
+              /* As Perl may be installed on an ODS-5 volume, but not */
+              /* have the EFS_CHARSET enabled, it still may encounter */
+              /* filenames with extra dots in them, and a precedent got */
+              /* set which allowed them to work, that we will uphold here */
+              /* If extra dots are present in a name and no ^ is on them */
+              /* VMS assumes that the first one is the extension delimiter */
+              /* the rest have an implied ^. */
+
+              /* this is also a conflict as the . is also a version */
+              /* delimiter in VMS, */
+
+              *(cp1++) = *(cp2++);
+              break;
+          }
+          dot_seen = 1;
+          /* This is an extension */
+          if (decc_readdir_dropdotnotype) {
+              cp2++;
+              if ((!*cp2) || (*cp2 == ';') || (*cp2 == '.')) {
+                  /* Drop the dot for the extension */
+                  break;
+              } else {
+                  *(cp1++) = '.';
+              }
+              break;
+          }
+      default:
+          *(cp1++) = *(cp2++);
+      }
   }
   *cp1 = '\0';
 
@@ -6806,8 +7479,43 @@ static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * u
       }
   }
 
+  if (vms_debug_fileify) {
+      fprintf(stderr, "int_tounixspec: rslt = %s\n", rslt);
+  }
   return rslt;
 
+}  /* end of int_tounixspec() */
+
+
+/*{{{ char *tounixspec[_ts](char *spec, char *buf, int *)*/
+static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * utf8_fl)
+{
+    static char __tounixspec_retbuf[VMS_MAXRSS];
+    char * unixspec, *ret_spec, *ret_buf;
+
+    unixspec = NULL;
+    ret_buf = buf;
+    if (ret_buf == NULL) {
+        if (ts) {
+            Newx(unixspec, VMS_MAXRSS, char);
+            if (unixspec == NULL)
+                _ckvmssts(SS$_INSFMEM);
+            ret_buf = unixspec;
+        } else {
+            ret_buf = __tounixspec_retbuf;
+        }
+    }
+
+    ret_spec = int_tounixspec(spec, ret_buf, utf8_fl);
+
+    if (ret_spec == NULL) {
+       /* Cleanup on isle 5, if this is thread specific we need to deallocate */
+       if (unixspec)
+           Safefree(unixspec);
+    }
+
+    return ret_spec;
+
 }  /* end of do_tounixspec() */
 /*}}}*/
 /* External entry points */
@@ -7523,7 +8231,7 @@ int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
 	 * special device files.
          */
 
-	if ((add_6zero == 0) && (*nextslash == '/') &&
+	if (!islnm && (add_6zero == 0) && (*nextslash == '/') &&
 	    (&nextslash[1] == unixend)) {
 	  /* No real directory present */
 	  add_6zero = 1;
@@ -7783,7 +8491,7 @@ int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
     vmsptr2 = vmsptr - 1;
     if ((vmslen > 1) &&
 	(*vmsptr2 != ']') && (*vmsptr2 != '*') && (*vmsptr2 != '%') &&
- 	(*vmsptr2 != ')') && (*lastdot != '.')) {
+	(*vmsptr2 != ')') && (*lastdot != '.') && (*vmsptr2 != ':')) {
 	*vmsptr++ = '.';
         vmslen++;
     }
@@ -7820,11 +8528,11 @@ int utf8_flag;
 }
 
 
+
 /*{{{ char *tovmsspec[_ts](char *path, char *buf, int * utf8_flag)*/
-static char *mp_do_tovmsspec
-   (pTHX_ const char *path, char *buf, int ts, int dir_flag, int * utf8_flag) {
-  static char __tovmsspec_retbuf[VMS_MAXRSS];
-  char *rslt, *dirend;
+static char *int_tovmsspec
+   (const char *path, char *rslt, int dir_flag, int * utf8_flag) {
+  char *dirend;
   char *lastdot;
   char *vms_delim;
   register char *cp1;
@@ -7835,11 +8543,20 @@ static char *mp_do_tovmsspec
   char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec;
   int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
 
-  if (path == NULL) return NULL;
+  if (vms_debug_fileify) {
+      if (path == NULL)
+          fprintf(stderr, "int_tovmsspec: path = NULL\n");
+      else
+          fprintf(stderr, "int_tovmsspec: path = %s\n", path);
+  }
+
+  if (path == NULL) {
+      /* If we fail, we should be setting errno */
+      set_errno(EINVAL);
+      set_vaxc_errno(SS$_BADPARAM);
+      return NULL;
+  }
   rslt_len = VMS_MAXRSS-1;
-  if (buf) rslt = buf;
-  else if (ts) Newx(rslt, VMS_MAXRSS, char);
-  else rslt = __tovmsspec_retbuf;
 
   /* '.' and '..' are "[]" and "[-]" for a quick check */
   if (path[0] == '.') {
@@ -7901,6 +8618,9 @@ static char *mp_do_tovmsspec
       if (utf8_flag != NULL)
 	*utf8_flag = 0;
       strcpy(rslt, path);
+      if (vms_debug_fileify) {
+          fprintf(stderr, "int_tovmsspec: rslt = %s\n", rslt);
+      }
       return rslt;
     }
     /* Now, what to do with trailing "." cases where there is no
@@ -7919,28 +8639,51 @@ static char *mp_do_tovmsspec
     if (utf8_flag != NULL)
       *utf8_flag = 0;
     strcpy(rslt, path);
+    if (vms_debug_fileify) {
+        fprintf(stderr, "int_tovmsspec: rslt = %s\n", rslt);
+    }
     return rslt;
   }
 
   dirend = strrchr(path,'/');
 
   if (dirend == NULL) {
+     char *macro_start;
+     int has_macro;
+
      /* If we get here with no UNIX directory delimiters, then this is
         not a complete file specification, either garbage a UNIX glob
 	specification that can not be converted to a VMS wildcard, or
-	it a UNIX shell macro.  MakeMaker wants these passed through AS-IS,
-	so apparently other programs expect this also.
+	it a UNIX shell macro.  MakeMaker wants shell macros passed
+	through AS-IS,
 
 	utf8 flag setting needs to be preserved.
       */
-      strcpy(rslt, path);
-      return rslt;
+      hasdir = 0;
+
+      has_macro = 0;
+      macro_start = strchr(path,'$');
+      if (macro_start != NULL) {
+          if (macro_start[1] == '(') {
+              has_macro = 1;
+          }
+      }
+      if ((decc_efs_charset == 0) || (has_macro)) {
+          strcpy(rslt, path);
+          if (vms_debug_fileify) {
+              fprintf(stderr, "int_tovmsspec: rslt = %s\n", rslt);
+          }
+          return rslt;
+      }
   }
 
-/* If POSIX mode active, handle the conversion */
+/* If EFS charset mode active, handle the conversion */
 #if __CRTL_VER >= 80200000 && !defined(__VAX)
   if (decc_efs_charset) {
     posix_to_vmsspec_hardway(rslt, rslt_len, path, dir_flag, utf8_flag);
+    if (vms_debug_fileify) {
+        fprintf(stderr, "int_tovmsspec: rslt = %s\n", rslt);
+    }
     return rslt;
   }
 #endif
@@ -7971,13 +8714,16 @@ static char *mp_do_tovmsspec
       }
       if (utf8_flag != NULL)
 	*utf8_flag = 0;
+      if (vms_debug_fileify) {
+          fprintf(stderr, "int_tovmsspec: rslt = %s\n", rslt);
+      }
       return rslt;
     }
     while (*(++cp2) != '/' && *cp2) *(cp1++) = *cp2;
     *cp1 = '\0';
     trndev = PerlMem_malloc(VMS_MAXRSS);
-    if (trndev == NULL) _ckvmssts(SS$_INSFMEM);
-    islnm =  my_trnlnm(rslt,trndev,0);
+    if (trndev == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+    islnm =  simple_trnlnm(rslt,trndev,VMS_MAXRSS-1);
 
      /* DECC special handling */
     if (!islnm) {
@@ -7985,21 +8731,21 @@ static char *mp_do_tovmsspec
 	strcpy(rslt,"sys$system");
 	cp1 = rslt + 10;
 	*cp1 = 0;
-	islnm =  my_trnlnm(rslt,trndev,0);
+	islnm = simple_trnlnm(rslt,trndev,VMS_MAXRSS-1);
       }
       else if (strcmp(rslt,"tmp") == 0) {
 	strcpy(rslt,"sys$scratch");
 	cp1 = rslt + 11;
 	*cp1 = 0;
-	islnm =  my_trnlnm(rslt,trndev,0);
+	islnm = simple_trnlnm(rslt,trndev,VMS_MAXRSS-1);
       }
       else if (!decc_disable_posix_root) {
         strcpy(rslt, "sys$posix_root");
-	cp1 = rslt + 13;
+	cp1 = rslt + 14;
 	*cp1 = 0;
 	cp2 = path;
         while (*(cp2+1) == '/') cp2++;  /* Skip multiple /s */
-	islnm =  my_trnlnm(rslt,trndev,0);
+	islnm = simple_trnlnm(rslt,trndev,VMS_MAXRSS-1);
       }
       else if (strcmp(rslt,"dev") == 0) {
 	if (strncmp(cp2,"/null", 5) == 0) {
@@ -8008,7 +8754,7 @@ static char *mp_do_tovmsspec
 	    cp1 = rslt + 4;
 	    *cp1 = 0;
 	    cp2 = cp2 + 5;
-	    islnm =  my_trnlnm(rslt,trndev,0);
+	    islnm = simple_trnlnm(rslt,trndev,VMS_MAXRSS-1);
 	  }
 	}
       }
@@ -8259,9 +9005,44 @@ static char *mp_do_tovmsspec
 
   if (utf8_flag != NULL)
     *utf8_flag = 0;
+  if (vms_debug_fileify) {
+      fprintf(stderr, "int_tovmsspec: rslt = %s\n", rslt);
+  }
   return rslt;
 
-}  /* end of do_tovmsspec() */
+}  /* end of int_tovmsspec() */
+
+
+/*{{{ char *tovmsspec[_ts](char *path, char *buf, int * utf8_flag)*/
+static char *mp_do_tovmsspec
+   (pTHX_ const char *path, char *buf, int ts, int dir_flag, int * utf8_flag) {
+  static char __tovmsspec_retbuf[VMS_MAXRSS];
+    char * vmsspec, *ret_spec, *ret_buf;
+
+    vmsspec = NULL;
+    ret_buf = buf;
+    if (ret_buf == NULL) {
+        if (ts) {
+            Newx(vmsspec, VMS_MAXRSS, char);
+            if (vmsspec == NULL)
+                _ckvmssts(SS$_INSFMEM);
+            ret_buf = vmsspec;
+        } else {
+            ret_buf = __tovmsspec_retbuf;
+        }
+    }
+
+    ret_spec = int_tovmsspec(path, ret_buf, 0, utf8_flag);
+
+    if (ret_spec == NULL) {
+       /* Cleanup on isle 5, if this is thread specific we need to deallocate */
+       if (vmsspec)
+           Safefree(vmsspec);
+    }
+
+    return ret_spec;
+
+}  /* end of mp_do_tovmsspec() */
 /*}}}*/
 /* External entry points */
 char *Perl_tovmsspec(pTHX_ const char *path, char *buf)
@@ -8273,6 +9054,33 @@ char *Perl_tovmsspec_utf8(pTHX_ const char *path, char *buf, int * utf8_fl)
 char *Perl_tovmsspec_utf8_ts(pTHX_ const char *path, char *buf, int * utf8_fl)
   { return do_tovmsspec(path,buf,1,utf8_fl); }
 
+/*{{{ char *int_tovmspath(char *path, char *buf, const int *)*/
+/* Internal routine for use with out an explict context present */
+static char * int_tovmspath(const char *path, char *buf, int * utf8_fl) {
+
+    char * ret_spec, *pathified;
+
+    if (path == NULL)
+        return NULL;
+
+    pathified = PerlMem_malloc(VMS_MAXRSS);
+    if (pathified == NULL)
+        _ckvmssts_noperl(SS$_INSFMEM);
+
+    ret_spec = int_pathify_dirspec(path, pathified);
+
+    if (ret_spec == NULL) {
+        PerlMem_free(pathified);
+        return NULL;
+    }
+
+    ret_spec = int_tovmsspec(pathified, buf, 0, utf8_fl);
+    
+    PerlMem_free(pathified);
+    return ret_spec;
+
+}
+
 /*{{{ char *tovmspath[_ts](char *path, char *buf, const int *)*/
 static char *mp_do_tovmspath(pTHX_ const char *path, char *buf, int ts, int * utf8_fl) {
   static char __tovmspath_retbuf[VMS_MAXRSS];
@@ -8282,7 +9090,7 @@ static char *mp_do_tovmspath(pTHX_ const char *path, char *buf, int ts, int * ut
   if (path == NULL) return NULL;
   pathified = PerlMem_malloc(VMS_MAXRSS);
   if (pathified == NULL) _ckvmssts(SS$_INSFMEM);
-  if (do_pathify_dirspec(path,pathified,0,NULL) == NULL) {
+  if (int_pathify_dirspec(path, pathified) == NULL) {
     PerlMem_free(pathified);
     return NULL;
   }
@@ -8335,7 +9143,7 @@ static char *mp_do_tounixpath(pTHX_ const char *path, char *buf, int ts, int * u
   if (path == NULL) return NULL;
   pathified = PerlMem_malloc(VMS_MAXRSS);
   if (pathified == NULL) _ckvmssts(SS$_INSFMEM);
-  if (do_pathify_dirspec(path,pathified,0,NULL) == NULL) {
+  if (int_pathify_dirspec(path, pathified) == NULL) {
     PerlMem_free(pathified);
     return NULL;
   }
@@ -8610,7 +9418,7 @@ mp_getredirection(pTHX_ int *ac, char ***av)
 	/* Input from a pipe, reopen it in binary mode to disable	*/
 	/* carriage control processing.	 				*/
 
-	fgetname(stdin, mbxname);
+	fgetname(stdin, mbxname, 1);
 	mbxnam.dsc$a_pointer = mbxname;
 	mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer);	
 	lib$getdvi(&dvi_item, 0, &mbxnam, &bufsize, 0, 0);
@@ -8744,7 +9552,7 @@ int rms_sts;
     vmsspec = PerlMem_malloc(VMS_MAXRSS);
     if (vmsspec == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     if ((isunix = (int) strchr(item,'/')) != (int) NULL)
-      filespec.dsc$a_pointer = do_tovmsspec(item,vmsspec,0,NULL);
+      filespec.dsc$a_pointer = int_tovmsspec(item, vmsspec, 0, NULL);
     if (!isunix || !filespec.dsc$a_pointer)
       filespec.dsc$a_pointer = item;
     filespec.dsc$w_length = strlen(filespec.dsc$a_pointer);
@@ -8903,7 +9711,7 @@ pipe_and_fork(pTHX_ char **cmargv)
     *p = '\0';
 
     fp = safe_popen(aTHX_ subcmd,"wbF",&sts);
-    if (fp == Nullfp) {
+    if (fp == NULL) {
         PerlIO_printf(Perl_debug_log,"Can't open output pipe (status %d)",sts);
     }
 }
@@ -8969,6 +9777,7 @@ int len;
 void
 vms_image_init(int *argcp, char ***argvp)
 {
+  int status;
   char eqv[LNM$C_NAMLENGTH+1] = "";
   unsigned int len, tabct = 8, tabidx = 0;
   unsigned long int *mask, iosb[2], i, rlst[128], rsz;
@@ -8987,6 +9796,38 @@ vms_image_init(int *argcp, char ***argvp)
     Perl_csighandler_init();
 #endif
 
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
+    /* This was moved from the pre-image init handler because on threaded */
+    /* Perl it was always returning 0 for the default value. */
+    status = simple_trnlnm("SYS$POSIX_ROOT", eqv, LNM$C_NAMLENGTH);
+    if (status > 0) {
+        int s;
+	s = decc$feature_get_index("DECC$DISABLE_POSIX_ROOT");
+	if (s > 0) {
+            int initial;
+	    initial = decc$feature_get_value(s, 4);
+	    if (initial > 0) {
+                /* initial is: 0 if nothing has set the feature */
+                /*            -1 if initialized to default */
+                /*             1 if set by logical name */
+                /*             2 if set by decc$feature_set_value */
+		decc_disable_posix_root = decc$feature_get_value(s, 1);
+
+                /* If the value is not valid, force the feature off */
+		if (decc_disable_posix_root < 0) {
+		    decc$feature_set_value(s, 1, 1);
+		    decc_disable_posix_root = 1;
+		}
+	    }
+	    else {
+		/* Nothing has asked for it explicitly, so use our own default. */
+		decc_disable_posix_root = 1;
+		decc$feature_set_value(s, 1, 1);
+	    }
+	}
+    }
+#endif
+
   _ckvmssts_noperl(sys$getjpiw(0,NULL,NULL,jpilist,iosb,NULL,NULL));
   _ckvmssts_noperl(iosb[0]);
   for (i = 0; i < sizeof iprv / sizeof(unsigned long int); i++) {
@@ -9152,12 +9993,13 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts)
        *template, *base, *end, *cp1, *cp2;
   register int tmplen, reslen = 0, dirs = 0;
 
-  unixwild = PerlMem_malloc(VMS_MAXRSS);
-  if (unixwild == NULL) _ckvmssts(SS$_INSFMEM);
   if (!wildspec || !fspec) return 0;
+
+  unixwild = PerlMem_malloc(VMS_MAXRSS);
+  if (unixwild == NULL) _ckvmssts_noperl(SS$_INSFMEM);
   template = unixwild;
   if (strpbrk(wildspec,"]>:") != NULL) {
-    if (do_tounixspec(wildspec,unixwild,0,NULL) == NULL) {
+    if (int_tounixspec(wildspec, unixwild, NULL) == NULL) {
         PerlMem_free(unixwild);
 	return 0;
     }
@@ -9167,9 +10009,9 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts)
     unixwild[VMS_MAXRSS-1] = 0;
   }
   unixified = PerlMem_malloc(VMS_MAXRSS);
-  if (unixified == NULL) _ckvmssts(SS$_INSFMEM);
+  if (unixified == NULL) _ckvmssts_noperl(SS$_INSFMEM);
   if (strpbrk(fspec,"]>:") != NULL) {
-    if (do_tounixspec(fspec,unixified,0,NULL) == NULL) {
+    if (int_tounixspec(fspec, unixified, NULL) == NULL) {
         PerlMem_free(unixwild);
         PerlMem_free(unixified);
 	return 0;
@@ -9221,7 +10063,7 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts)
     totells = ells;
     for (cp1 = ellipsis+4; *cp1; cp1++) if (*cp1 == '/') dirs++;
     tpl = PerlMem_malloc(VMS_MAXRSS);
-    if (tpl == NULL) _ckvmssts(SS$_INSFMEM);
+    if (tpl == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     if (ellipsis == template && opts & 1) {
       /* Template begins with an ellipsis.  Since we can't tell how many
        * directory names at the front of the resultant to keep for an
@@ -9257,7 +10099,7 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts)
          if (*front == '/' && !dirs--) { front++; break; }
     }
     lcres = PerlMem_malloc(VMS_MAXRSS);
-    if (lcres == NULL) _ckvmssts(SS$_INSFMEM);
+    if (lcres == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     for (cp1=template,cp2=lcres; *cp1 && cp2 <= lcres + (VMS_MAXRSS - 1);
          cp1++,cp2++) {
 	    if (!decc_efs_case_preserve) {
@@ -9340,10 +10182,10 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts)
         char def[NAM$C_MAXRSS+1], *st;
 
         if (getcwd(def, sizeof def,0) == NULL) {
-	    Safefree(unixified);
-	    Safefree(unixwild);
-	    Safefree(lcres);
-	    Safefree(tpl);
+	    PerlMem_free(unixified);
+	    PerlMem_free(unixwild);
+	    PerlMem_free(lcres);
+	    PerlMem_free(tpl);
 	    return 0;
 	}
 	if (!decc_efs_case_preserve) {
@@ -9411,7 +10253,7 @@ Perl_opendir(pTHX_ const char *name)
     Stat_t sb;
 
     Newx(dir, VMS_MAXRSS, char);
-    if (do_tovmspath(name,dir,0,NULL) == NULL) {
+    if (int_tovmspath(name, dir, NULL) == NULL) {
       Safefree(dir);
       return NULL;
     }
@@ -9626,11 +10468,28 @@ Perl_readdir(pTHX_ DIR *dd)
 	&vs_spec,
 	&vs_len);
 
-    /* Drop NULL extensions on UNIX file specification */
-    if ((dd->flags & PERL_VMSDIR_M_UNIXSPECS &&
-	(e_len == 1) && decc_readdir_dropdotnotype)) {
-	e_len = 0;
-	e_spec[0] = '\0';
+    if (dd->flags & PERL_VMSDIR_M_UNIXSPECS) {
+
+        /* In Unix report mode, remove the ".dir;1" from the name */
+        /* if it is a real directory. */
+        if (decc_filename_unix_report || decc_efs_charset) {
+            if (is_dir_ext(e_spec, e_len, vs_spec, vs_len)) {
+                Stat_t statbuf;
+                int ret_sts;
+
+                ret_sts = flex_lstat(buff, &statbuf);
+                if ((ret_sts == 0) && S_ISDIR(statbuf.st_mode)) {
+                    e_len = 0;
+                    e_spec[0] = 0;
+                }
+            }
+        }
+
+        /* Drop NULL extensions on UNIX file specification */
+	if ((e_len == 1) && decc_readdir_dropdotnotype) {
+	    e_len = 0;
+	    e_spec[0] = '\0';
+        }
     }
 
     strncpy(dd->entry.d_name, n_spec, n_len + e_len);
@@ -9788,7 +10647,7 @@ vms_execfree(struct dsc$descriptor_s *vmscmd)
 static char *
 setup_argstr(pTHX_ SV *really, SV **mark, SV **sp)
 {
-  char *junk, *tmps = Nullch;
+  char *junk, *tmps = NULL;
   register size_t cmdlen = 0;
   size_t rlen;
   register SV **idx;
@@ -9833,12 +10692,13 @@ static unsigned long int
 setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
                    struct dsc$descriptor_s **pvmscmd)
 {
-  char vmsspec[NAM$C_MAXRSS+1], resspec[NAM$C_MAXRSS+1];
+  char * vmsspec;
+  char * resspec;
   char image_name[NAM$C_MAXRSS+1];
   char image_argv[NAM$C_MAXRSS+1];
   $DESCRIPTOR(defdsc,".EXE");
   $DESCRIPTOR(defdsc2,".");
-  $DESCRIPTOR(resdsc,resspec);
+  struct dsc$descriptor_s resdsc;
   struct dsc$descriptor_s *vmscmd;
   struct dsc$descriptor_s imgdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
   unsigned long int cxt = 0, flags = 1, retsts = SS$_NORMAL;
@@ -9848,17 +10708,31 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
   register int isdcl;
 
   vmscmd = PerlMem_malloc(sizeof(struct dsc$descriptor_s));
-  if (vmscmd == NULL) _ckvmssts(SS$_INSFMEM);
+  if (vmscmd == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+
+  /* vmsspec is a DCL command buffer, not just a filename */
+  vmsspec = PerlMem_malloc(MAX_DCL_LINE_LENGTH + 1);
+  if (vmsspec == NULL)
+      _ckvmssts_noperl(SS$_INSFMEM);
+
+  resspec = PerlMem_malloc(VMS_MAXRSS);
+  if (resspec == NULL)
+      _ckvmssts_noperl(SS$_INSFMEM);
 
   /* Make a copy for modification */
   cmdlen = strlen(incmd);
   cmd = PerlMem_malloc(cmdlen+1);
-  if (cmd == NULL) _ckvmssts(SS$_INSFMEM);
+  if (cmd == NULL) _ckvmssts_noperl(SS$_INSFMEM);
   strncpy(cmd, incmd, cmdlen);
   cmd[cmdlen] = 0;
   image_name[0] = 0;
   image_argv[0] = 0;
 
+  resdsc.dsc$a_pointer = resspec;
+  resdsc.dsc$b_dtype  = DSC$K_DTYPE_T;
+  resdsc.dsc$b_class  = DSC$K_CLASS_S;
+  resdsc.dsc$w_length = VMS_MAXRSS - 1;
+
   vmscmd->dsc$a_pointer = NULL;
   vmscmd->dsc$b_dtype  = DSC$K_DTYPE_T;
   vmscmd->dsc$b_class  = DSC$K_CLASS_S;
@@ -9869,6 +10743,8 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
 
   if (strlen(cmd) > MAX_DCL_LINE_LENGTH) {
     PerlMem_free(cmd);
+    PerlMem_free(vmsspec);
+    PerlMem_free(resspec);
     return CLI$_BUFOVF;                /* continuation lines currently unsupported */
   }
 
@@ -9884,14 +10760,27 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
   if (*rest == '.' || *rest == '/') {
     char *cp2;
     for (cp2 = resspec;
-         *rest && !isspace(*rest) && cp2 - resspec < sizeof resspec;
+         *rest && !isspace(*rest) && cp2 - resspec < (VMS_MAXRSS - 1);
          rest++, cp2++) *cp2 = *rest;
     *cp2 = '\0';
-    if (do_tovmsspec(resspec,cp,0,NULL)) { 
+    if (int_tovmsspec(resspec, cp, 0, NULL)) { 
       s = vmsspec;
+
+      /* When a UNIX spec with no file type is translated to VMS, */
+      /* A trailing '.' is appended under ODS-5 rules.            */
+      /* Here we do not want that trailing "." as it prevents     */
+      /* Looking for a implied ".exe" type. */
+      if (decc_efs_charset) {
+          int i;
+          i = strlen(vmsspec);
+          if (vmsspec[i-1] == '.') {
+              vmsspec[i-1] = '\0';
+          }
+      }
+
       if (*rest) {
         for (cp2 = vmsspec + strlen(vmsspec);
-             *rest && cp2 - vmsspec < sizeof vmsspec;
+             *rest && cp2 - vmsspec < MAX_DCL_LINE_LENGTH;
              rest++, cp2++) *cp2 = *rest;
         *cp2 = '\0';
       }
@@ -9922,19 +10811,19 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
     imgdsc.dsc$w_length = wordbreak - s;
     retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,&rsts,&flags);
     if (!(retsts&1)) {
-        _ckvmssts(lib$find_file_end(&cxt));
+        _ckvmssts_noperl(lib$find_file_end(&cxt));
         retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc2,0,&rsts,&flags);
       if (!(retsts & 1) && *s == '$') {
-        _ckvmssts(lib$find_file_end(&cxt));
+        _ckvmssts_noperl(lib$find_file_end(&cxt));
 	imgdsc.dsc$a_pointer++; imgdsc.dsc$w_length--;
 	retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,&rsts,&flags);
 	if (!(retsts&1)) {
-	  _ckvmssts(lib$find_file_end(&cxt));
+	  _ckvmssts_noperl(lib$find_file_end(&cxt));
           retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc2,0,&rsts,&flags);
         }
       }
     }
-    _ckvmssts(lib$find_file_end(&cxt));
+    _ckvmssts_noperl(lib$find_file_end(&cxt));
 
     if (retsts & 1) {
       FILE *fp;
@@ -10006,8 +10895,8 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
 
 	       /* Try to find the exact program requested to be run */
 	      /*---------------------------------------------------*/
-	      iname = do_rmsexpand
-		 (tmpspec, image_name, 0, ".exe",
+	      iname = int_rmsexpand
+		 (tmpspec, image_name, ".exe",
 		  PERL_RMSEXPAND_M_VMS, NULL, NULL);
 	      if (iname != NULL) {
 		if (cando_by_name_int
@@ -10018,8 +10907,8 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
 		else {
 		   /* Try again with a null type */
 		  /*----------------------------*/
-		  iname = do_rmsexpand
-		    (tmpspec, image_name, 0, ".",
+		  iname = int_rmsexpand
+		    (tmpspec, image_name, ".",
 		     PERL_RMSEXPAND_M_VMS, NULL, NULL);
 		  if (iname != NULL) {
 		    if (cando_by_name_int
@@ -10052,11 +10941,16 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
 	}
         fclose(fp);
       }
-      if (check_img && isdcl) return RMS$_FNF;
+      if (check_img && isdcl) {
+          PerlMem_free(cmd);
+          PerlMem_free(resspec);
+          PerlMem_free(vmsspec);
+          return RMS$_FNF;
+      }
 
       if (cando_by_name(S_IXUSR,0,resspec)) {
         vmscmd->dsc$a_pointer = PerlMem_malloc(MAX_DCL_LINE_LENGTH);
-	if (vmscmd->dsc$a_pointer == NULL) _ckvmssts(SS$_INSFMEM);
+	if (vmscmd->dsc$a_pointer == NULL) _ckvmssts_noperl(SS$_INSFMEM);
         if (!isdcl) {
             strcpy(vmscmd->dsc$a_pointer,"$ MCR ");
 	    if (image_name[0] != 0) {
@@ -10096,6 +10990,8 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
 	}
         vmscmd->dsc$w_length = strlen(vmscmd->dsc$a_pointer);
         PerlMem_free(cmd);
+        PerlMem_free(vmsspec);
+        PerlMem_free(resspec);
         return (vmscmd->dsc$w_length > MAX_DCL_LINE_LENGTH ? CLI$_BUFOVF : retsts);
       }
       else
@@ -10110,6 +11006,8 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
   vmscmd->dsc$a_pointer[vmscmd->dsc$w_length] = 0;
 
   PerlMem_free(cmd);
+  PerlMem_free(resspec);
+  PerlMem_free(vmsspec);
 
   /* check if it's a symbol (for quoting purposes) */
   if (suggest_quote && !*suggest_quote) { 
@@ -10126,7 +11024,7 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
     if (retsts == RMS$_FNF || retsts == RMS$_DNF || retsts == RMS$_PRV ||
         retsts == RMS$_DEV || retsts == RMS$_DIR || retsts == RMS$_SYN ||
        (retsts & STS$M_CODE) == (SHR$_NOWILD & STS$M_CODE)) return retsts;
-    else { _ckvmssts(retsts); }
+    else { _ckvmssts_noperl(retsts); }
   }
 
   return (vmscmd->dsc$w_length > MAX_DCL_LINE_LENGTH ? CLI$_BUFOVF : retsts);
@@ -10198,7 +11096,7 @@ Perl_vms_do_exec(pTHX_ const char *cmd)
       case CLI$_BUFOVF: case RMS$_RTB: case CLI$_TKNOVF: case CLI$_RSLOVF:
         set_errno(E2BIG); break;
       case LIB$_INVARG: case LIB$_INVSTRDES: case SS$_ACCVIO: /* shouldn't happen */
-        _ckvmssts(retsts); /* fall through */
+        _ckvmssts_noperl(retsts); /* fall through */
       default:  /* SS$_DUPLNAM, SS$_CLI, resource exhaustion, etc. */
         set_errno(EVMSERR); 
     }
@@ -10215,12 +11113,10 @@ Perl_vms_do_exec(pTHX_ const char *cmd)
 }  /* end of vms_do_exec() */
 /*}}}*/
 
-unsigned long int Perl_do_spawn(pTHX_ const char *);
-unsigned long int do_spawn2(pTHX_ const char *, int);
+int do_spawn2(pTHX_ const char *, int);
 
-/* {{{ unsigned long int do_aspawn(void *really,void **mark,void **sp) */
-unsigned long int
-Perl_do_aspawn(pTHX_ void *really,void **mark,void **sp)
+int
+Perl_do_aspawn(pTHX_ SV* really, SV** mark, SV** sp)
 {
 unsigned long int sts;
 char * cmd;
@@ -10233,9 +11129,9 @@ int flags = 0;
      * through do_aspawn is a value of 1, which means spawn without
      * waiting for completion -- other values are ignored.
      */
-    if (SvNIOKp(*((SV**)mark+1)) && !SvPOKp(*((SV**)mark+1))) {
+    if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
 	++mark;
-	flags = SvIVx(*(SV**)mark);
+	flags = SvIVx(*mark);
     }
 
     if (flags && flags == 1)     /* the Win32 P_NOWAIT value */
@@ -10243,7 +11139,7 @@ int flags = 0;
     else
         flags = 0;
 
-    cmd = setup_argstr(aTHX_ (SV *)really,(SV **)mark,(SV **)sp);
+    cmd = setup_argstr(aTHX_ really, mark, sp);
     sts = do_spawn2(aTHX_ cmd, flags);
     /* pp_sys will clean up cmd */
     return sts;
@@ -10253,16 +11149,28 @@ int flags = 0;
 /*}}}*/
 
 
-/* {{{unsigned long int do_spawn(char *cmd) */
-unsigned long int
-Perl_do_spawn(pTHX_ const char *cmd)
+/* {{{int do_spawn(char* cmd) */
+int
+Perl_do_spawn(pTHX_ char* cmd)
 {
+    PERL_ARGS_ASSERT_DO_SPAWN;
+
     return do_spawn2(aTHX_ cmd, 0);
 }
 /*}}}*/
 
-/* {{{unsigned long int do_spawn2(char *cmd) */
-unsigned long int
+/* {{{int do_spawn_nowait(char* cmd) */
+int
+Perl_do_spawn_nowait(pTHX_ char* cmd)
+{
+    PERL_ARGS_ASSERT_DO_SPAWN_NOWAIT;
+
+    return do_spawn2(aTHX_ cmd, CLI$M_NOWAIT);
+}
+/*}}}*/
+
+/* {{{int do_spawn2(char *cmd) */
+int
 do_spawn2(pTHX_ const char *cmd, int flags)
 {
   unsigned long int sts, substs;
@@ -10289,7 +11197,7 @@ do_spawn2(pTHX_ const char *cmd, int flags)
         case CLI$_BUFOVF: case RMS$_RTB: case CLI$_TKNOVF: case CLI$_RSLOVF:
           set_errno(E2BIG); break;
         case LIB$_INVARG: case LIB$_INVSTRDES: case SS$_ACCVIO: /* shouldn't happen */
-          _ckvmssts(sts); /* fall through */
+          _ckvmssts_noperl(sts); /* fall through */
         default:  /* SS$_DUPLNAM, SS$_CLI, resource exhaustion, etc. */
           set_errno(EVMSERR);
       }
@@ -10341,7 +11249,7 @@ FILE *my_fdopen(int fd, const char *mode)
       memset(sockflags+sockflagsize,0,fdoff + 2 - sockflagsize);
       sockflagsize = fdoff + 2;
     }
-    if (fstat(fd, (struct stat *)&sbuf) == 0 && S_ISSOCK(sbuf.st_mode))
+    if (fstat(fd, &sbuf.crtl_stat) == 0 && S_ISSOCK(sbuf.st_mode))
       sockflags[fdoff] |= 1 << (fd % sizeof(unsigned int));
   }
   return fp;
@@ -10361,7 +11269,7 @@ int my_fclose(FILE *fp) {
     unsigned int fd = fileno(fp);
     unsigned int fdoff = fd / sizeof(unsigned int);
 
-    if (sockflagsize && fdoff <= sockflagsize)
+    if (sockflagsize && fdoff < sockflagsize)
       sockflags[fdoff] &= ~(1 << fd % sizeof(unsigned int));
   }
   return fclose(fp);
@@ -10423,7 +11331,7 @@ Perl_my_flush(pTHX_ FILE *fp)
     if ((res = fflush(fp)) == 0 && fp) {
 #ifdef VMS_DO_SOCKETS
 	Stat_t s;
-	if (Fstat(fileno(fp), &s) == 0 && !S_ISSOCK(s.st_mode))
+	if (fstat(fileno(fp), &s.crtl_stat) == 0 && !S_ISSOCK(s.st_mode))
 #endif
 	    res = fsync(fileno(fp));
     }
@@ -10438,6 +11346,34 @@ Perl_my_flush(pTHX_ FILE *fp)
 }
 /*}}}*/
 
+/* fgetname() is not returning the correct file specifications when
+ * decc_filename_unix_report mode is active.  So we have to have it
+ * aways return filenames in VMS mode and convert it ourselves.
+ */
+
+/*{{{ char * my_fgetname(FILE *fp, buf)*/
+char *
+Perl_my_fgetname(FILE *fp, char * buf) {
+    char * retname;
+    char * vms_name;
+
+    retname = fgetname(fp, buf, 1);
+
+    /* If we are in VMS mode, then we are done */
+    if (!decc_filename_unix_report || (retname == NULL)) {
+       return retname;
+    }
+
+    /* Convert this to Unix format */
+    vms_name = PerlMem_malloc(VMS_MAXRSS + 1);
+    strcpy(vms_name, retname);
+    retname = int_tounixspec(vms_name, buf, NULL);
+    PerlMem_free(vms_name);
+
+    return retname;
+}
+/*}}}*/
+
 /*
  * Here are replacements for the following Unix routines in the VMS environment:
  *      getpwuid    Get information for a particular UIC or UID
@@ -11369,7 +12305,7 @@ int Perl_my_utime(pTHX_ const char *file, const struct utimbuf *utimes)
   }
 
   /* Convert to VMS format ensuring that it will fit in 255 characters */
-  if (do_rmsexpand(file, vmsspec, 0, NULL, PERL_RMSEXPAND_M_VMS, NULL, NULL) == NULL) {
+  if (int_rmsexpand_tovms(file, vmsspec, 0) == NULL) {
       SETERRNO(ENOENT, LIB$_INVARG);
       return -1;
   }
@@ -11611,6 +12547,10 @@ is_null_device(name)
   return (*name++ == ':') && (*name != ':');
 }
 
+static int
+Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag);
+
+#define flex_stat_int(a,b,c)		Perl_flex_stat_int(aTHX_ a,b,c)
 
 static I32
 Perl_cando_by_name_int
@@ -11640,7 +12580,7 @@ Perl_cando_by_name_int
 
   /* Make sure we expand logical names, since sys$check_access doesn't */
   fileified = PerlMem_malloc(VMS_MAXRSS);
-  if (fileified == NULL) _ckvmssts(SS$_INSFMEM);
+  if (fileified == NULL) _ckvmssts_noperl(SS$_INSFMEM);
   if (!strpbrk(fname,"/]>:")) {
       strcpy(fileified,fname);
       trnlnm_iter_count = 0;
@@ -11652,7 +12592,7 @@ Perl_cando_by_name_int
   }
 
   vmsname = PerlMem_malloc(VMS_MAXRSS);
-  if (vmsname == NULL) _ckvmssts(SS$_INSFMEM);
+  if (vmsname == NULL) _ckvmssts_noperl(SS$_INSFMEM);
   if ( !(opts & PERL_RMSEXPAND_M_VMS_IN) ) {
     /* Don't know if already in VMS format, so make sure */
     if (!do_rmsexpand(fname, vmsname, 0, NULL, PERL_RMSEXPAND_M_VMS, NULL, NULL)) {
@@ -11666,17 +12606,17 @@ Perl_cando_by_name_int
   }
 
   /* sys$check_access needs a file spec, not a directory spec.
-   * Don't use flex_stat here, as that depends on thread context
-   * having been initialized, and we may get here during startup.
+   * flex_stat now will handle a null thread context during startup.
    */
 
   retlen = namdsc.dsc$w_length = strlen(vmsname);
   if (vmsname[retlen-1] == ']' 
       || vmsname[retlen-1] == '>' 
       || vmsname[retlen-1] == ':'
-      || (!stat(vmsname, (stat_t *)&st) && S_ISDIR(st.st_mode))) {
+      || (!flex_stat_int(vmsname, &st, 1) &&
+          S_ISDIR(st.st_mode))) {
 
-      if (!do_fileify_dirspec(vmsname,fileified,1,NULL)) {
+      if (!int_fileify_dirspec(vmsname, fileified, NULL)) {
         PerlMem_free(fileified);
         PerlMem_free(vmsname);
         return FALSE;
@@ -11723,19 +12663,19 @@ Perl_cando_by_name_int
    */
 
   /* get current process privs and username */
-  _ckvmssts(sys$getjpiw(0,0,0,jpilst,iosb,0,0));
-  _ckvmssts(iosb[0]);
+  _ckvmssts_noperl(sys$getjpiw(0,0,0,jpilst,iosb,0,0));
+  _ckvmssts_noperl(iosb[0]);
 
 #if defined(__VMS_VER) && __VMS_VER >= 60000000
 
   /* find out the space required for the profile */
-  _ckvmssts(sys$create_user_profile(&usrdsc,&usrprolst,0,0,
+  _ckvmssts_noperl(sys$create_user_profile(&usrdsc,&usrprolst,0,0,
                                     &usrprodsc.dsc$w_length,&profile_context));
 
   /* allocate space for the profile and get it filled in */
   usrprodsc.dsc$a_pointer = PerlMem_malloc(usrprodsc.dsc$w_length);
-  if (usrprodsc.dsc$a_pointer == NULL) _ckvmssts(SS$_INSFMEM);
-  _ckvmssts(sys$create_user_profile(&usrdsc,&usrprolst,0,usrprodsc.dsc$a_pointer,
+  if (usrprodsc.dsc$a_pointer == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+  _ckvmssts_noperl(sys$create_user_profile(&usrdsc,&usrprolst,0,usrprodsc.dsc$a_pointer,
                                     &usrprodsc.dsc$w_length,&profile_context));
 
   /* use the profile to check access to the file; free profile & analyze results */
@@ -11769,7 +12709,7 @@ Perl_cando_by_name_int
       PerlMem_free(vmsname);
     return TRUE;
   }
-  _ckvmssts(retsts);
+  _ckvmssts_noperl(retsts);
 
   if (fileified != NULL)
     PerlMem_free(fileified);
@@ -11806,7 +12746,7 @@ Perl_cando_by_name(pTHX_ I32 bit, bool effective, const char *fname)
 int
 Perl_flex_fstat(pTHX_ int fd, Stat_t *statbufp)
 {
-  if (!fstat(fd,(stat_t *) statbufp)) {
+  if (!fstat(fd, &statbufp->crtl_stat)) {
     char *cptr;
     char *vms_filename;
     vms_filename = PerlMem_malloc(VMS_MAXRSS);
@@ -11821,14 +12761,10 @@ Perl_flex_fstat(pTHX_ int fd, Stat_t *statbufp)
     }
     else {
 	/* Make sure that the saved name fits in 255 characters */
-	cptr = do_rmsexpand
+	cptr = int_rmsexpand_vms
 		       (vms_filename,
 			statbufp->st_devnam, 
-			0,
-			NULL,
-			PERL_RMSEXPAND_M_VMS | PERL_RMSEXPAND_M_VMS_IN,
-			NULL,
-			NULL);
+			0);
 	if (cptr == NULL)
 	    statbufp->st_devnam[0] = 0;
     }
@@ -11864,34 +12800,24 @@ Perl_flex_fstat(pTHX_ int fd, Stat_t *statbufp)
 }  /* end of flex_fstat() */
 /*}}}*/
 
-#if !defined(__VAX) && __CRTL_VER >= 80200000
-#ifdef lstat
-#undef lstat
-#endif
-#else
-#ifdef lstat
-#undef lstat
-#endif
-#define lstat(_x, _y) stat(_x, _y)
-#endif
-
-#define flex_stat_int(a,b,c)		Perl_flex_stat_int(aTHX_ a,b,c)
-
 static int
 Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
 {
-    char fileified[VMS_MAXRSS];
-    char temp_fspec[VMS_MAXRSS];
-    char *save_spec;
+    char *fileified;
+    char *temp_fspec;
+    const char *save_spec;
+    char *ret_spec;
     int retval = -1;
-    int saved_errno, saved_vaxc_errno;
+    int efs_hack = 0;
+    dSAVEDERRNO;
 
-    if (!fspec) return retval;
-    saved_errno = errno; saved_vaxc_errno = vaxc$errno;
-    strcpy(temp_fspec, fspec);
+    if (!fspec) {
+        errno = EINVAL;
+        return retval;
+    }
 
     if (decc_bug_devnull != 0) {
-      if (is_null_device(temp_fspec)) { /* Fake a stat() for the null device */
+      if (is_null_device(fspec)) { /* Fake a stat() for the null device */
 	memset(statbufp,0,sizeof *statbufp);
         VMS_DEVICE_ENCODE(statbufp->st_dev, "_NLA0:", 0);
 	statbufp->st_mode = S_IFBLK | S_IREAD | S_IWRITE | S_IEXEC;
@@ -11915,58 +12841,86 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
      */
 
 
-#if __CRTL_VER >= 70300000 && !defined(__VAX)
-  /* The CRTL stat() falls down hard on multi-dot filenames in unix format unless
-   * DECC$EFS_CHARSET is in effect, so temporarily enable it if it isn't already.
-   */
-  if (!decc_efs_charset)
-    decc$feature_set_value(decc$feature_get_index("DECC$EFS_CHARSET"),1,1); 
-#endif
+    fileified = PerlMem_malloc(VMS_MAXRSS);
+    if (fileified == NULL)
+        _ckvmssts_noperl(SS$_INSFMEM);
+     
+    temp_fspec = PerlMem_malloc(VMS_MAXRSS);
+    if (temp_fspec == NULL)
+        _ckvmssts_noperl(SS$_INSFMEM);
+
+    strcpy(temp_fspec, fspec);
+
+    SAVE_ERRNO;
 
 #if __CRTL_VER >= 80200000 && !defined(__VAX)
   if (decc_posix_compliant_pathnames == 0) {
 #endif
-    if (do_fileify_dirspec(temp_fspec,fileified,0,NULL) != NULL) {
-      if (lstat_flag == 0)
-	retval = stat(fileified,(stat_t *) statbufp);
-      else
-	retval = lstat(fileified,(stat_t *) statbufp);
-      save_spec = fileified;
+
+    /* We may be able to optimize this, but in order for fileify_dirspec to
+     * always return a usuable answer, we have to call vmspath first to
+     * make sure that it is in VMS directory format, as stat/lstat on 8.3
+     * can not handle directories in unix format that it does not have read
+     * access to.  Vmspath handles the case where a bare name which could be
+     * a logical name gets passed.
+     */ 
+    ret_spec = int_tovmspath(fspec, temp_fspec, NULL);
+    if (ret_spec != NULL) {
+        ret_spec = int_fileify_dirspec(temp_fspec, fileified, NULL); 
+        if (ret_spec != NULL) {
+            if (lstat_flag == 0)
+                retval = stat(fileified, &statbufp->crtl_stat);
+            else
+                retval = lstat(fileified, &statbufp->crtl_stat);
+            save_spec = fileified;
+        }
     }
-    if (retval) {
-      if (lstat_flag == 0)
-	retval = stat(temp_fspec,(stat_t *) statbufp);
-      else
-	retval = lstat(temp_fspec,(stat_t *) statbufp);
-      save_spec = temp_fspec;
+
+    if (retval && vms_bug_stat_filename) {
+
+        /* We should try again as a vmsified file specification */
+        /* However Perl traditionally has not done this, which  */
+        /* causes problems with existing tests */
+
+        ret_spec = int_tovmsspec(fspec, temp_fspec, 0, NULL);
+        if (ret_spec != NULL) {
+            if (lstat_flag == 0)
+                retval = stat(temp_fspec, &statbufp->crtl_stat);
+            else
+                retval = lstat(temp_fspec, &statbufp->crtl_stat);
+            save_spec = temp_fspec;
+        }
     }
-/*
- * In debugging, on 8.3 Alpha, I found a case where stat was returning a
- * file not found error for a directory named foo:[bar.t] or /foo/bar/t
- * and lstat was working correctly for the same file.
- * The only syntax that was working for stat was "foo:[bar]t.dir".
- *
- * Other directories with the same syntax worked fine.
- * So work around the problem when it shows up here.
- */
+
     if (retval) {
-        int save_errno = errno;
-	if (do_tovmsspec(fspec, temp_fspec, 0, NULL) != NULL) {
-	    if (do_fileify_dirspec(temp_fspec, fileified, 0, NULL) != NULL) {
-		retval = stat(fileified, (stat_t *) statbufp);
-		save_spec = fileified;
-	    }
-	}
-	/* Restore the errno value if third stat does not succeed */
-	if (retval != 0)
-	    errno = save_errno;
+        /* Last chance - allow multiple dots with out EFS CHARSET */
+        /* The CRTL stat() falls down hard on multi-dot filenames in unix
+         * format unless * DECC$EFS_CHARSET is in effect, so temporarily
+         * enable it if it isn't already.
+         */
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
+        if (!decc_efs_charset && (decc_efs_charset_index > 0))
+            decc$feature_set_value(decc_efs_charset_index, 1, 1); 
+#endif
+        if (lstat_flag == 0)
+	    retval = stat(fspec, &statbufp->crtl_stat);
+        else
+	    retval = lstat(fspec, &statbufp->crtl_stat);
+        save_spec = fspec;
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
+        if (!decc_efs_charset && (decc_efs_charset_index > 0)) {
+            decc$feature_set_value(decc_efs_charset_index, 1, 0); 
+            efs_hack = 1;
+        }
+#endif
     }
+
 #if __CRTL_VER >= 80200000 && !defined(__VAX)
   } else {
     if (lstat_flag == 0)
-      retval = stat(temp_fspec,(stat_t *) statbufp);
+      retval = stat(temp_fspec, &statbufp->crtl_stat);
     else
-      retval = lstat(temp_fspec,(stat_t *) statbufp);
+      retval = lstat(temp_fspec, &statbufp->crtl_stat);
       save_spec = temp_fspec;
   }
 #endif
@@ -11985,8 +12939,22 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
       if (lstat_flag)
 	rmsex_flags |= PERL_RMSEXPAND_M_SYMLINK;
 
-      cptr = do_rmsexpand
-       (save_spec, statbufp->st_devnam, 0, NULL, rmsex_flags, NULL, NULL);
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
+      /* If we used the efs_hack above, we must also use it here for */
+      /* perl_cando to work */
+      if (efs_hack && (decc_efs_charset_index > 0)) {
+          decc$feature_set_value(decc_efs_charset_index, 1, 1);
+      }
+#endif
+      cptr = int_rmsexpand_tovms(save_spec, statbufp->st_devnam, rmsex_flags);
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
+      if (efs_hack && (decc_efs_charset_index > 0)) {
+          decc$feature_set_value(decc_efs_charset, 1, 0);
+      }
+#endif
+
+      /* Fix me: If this is NULL then stat found a file, and we could */
+      /* not convert the specification to VMS - Should never happen */
       if (cptr == NULL)
 	statbufp->st_devnam[0] = 0;
 
@@ -12014,7 +12982,7 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
 #     endif
     }
     /* If we were successful, leave errno where we found it */
-    if (retval == 0) { errno = saved_errno; vaxc$errno = saved_vaxc_errno; }
+    if (retval == 0) RESTORE_ERRNO;
     return retval;
 
 }  /* end of flex_stat_int() */
@@ -12090,11 +13058,11 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
     struct XABSUM xabsum;
 
     vmsin = PerlMem_malloc(VMS_MAXRSS);
-    if (vmsin == NULL) _ckvmssts(SS$_INSFMEM);
+    if (vmsin == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     vmsout = PerlMem_malloc(VMS_MAXRSS);
-    if (vmsout == NULL) _ckvmssts(SS$_INSFMEM);
-    if (!spec_in  || !*spec_in  || !do_tovmsspec(spec_in,vmsin,1,NULL) ||
-        !spec_out || !*spec_out || !do_tovmsspec(spec_out,vmsout,1,NULL)) {
+    if (vmsout == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+    if (!spec_in  || !*spec_in  || !int_tovmsspec(spec_in, vmsin, 1, NULL) ||
+        !spec_out || !*spec_out || !int_tovmsspec(spec_out, vmsout, 1, NULL)) {
       PerlMem_free(vmsin);
       PerlMem_free(vmsout);
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
@@ -12102,11 +13070,11 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
     }
 
     esa = PerlMem_malloc(VMS_MAXRSS);
-    if (esa == NULL) _ckvmssts(SS$_INSFMEM);
+    if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     esal = NULL;
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
     esal = PerlMem_malloc(VMS_MAXRSS);
-    if (esal == NULL) _ckvmssts(SS$_INSFMEM);
+    if (esal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 #endif
     fab_in = cc$rms_fab;
     rms_set_fna(fab_in, nam, vmsin, strlen(vmsin));
@@ -12117,11 +13085,11 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
     fab_in.fab$l_xab = (void *) &xabdat;
 
     rsa = PerlMem_malloc(VMS_MAXRSS);
-    if (rsa == NULL) _ckvmssts(SS$_INSFMEM);
+    if (rsa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     rsal = NULL;
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
     rsal = PerlMem_malloc(VMS_MAXRSS);
-    if (rsal == NULL) _ckvmssts(SS$_INSFMEM);
+    if (rsal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 #endif
     rms_set_rsal(nam, rsa, NAM$C_MAXRSS, rsal, (VMS_MAXRSS - 1));
     rms_set_esal(nam, esa, NAM$C_MAXRSS, esal, (VMS_MAXRSS - 1));
@@ -12180,16 +13148,16 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
     dna_len = rms_nam_namel(nam) ? rms_nam_name_type_l_size(nam) : 0;
     rms_set_dna(fab_out, nam_out, rms_nam_namel(nam), dna_len);
     esa_out = PerlMem_malloc(NAM$C_MAXRSS + 1);
-    if (esa_out == NULL) _ckvmssts(SS$_INSFMEM);
+    if (esa_out == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     rsa_out = PerlMem_malloc(NAM$C_MAXRSS + 1);
-    if (rsa_out == NULL) _ckvmssts(SS$_INSFMEM);
+    if (rsa_out == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     esal_out = NULL;
     rsal_out = NULL;
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
     esal_out = PerlMem_malloc(VMS_MAXRSS);
-    if (esal_out == NULL) _ckvmssts(SS$_INSFMEM);
+    if (esal_out == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     rsal_out = PerlMem_malloc(VMS_MAXRSS);
-    if (rsal_out == NULL) _ckvmssts(SS$_INSFMEM);
+    if (rsal_out == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 #endif
     rms_set_rsal(nam_out, rsa_out, NAM$C_MAXRSS, rsal_out, (VMS_MAXRSS - 1));
     rms_set_esal(nam_out, esa_out, NAM$C_MAXRSS, esal_out, (VMS_MAXRSS - 1));
@@ -12271,7 +13239,7 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
     }
 
     ubf = PerlMem_malloc(32256);
-    if (ubf == NULL) _ckvmssts(SS$_INSFMEM);
+    if (ubf == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     rab_in = cc$rms_rab;
     rab_in.rab$l_fab = &fab_in;
     rab_in.rab$l_rop = RAB$M_BIO;
@@ -12673,8 +13641,7 @@ mod2fname(pTHX_ CV *cv)
     if (counter) {
       strcat(work_name, "__");
     }
-    strcat(work_name, SvPV(*av_fetch(in_array, counter, FALSE),
-			   PL_na));
+    strcat(work_name, SvPV_nolen(*av_fetch(in_array, counter, FALSE)));
   }
 
   /* Check to see if we actually have to bother...*/
@@ -12755,6 +13722,14 @@ Perl_vms_start_glob
     unsigned long hasver = 0, isunix = 0;
     unsigned long int lff_flags = 0;
     int rms_sts;
+    int vms_old_glob = 1;
+
+    if (!SvOK(tmpglob)) {
+        SETERRNO(ENOENT,RMS$_FNF);
+        return NULL;
+    }
+
+    vms_old_glob = !decc_filename_unix_report;
 
 #ifdef VMS_LONGNAME_SUPPORT
     lff_flags = LIB$M_FIL_LONG_NAMES;
@@ -12800,16 +13775,47 @@ Perl_vms_start_glob
 	    break;
 	}
     }
+
+    /* In UNIX report mode, assume UNIX unless VMS directory delimiters seen */
+    if ((hasdir == 0) && decc_filename_unix_report) {
+        isunix = 1;
+    }
+
     if ((tmpfp = PerlIO_tmpfile()) != NULL) {
+	char * wv_spec, * wr_spec, * wd_spec, * wn_spec, * we_spec, * wvs_spec;
+	int wv_sts, wv_len, wr_len, wd_len, wn_len, we_len, wvs_len;
+	int wildstar = 0;
+	int wildquery = 0;
 	int found = 0;
 	Stat_t st;
 	int stat_sts;
 	stat_sts = PerlLIO_stat(SvPVX_const(tmpglob),&st);
 	if (!stat_sts && S_ISDIR(st.st_mode)) {
-	    wilddsc.dsc$a_pointer = tovmspath_utf8(SvPVX(tmpglob),vmsspec,NULL);
-	    ok = (wilddsc.dsc$a_pointer != NULL);
-	    /* maybe passed 'foo' rather than '[.foo]', thus not detected above */
-	    hasdir = 1; 
+            char * vms_dir;
+            const char * fname;
+            STRLEN fname_len;
+
+            /* Test to see if SvPVX_const(tmpglob) ends with a VMS */
+            /* path delimiter of ':>]', if so, then the old behavior has */
+            /* obviously been specificially requested */
+
+            fname = SvPVX_const(tmpglob);
+            fname_len = strlen(fname);
+            vms_dir = strpbrk(&fname[fname_len - 1], ":>]");
+            if (vms_old_glob || (vms_dir != NULL)) {
+                wilddsc.dsc$a_pointer = tovmspath_utf8(
+                                            SvPVX(tmpglob),vmsspec,NULL);
+                ok = (wilddsc.dsc$a_pointer != NULL);
+                /* maybe passed 'foo' rather than '[.foo]', thus not
+                   detected above */
+                hasdir = 1; 
+            } else {
+                /* Operate just on the directory, the special stat/fstat for */
+                /* leaves the fileified  specification in the st_devnam */
+                /* member. */
+                wilddsc.dsc$a_pointer = st.st_devnam;
+                ok = 1;
+            }
 	}
 	else {
 	    wilddsc.dsc$a_pointer = tovmsspec_utf8(SvPVX(tmpglob),vmsspec,NULL);
@@ -12820,22 +13826,42 @@ Perl_vms_start_glob
 
 	/* If not extended character set, replace ? with % */
 	/* With extended character set, ? is a wildcard single character */
-	if (!decc_efs_case_preserve) {
-	    for (cp=wilddsc.dsc$a_pointer; ok && cp && *cp; cp++)
-	        if (*cp == '?') *cp = '%';
+	for (cp=wilddsc.dsc$a_pointer; ok && cp && *cp; cp++) {
+	    if (*cp == '?') {
+                wildquery = 1;
+                if (!decc_efs_case_preserve)
+                    *cp = '%';
+            } else if (*cp == '%') {
+                wildquery = 1;
+            } else if (*cp == '*') {
+                wildstar = 1;
+            }
 	}
+
+        if (ok) {
+            wv_sts = vms_split_path(
+                wilddsc.dsc$a_pointer, &wv_spec, &wv_len, &wr_spec, &wr_len,
+                &wd_spec, &wd_len, &wn_spec, &wn_len, &we_spec, &we_len,
+                &wvs_spec, &wvs_len);
+        } else {
+            wn_spec = NULL;
+            wn_len = 0;
+            we_spec = NULL;
+            we_len = 0;
+        }
+
 	sts = SS$_NORMAL;
 	while (ok && $VMS_STATUS_SUCCESS(sts)) {
 	 char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec;
 	 int v_sts, v_len, r_len, d_len, n_len, e_len, vs_len;
+         int valid_find;
 
+            valid_find = 0;
 	    sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
 				&dfltdsc,NULL,&rms_sts,&lff_flags);
 	    if (!$VMS_STATUS_SUCCESS(sts))
 		break;
 
-	    found++;
-
 	    /* with varying string, 1st word of buffer contains result length */
 	    rstr[rslt->length] = '\0';
 
@@ -12859,9 +13885,28 @@ Perl_vms_start_glob
 	    if (!hasver && (vs_len > 0)) {
 		*vs_spec = '\0';
 		vs_len = 0;
+            }
+
+            if (isunix) {
+
+                /* In Unix report mode, remove the ".dir;1" from the name */
+                /* if it is a real directory */
+                if (decc_filename_unix_report || decc_efs_charset) {
+                    if (is_dir_ext(e_spec, e_len, vs_spec, vs_len)) {
+                        Stat_t statbuf;
+                        int ret_sts;
+
+                        ret_sts = flex_lstat(rstr, &statbuf);
+                        if ((ret_sts == 0) &&
+                            S_ISDIR(statbuf.st_mode)) {
+                            e_len = 0;
+                            e_spec[0] = 0;
+                        }
+                    }
+                }
 
 		/* No version & a null extension on UNIX handling */
-		if (isunix && (e_len == 1) && decc_readdir_dropdotnotype) {
+		if ((e_len == 1) && decc_readdir_dropdotnotype) {
 		    e_len = 0;
 		    *e_spec = '\0';
 		}
@@ -12871,16 +13916,45 @@ Perl_vms_start_glob
 	        for (cp = rstr; *cp; cp++) *cp = _tolower(*cp);
 	    }
 
-	    if (hasdir) {
-		if (isunix) trim_unixpath(rstr,SvPVX(tmpglob),1);
-		begin = rstr;
-	    }
-	    else {
-		/* Start with the name */
-		begin = n_spec;
-	    }
-	    strcat(begin,"\n");
-	    ok = (PerlIO_puts(tmpfp,begin) != EOF);
+            /* Find File treats a Null extension as return all extensions */
+            /* This is contrary to Perl expectations */
+
+            if (wildstar || wildquery || vms_old_glob) {
+                /* really need to see if the returned file name matched */
+                /* but for now will assume that it matches */
+                valid_find = 1;
+            } else {
+                /* Exact Match requested */
+                /* How are directories handled? - like a file */
+                if ((e_len == we_len) && (n_len == wn_len)) {
+                    int t1;
+                    t1 = e_len;
+                    if (t1 > 0)
+                        t1 = strncmp(e_spec, we_spec, e_len);
+                    if (t1 == 0) {
+                       t1 = n_len;
+                       if (t1 > 0)
+                           t1 = strncmp(n_spec, we_spec, n_len);
+                       if (t1 == 0)
+                           valid_find = 1;
+                    }
+                }
+            }
+
+            if (valid_find) {
+	        found++;
+
+	        if (hasdir) {
+		    if (isunix) trim_unixpath(rstr,SvPVX(tmpglob),1);
+		    begin = rstr;
+	        }
+	        else {
+		    /* Start with the name */
+		    begin = n_spec;
+	        }
+	        strcat(begin,"\n");
+	        ok = (PerlIO_puts(tmpfp,begin) != EOF);
+            }
 	}
 	if (cxt) (void)lib$find_file_end(&cxt);
 
@@ -12973,14 +14047,41 @@ vmsrealpath_fromperl(pTHX_ CV *cv)
 /*
  * A thin wrapper around decc$symlink to make sure we follow the 
  * standard and do not create a symlink with a zero-length name.
+ *
+ * Also in ODS-2 mode, existing tests assume that the link target
+ * will be converted to UNIX format.
  */
-/*{{{ int my_symlink(const char *path1, const char *path2)*/
-int my_symlink(const char *path1, const char *path2) {
-  if (!path2 || !*path2) {
+/*{{{ int my_symlink(pTHX_ const char *contents, const char *link_name)*/
+int Perl_my_symlink(pTHX_ const char *contents, const char *link_name) {
+  if (!link_name || !*link_name) {
     SETERRNO(ENOENT, SS$_NOSUCHFILE);
     return -1;
   }
-  return symlink(path1, path2);
+
+  if (decc_efs_charset) {
+      return symlink(contents, link_name);
+  } else {
+      int sts;
+      char * utarget;
+
+      /* Unless we are in ODS-5 mode, convert the symlink target to UNIX */
+      /* because in order to work, the symlink target must be in UNIX format */
+
+      /* As symbolic links can hold things other than files, we will only do */
+      /* the conversion in in ODS-2 mode */
+
+      utarget = PerlMem_malloc(VMS_MAXRSS + 1);
+      if (int_tounixspec(contents, utarget, NULL) == NULL) {
+
+          /* This should not fail, as an untranslatable filename */
+          /* should be passed through */
+          utarget = (char *)contents;
+      }
+      sts = symlink(utarget, link_name);
+      PerlMem_free(utarget);
+      return sts;
+  }
+
 }
 /*}}}*/
 
@@ -12996,13 +14097,19 @@ case_tolerant_process_fromperl(pTHX_ CV *cv)
   XSRETURN(1);
 }
 
+#ifdef USE_ITHREADS
+
 void  
 Perl_sys_intern_dup(pTHX_ struct interp_intern *src, 
                           struct interp_intern *dst)
 {
+    PERL_ARGS_ASSERT_SYS_INTERN_DUP;
+
     memcpy(dst,src,sizeof(struct interp_intern));
 }
 
+#endif
+
 void  
 Perl_sys_intern_clear(pTHX)
 {
@@ -13016,9 +14123,7 @@ Perl_sys_intern_init(pTHX)
 
     VMSISH_HUSHED = 0;
 
-    /* fix me later to track running under GNV */
-    /* this allows some limited testing */
-    MY_POSIX_EXIT = decc_filename_unix_report;
+    MY_POSIX_EXIT = vms_posix_exit;
 
     x = (float)ix;
     MY_INV_RAND_MAX = 1./x;
@@ -13069,6 +14174,11 @@ char *realpath(const char *file_name, char * resolved_name, ...);
 
 /* Hack, use old stat() as fastest way of getting ino_t and device */
 int decc$stat(const char *name, void * statbuf);
+#if !defined(__VAX) && __CRTL_VER >= 80200000
+int decc$lstat(const char *name, void * statbuf);
+#else
+#define decc$lstat decc$stat
+#endif
 
 
 /* Realpath is fragile.  In 8.3 it does not work if the feature
@@ -13079,31 +14189,119 @@ int decc$stat(const char *name, void * statbuf);
  * fall back to looking up the filename by the device name and FID.
  */
 
-int vms_fid_to_name(char * outname, int outlen, const char * name)
+int vms_fid_to_name(char * outname, int outlen,
+                    const char * name, int lstat_flag, mode_t * mode)
 {
+#pragma message save
+#pragma message disable MISALGNDSTRCT
+#pragma message disable MISALGNDMEM
+#pragma member_alignment save
+#pragma nomember_alignment
 struct statbuf_t {
     char	   * st_dev;
     unsigned short st_ino[3];
-    unsigned short padw;
+    unsigned short old_st_mode;
     unsigned long  padl[30];  /* plenty of room */
 } statbuf;
-int sts;
-struct dsc$descriptor_s dvidsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
-struct dsc$descriptor_s specdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+#pragma message restore
+#pragma member_alignment restore
+
+    int sts;
+    struct dsc$descriptor_s dvidsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+    struct dsc$descriptor_s specdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+    char *fileified;
+    char *temp_fspec;
+    char *ret_spec;
+
+    /* Need to follow the mostly the same rules as flex_stat_int, or we may get
+     * unexpected answers
+     */
+
+    fileified = PerlMem_malloc(VMS_MAXRSS);
+    if (fileified == NULL)
+        _ckvmssts_noperl(SS$_INSFMEM);
+     
+    temp_fspec = PerlMem_malloc(VMS_MAXRSS);
+    if (temp_fspec == NULL)
+        _ckvmssts_noperl(SS$_INSFMEM);
+
+    sts = -1;
+    /* First need to try as a directory */
+    ret_spec = int_tovmspath(name, temp_fspec, NULL);
+    if (ret_spec != NULL) {
+        ret_spec = int_fileify_dirspec(temp_fspec, fileified, NULL); 
+        if (ret_spec != NULL) {
+            if (lstat_flag == 0)
+                sts = decc$stat(fileified, &statbuf);
+            else
+                sts = decc$lstat(fileified, &statbuf);
+        }
+    }
+
+    /* Then as a VMS file spec */
+    if (sts != 0) {
+        ret_spec = int_tovmsspec(name, temp_fspec, 0, NULL);
+        if (ret_spec != NULL) {
+            if (lstat_flag == 0) {
+                sts = decc$stat(temp_fspec, &statbuf);
+            } else {
+                sts = decc$lstat(temp_fspec, &statbuf);
+            }
+        }
+    }
+
+    if (sts) {
+        /* Next try - allow multiple dots with out EFS CHARSET */
+        /* The CRTL stat() falls down hard on multi-dot filenames in unix
+         * format unless * DECC$EFS_CHARSET is in effect, so temporarily
+         * enable it if it isn't already.
+         */
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
+        if (!decc_efs_charset && (decc_efs_charset_index > 0))
+            decc$feature_set_value(decc_efs_charset_index, 1, 1); 
+#endif
+        ret_spec = int_tovmspath(name, temp_fspec, NULL);
+        if (lstat_flag == 0) {
+            sts = decc$stat(name, &statbuf);
+        } else {
+            sts = decc$lstat(name, &statbuf);
+        }
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
+        if (!decc_efs_charset && (decc_efs_charset_index > 0))
+            decc$feature_set_value(decc_efs_charset_index, 1, 0); 
+#endif
+    }
+
+
+    /* and then because the Perl Unix to VMS conversion is not perfect */
+    /* Specifically the CRTL removes spaces and possibly other illegal ODS-2 */
+    /* characters from filenames so we need to try it as-is */
+    if (sts) {
+        if (lstat_flag == 0) {
+            sts = decc$stat(name, &statbuf);
+        } else {
+            sts = decc$lstat(name, &statbuf);
+        }
+    }
 
-    sts = decc$stat(name, &statbuf);
     if (sts == 0) {
+        int vms_sts;
 
 	dvidsc.dsc$a_pointer=statbuf.st_dev;
-       dvidsc.dsc$w_length=strlen(statbuf.st_dev);
+        dvidsc.dsc$w_length=strlen(statbuf.st_dev);
 
 	specdsc.dsc$a_pointer = outname;
 	specdsc.dsc$w_length = outlen-1;
 
-       sts = lib$fid_to_name
+        vms_sts = lib$fid_to_name
 	    (&dvidsc, statbuf.st_ino, &specdsc, &specdsc.dsc$w_length);
-       if ($VMS_STATUS_SUCCESS(sts)) {
+        if ($VMS_STATUS_SUCCESS(vms_sts)) {
 	    outname[specdsc.dsc$w_length] = 0;
+
+            /* Return the mode */
+            if (mode) {
+                *mode = statbuf.old_st_mode;
+            }
 	    return 0;
 	}
     }
@@ -13133,12 +14331,13 @@ mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf,
         char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec;
         int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
         int file_len;
+        mode_t my_mode;
 
 	/* Fall back to fid_to_name */
 
         Newx(vms_spec, VMS_MAXRSS + 1, char);
 
-	sts = vms_fid_to_name(vms_spec, VMS_MAXRSS + 1, filespec);
+	sts = vms_fid_to_name(vms_spec, VMS_MAXRSS + 1, filespec, 0, &my_mode);
 	if (sts == 0) {
 
 
@@ -13167,8 +14366,22 @@ mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf,
 	            int file_len = v_len + r_len + d_len + n_len + e_len;
 	            vms_spec[file_len] = 0;
 
+	            /* Trim off the .DIR if this is a directory */
+	            if (is_dir_ext(e_spec, e_len, vs_spec, vs_len)) {
+                        if (S_ISDIR(my_mode)) {
+                            e_len = 0;
+                            e_spec[0] = 0;
+                        }
+	            }
+
+	            /* Drop NULL extensions on UNIX file specification */
+		    if ((e_len == 1) && decc_readdir_dropdotnotype) {
+			e_len = 0;
+			e_spec[0] = '\0';
+		    }
+
 	            /* The result is expected to be in UNIX format */
-		    rslt = do_tounixspec(vms_spec, outbuf, 0, utf8_fl);
+		    rslt = int_tounixspec(vms_spec, outbuf, utf8_fl);
 
                     /* Downcase if input had any lower case letters and 
 	             * case preservation is not in effect. 
@@ -13180,8 +14393,101 @@ mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf,
 	                if (haslower) __mystrtolower(rslt);
 	            }
 	        }
-	}
+	} else {
+
+	    /* Now for some hacks to deal with backwards and forward */
+	    /* compatibilty */
+	    if (!decc_efs_charset) {
 
+		/* 1. ODS-2 mode wants to do a syntax only translation */
+		rslt = int_rmsexpand(filespec, outbuf,
+				    NULL, 0, NULL, utf8_fl);
+
+	    } else {
+		if (decc_filename_unix_report) {
+		    char * dir_name;
+		    char * vms_dir_name;
+		    char * file_name;
+
+		    /* 2. ODS-5 / UNIX report mode should return a failure */
+		    /*    if the parent directory also does not exist */
+		    /*    Otherwise, get the real path for the parent */
+		    /*    and add the child to it.
+
+		    /* basename / dirname only available for VMS 7.0+ */
+		    /* So we may need to implement them as common routines */
+
+		    Newx(dir_name, VMS_MAXRSS + 1, char);
+		    Newx(vms_dir_name, VMS_MAXRSS + 1, char);
+		    dir_name[0] = '\0';
+		    file_name = NULL;
+
+		    /* First try a VMS parse */
+		    sts = vms_split_path
+			  (filespec,
+			   &v_spec,
+			   &v_len,
+			   &r_spec,
+			   &r_len,
+			   &d_spec,
+			   &d_len,
+			   &n_spec,
+			   &n_len,
+			   &e_spec,
+			   &e_len,
+			   &vs_spec,
+			   &vs_len);
+
+		    if (sts == 0) {
+			/* This is VMS */
+
+			int dir_len = v_len + r_len + d_len + n_len;
+			if (dir_len > 0) {
+			   strncpy(dir_name, filespec, dir_len);
+			   dir_name[dir_len] = '\0';
+			   file_name = (char *)&filespec[dir_len + 1];
+			}
+		    } else {
+			/* This must be UNIX */
+			char * tchar;
+
+			tchar = strrchr(filespec, '/');
+
+			if (tchar != NULL) {
+			    int dir_len = tchar - filespec;
+			    strncpy(dir_name, filespec, dir_len);
+			    dir_name[dir_len] = '\0';
+			    file_name = (char *) &filespec[dir_len + 1];
+			}
+		    }
+
+		    /* Dir name is defaulted */
+		    if (dir_name[0] == 0) {
+			dir_name[0] = '.';
+			dir_name[1] = '\0';
+		    }
+
+		    /* Need realpath for the directory */
+		    sts = vms_fid_to_name(vms_dir_name,
+					  VMS_MAXRSS + 1,
+					  dir_name, 0, NULL);
+
+		    if (sts == 0) {
+		        /* Now need to pathify it.
+		        char *tdir = int_pathify_dirspec(vms_dir_name,
+							 outbuf);
+
+			/* And now add the original filespec to it */
+			if (file_name != NULL) {
+			    strcat(outbuf, file_name);
+			}
+			return outbuf;
+		    }
+		    Safefree(vms_dir_name);
+		    Safefree(dir_name);
+		}
+            }
+        }
         Safefree(vms_spec);
     }
     return rslt;
@@ -13197,7 +14503,7 @@ mp_do_vms_realname(pTHX_ const char *filespec, char *outbuf,
 
     /* Fall back to fid_to_name */
 
-    sts = vms_fid_to_name(outbuf, VMS_MAXRSS + 1, filespec);
+    sts = vms_fid_to_name(outbuf, VMS_MAXRSS + 1, filespec, 0, NULL);
     if (sts != 0) {
 	return NULL;
     }
@@ -13352,7 +14658,6 @@ static int set_features
 {
     int status;
     int s;
-    int dflt;
     char* str;
     char val_str[10];
 #if defined(JPI$_CASE_LOOKUP_PERM) && !defined(__VAX)
@@ -13366,28 +14671,62 @@ static int set_features
     vms_debug_on_exception = 0;
     status = sys_trnlnm("PERL_VMS_EXCEPTION_DEBUG", val_str, sizeof(val_str));
     if ($VMS_STATUS_SUCCESS(status)) {
+       val_str[0] = _toupper(val_str[0]);
        if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
 	 vms_debug_on_exception = 1;
        else
 	 vms_debug_on_exception = 0;
     }
 
+    /* Debug unix/vms file translation routines */
+    vms_debug_fileify = 0;
+    status = sys_trnlnm("PERL_VMS_FILEIFY_DEBUG", val_str, sizeof(val_str));
+    if ($VMS_STATUS_SUCCESS(status)) {
+	val_str[0] = _toupper(val_str[0]);
+        if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
+	    vms_debug_fileify = 1;
+        else
+	    vms_debug_fileify = 0;
+    }
+
+
+    /* Historically PERL has been doing vmsify / stat differently than */
+    /* the CRTL.  In particular, under some conditions the CRTL will   */
+    /* remove some illegal characters like spaces from filenames       */
+    /* resulting in some differences.  The stat()/lstat() wrapper has  */
+    /* been reporting such file names as invalid and fails to stat them */
+    /* fixing this bug so that stat()/lstat() accept these like the     */
+    /* CRTL does will result in several tests failing.                  */
+    /* This should really be fixed, but for now, set up a feature to    */
+    /* enable it so that the impact can be studied.                     */
+    vms_bug_stat_filename = 0;
+    status = sys_trnlnm("PERL_VMS_BUG_STAT_FILENAME", val_str, sizeof(val_str));
+    if ($VMS_STATUS_SUCCESS(status)) {
+	val_str[0] = _toupper(val_str[0]);
+        if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
+	    vms_bug_stat_filename = 1;
+        else
+	    vms_bug_stat_filename = 0;
+    }
+
+
     /* Create VTF-7 filenames from Unicode instead of UTF-8 */
     vms_vtf7_filenames = 0;
     status = sys_trnlnm("PERL_VMS_VTF7_FILENAMES", val_str, sizeof(val_str));
     if ($VMS_STATUS_SUCCESS(status)) {
+       val_str[0] = _toupper(val_str[0]);
        if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
 	 vms_vtf7_filenames = 1;
        else
 	 vms_vtf7_filenames = 0;
     }
 
-
     /* unlink all versions on unlink() or rename() */
     vms_unlink_all_versions = 0;
     status = sys_trnlnm
 	("PERL_VMS_UNLINK_ALL_VERSIONS", val_str, sizeof(val_str));
     if ($VMS_STATUS_SUCCESS(status)) {
+       val_str[0] = _toupper(val_str[0]);
        if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
 	 vms_unlink_all_versions = 1;
        else
@@ -13399,7 +14738,6 @@ static int set_features
     gnv_unix_shell = 0;
     status = sys_trnlnm("GNV$UNIX_SHELL", val_str, sizeof(val_str));
     if ($VMS_STATUS_SUCCESS(status)) {
-       if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
 	 gnv_unix_shell = 1;
 	 set_feature_default("DECC$EFS_CASE_PRESERVE", 1);
 	 set_feature_default("DECC$EFS_CHARSET", 1);
@@ -13408,48 +14746,28 @@ static int set_features
 	 set_feature_default("DECC$READDIR_DROPDOTNOTYPE", 1);
 	 set_feature_default("DECC$DISABLE_POSIX_ROOT", 0);
 	 vms_unlink_all_versions = 1;
-       }
-       else
-	 gnv_unix_shell = 0;
+	 vms_posix_exit = 1;
     }
 #endif
 
     /* hacks to see if known bugs are still present for testing */
 
-    /* Readdir is returning filenames in VMS syntax always */
-    decc_bug_readdir_efs1 = 1;
-    status = sys_trnlnm("DECC_BUG_READDIR_EFS1", val_str, sizeof(val_str));
-    if ($VMS_STATUS_SUCCESS(status)) {
-       if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
-         decc_bug_readdir_efs1 = 1;
-       else
-	 decc_bug_readdir_efs1 = 0;
-    }
-
     /* PCP mode requires creating /dev/null special device file */
     decc_bug_devnull = 0;
     status = sys_trnlnm("DECC_BUG_DEVNULL", val_str, sizeof(val_str));
     if ($VMS_STATUS_SUCCESS(status)) {
+       val_str[0] = _toupper(val_str[0]);
        if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
           decc_bug_devnull = 1;
        else
 	  decc_bug_devnull = 0;
     }
 
-    /* fgetname returning a VMS name in UNIX mode */
-    decc_bug_fgetname = 1;
-    status = sys_trnlnm("DECC_BUG_FGETNAME", val_str, sizeof(val_str));
-    if ($VMS_STATUS_SUCCESS(status)) {
-      if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
-	decc_bug_fgetname = 1;
-      else
-	decc_bug_fgetname = 0;
-    }
-
     /* UNIX directory names with no paths are broken in a lot of places */
     decc_dir_barename = 1;
     status = sys_trnlnm("DECC_DIR_BARENAME", val_str, sizeof(val_str));
     if ($VMS_STATUS_SUCCESS(status)) {
+      val_str[0] = _toupper(val_str[0]);
       if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
 	decc_dir_barename = 1;
       else
@@ -13472,6 +14790,7 @@ static int set_features
     }
 
     s = decc$feature_get_index("DECC$EFS_CHARSET");
+    decc_efs_charset_index = s;
     if (s >= 0) {
 	decc_efs_charset = decc$feature_get_value(s, 1);
 	if (decc_efs_charset < 0)
@@ -13481,8 +14800,10 @@ static int set_features
     s = decc$feature_get_index("DECC$FILENAME_UNIX_REPORT");
     if (s >= 0) {
 	decc_filename_unix_report = decc$feature_get_value(s, 1);
-	if (decc_filename_unix_report > 0)
+	if (decc_filename_unix_report > 0) {
 	    decc_filename_unix_report = 1;
+	    vms_posix_exit = 1;
+	}
 	else
 	    decc_filename_unix_report = 0;
     }
@@ -13512,26 +14833,6 @@ static int set_features
 	    decc_readdir_dropdotnotype = 0;
     }
 
-    status = sys_trnlnm("SYS$POSIX_ROOT", val_str, sizeof(val_str));
-    if ($VMS_STATUS_SUCCESS(status)) {
-	s = decc$feature_get_index("DECC$DISABLE_POSIX_ROOT");
-	if (s >= 0) {
-	    dflt = decc$feature_get_value(s, 4);
-	    if (dflt > 0) {
-		decc_disable_posix_root = decc$feature_get_value(s, 1);
-		if (decc_disable_posix_root <= 0) {
-		    decc$feature_set_value(s, 1, 1);
-		    decc_disable_posix_root = 1;
-		}
-	    }
-	    else {
-		/* Traditionally Perl assumes this is off */
-		decc_disable_posix_root = 1;
-		decc$feature_set_value(s, 1, 1);
-	    }
-	}
-    }
-
 #if __CRTL_VER >= 80200000
     s = decc$feature_get_index("DECC$POSIX_COMPLIANT_PATHNAMES");
     if (s >= 0) {
@@ -13594,7 +14895,7 @@ static int set_features
     }
 #endif
 
-#if defined(JPI$_CASE_LOOKUP_PERM) && !defined(__VAX)
+#if defined(JPI$_CASE_LOOKUP_PERM) && defined(PPROP$K_CASE_BLIND) && !defined(__VAX)
 
      /* Report true case tolerance */
     /*----------------------------*/
@@ -13610,6 +14911,18 @@ static int set_features
 
 #endif
 
+    /* USE POSIX/DCL Exit codes - Recommended, but needs to default to  */
+    /* for strict backward compatibilty */
+    status = sys_trnlnm
+	("PERL_VMS_POSIX_EXIT", val_str, sizeof(val_str));
+    if ($VMS_STATUS_SUCCESS(status)) {
+       val_str[0] = _toupper(val_str[0]);
+       if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
+	 vms_posix_exit = 1;
+       else
+	 vms_posix_exit = 0;
+    }
+
 
     /* CRTL can be initialized past this point, but not before. */
 /*    DECC$CRTL_INIT(); */
diff --git a/gnu/usr.bin/perl/vms/vmsish.h b/gnu/usr.bin/perl/vms/vmsish.h
index 90311a06d07..95ac23b403a 100644
--- a/gnu/usr.bin/perl/vms/vmsish.h
+++ b/gnu/usr.bin/perl/vms/vmsish.h
@@ -133,6 +133,7 @@
 #define vms_image_init	Perl_vms_image_init
 #define my_tmpfile		Perl_my_tmpfile
 #define vmstrnenv           	Perl_vmstrnenv            
+#define my_fgetname(a, b)	Perl_my_fgetname(a, b)
 #if !defined(PERL_IMPLICIT_CONTEXT)
 #define my_getenv_len		Perl_my_getenv_len
 #define vmssetenv		Perl_vmssetenv
@@ -276,7 +277,7 @@
 #define my_endpwent()		Perl_my_endpwent(aTHX)
 #define my_getlogin		Perl_my_getlogin
 #ifdef HAS_SYMLINK
-#  define my_symlink		Perl_my_symlink
+#  define my_symlink(a, b)	Perl_my_symlink(aTHX_ a, b)
 #endif
 #define init_os_extras		Perl_init_os_extras
 #define vms_realpath(a, b, c)	Perl_vms_realpath(aTHX_ a,b,c)
@@ -361,7 +362,11 @@
 #define HINT_M_VMSISH_TIME	0x80000000 /* times are local, not UTC */
 #define NATIVE_HINTS		(PL_hints >> HINT_V_VMSISH)  /* used in op.c */
 
-#define TEST_VMSISH(h)	(PL_curcop->op_private & ((h) >> HINT_V_VMSISH))
+#ifdef PERL_IMPLICIT_CONTEXT
+#  define TEST_VMSISH(h)	(my_perl && PL_curcop && (PL_curcop->op_private & ((h) >> HINT_V_VMSISH)))
+#else
+#  define TEST_VMSISH(h)	(PL_curcop && (PL_curcop->op_private & ((h) >> HINT_V_VMSISH)))
+#endif
 #define VMSISH_STATUS	TEST_VMSISH(HINT_M_VMSISH_STATUS)
 #define VMSISH_TIME	TEST_VMSISH(HINT_M_VMSISH_TIME)
 
@@ -413,7 +418,12 @@ struct interp_intern {
 #define HAS_KILL
 #define HAS_WAIT
 
-#define PERL_FS_VER_FMT		"%d_%d_%d"
+#ifndef PERL_CORE
+#  define PERL_FS_VER_FMT	"%d_%d_%d"
+#endif
+#define PERL_FS_VERSION		STRINGIFY(PERL_REVISION) "_" \
+				STRINGIFY(PERL_VERSION) "_" \
+				STRINGIFY(PERL_SUBVERSION)
 /* Temporary; we need to add support for this to Configure.Com */
 #ifdef PERL_INC_VERSION_LIST
 #  undef PERL_INC_VERSION_LIST
@@ -449,7 +459,11 @@ struct interp_intern {
  *	getgrgid() routines are available to get group entries.
  *	The getgrent() has a separate definition, HAS_GETGRENT.
  */
+#if __CRTL_VER >= 70302000
+#define HAS_GROUP		/**/
+#else
 #undef HAS_GROUP		/**/
+#endif
 
 /* HAS_PASSWD
  *	This symbol, if defined, indicates that the getpwnam() and
@@ -512,6 +526,7 @@ struct interp_intern {
 #  define fwrite my_fwrite     /* for PerlSIO_fwrite */
 #  define fdopen my_fdopen
 #  define fclose my_fclose
+#  define fgetname(a, b) my_fgetname(a, b)
 #ifdef HAS_SYMLINK
 #  define symlink my_symlink
 #endif
@@ -962,13 +977,12 @@ int	Perl_flex_lstat (pTHX_ const char *, Stat_t *);
 int	Perl_flex_stat (pTHX_ const char *, Stat_t *);
 int	my_vfork (void);
 bool	Perl_vms_do_exec (pTHX_ const char *);
-unsigned long int	Perl_do_aspawn (pTHX_ void *, void **, void **);
-unsigned long int	Perl_do_spawn (pTHX_ const char *);
 FILE *  my_fdopen (int, const char *);
 int     my_fclose (FILE *);
 int     my_fwrite (const void *, size_t, size_t, FILE *);
+char *  Perl_my_fgetname (FILE *fp, char *buf);
 #ifdef HAS_SYMLINK
-int     my_symlink(const char *path1, const char *path2);
+int     Perl_my_symlink(pTHX_ const char *path1, const char *path2);
 #endif
 int	Perl_my_flush (pTHX_ FILE *);
 struct passwd *	Perl_my_getpwnam (pTHX_ const char *name);
diff --git a/gnu/usr.bin/perl/win32/Makefile b/gnu/usr.bin/perl/win32/Makefile
index b328dddb260..06d06d6ee68 100644
--- a/gnu/usr.bin/perl/win32/Makefile
+++ b/gnu/usr.bin/perl/win32/Makefile
@@ -32,7 +32,7 @@ INST_TOP	= $(INST_DRV)\perl
 # versioned installation can be obtained by setting INST_TOP above to a

 # path that includes an arbitrary version string.

 #

-#INST_VER	= \5.10.0

+#INST_VER	= \5.10.1

 

 #

 # Comment this out if you DON'T want your perl installation to have

@@ -383,16 +383,13 @@ DELAYLOAD	= -DELAYLOAD:ws2_32.dll delayimp.lib
 

 # Visual C++ 2005 and 2008 (VC++ 8.x and 9.x) create manifest files for EXEs and

 # DLLs. These either need copying everywhere with the binaries, or else need

-# embedding in them otherwise MSVCR80.dll or MSVCR90.dll won't be found. Embed

-# them for simplicity, and delete them afterwards so that they don't get

-# installed too.

-!IF "$(CCTYPE)" == "MSVC80" || "$(CCTYPE)" == "MSVC80FREE" || \

-    "$(CCTYPE)" == "MSVC90" || "$(CCTYPE)" == "MSVC90FREE"

-EMBED_EXE_MANI	= mt -nologo -manifest $@.manifest -outputresource:$@;1 && \

-		  del $@.manifest

-EMBED_DLL_MANI	= mt -nologo -manifest $@.manifest -outputresource:$@;2 && \

-		  del $@.manifest

-!ENDIF

+# embedding in them otherwise MSVCR80.dll or MSVCR90.dll won't be found. For

+# simplicity, embed them if they exist (and delete them afterwards so that they

+# don't get installed too).

+EMBED_EXE_MANI	= if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1 && \

+		  if exist $@.manifest del $@.manifest

+EMBED_DLL_MANI	= if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2 && \

+		  if exist $@.manifest del $@.manifest

 

 ARCHDIR		= ..\lib\$(ARCHNAME)

 COREDIR		= ..\lib\CORE

@@ -616,7 +613,6 @@ UTILS		=			\
 		..\utils\cpan2dist	\

 		..\utils\shasum		\

 		..\utils\instmodsh	\

-		..\pod\checkpods	\

 		..\pod\pod2html		\

 		..\pod\pod2latex	\

 		..\pod\pod2man		\

@@ -767,7 +763,7 @@ CORE_NOCFG_H	=		\
 		.\include\sys\socket.h	\

 		.\win32.h

 

-CORE_H		= $(CORE_NOCFG_H) .\config.h

+CORE_H		= $(CORE_NOCFG_H) .\config.h ..\git_version.h

 

 UUDMAP_H	= ..\uudmap.h

 

@@ -839,8 +835,8 @@ CFG_VARS	=					\
 # Top targets

 #

 

-all : .\config.h $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(UNIDATAFILES) MakePPPort \

-	$(PERLEXE) $(X2P) Extensions $(PERLSTATIC)

+all : .\config.h ..\git_version.h $(GLOBEXE) $(MINIMOD) $(CONFIGPM) \

+	$(UNIDATAFILES) MakePPPort $(PERLEXE) $(X2P) Extensions $(PERLSTATIC)

 	@echo	Everything is up to date. '$(MAKE_BARE) test' to run test suite.

 

 ..\regcharclass.h : ..\Porting\regcharclass.pl

@@ -854,8 +850,8 @@ regnodes : ..\regnodes.h
 

 ..\regexec$(o) : ..\regnodes.h ..\regcharclass.h

 

-reonly : regnodes .\config.h $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(UNIDATAFILES) \

-	$(PERLEXE) $(X2P) Extensions_reonly

+reonly : regnodes .\config.h ..\git_version.h $(GLOBEXE) $(MINIMOD) $(CONFIGPM) \

+	$(UNIDATAFILES) $(PERLEXE) $(X2P) Extensions_reonly

 	@echo	Perl and 're' are up to date.

 

 $(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c

@@ -878,21 +874,33 @@ config.w32 : $(CFGSH_TMPL)
 	-del /f config.h

 	copy $(CFGH_TMPL) config.h

 

+..\git_version.h : $(MINIPERL) ..\make_patchnum.pl

+	cd ..

+	miniperl -Ilib make_patchnum.pl

+	cd win32

+

+# make sure that we recompile perl.c if the git version changes

+..\perl$(o) : ..\git_version.h

+

 ..\config.sh : config.w32 $(MINIPERL) config_sh.PL

 	$(MINIPERL) -I..\lib config_sh.PL $(CFG_VARS) config.w32 > ..\config.sh

 

-# this target is for when changes to the main config.sh happen

-# edit config.{b,v,g}c and make this target once for each supported

-# compiler (e.g. `nmake CCTYPE=BORLAND regen_config_h`)

+# this target is for when changes to the main config.sh happen.

+# edit config.vc, then make perl in a minimal configuration (i.e. with MULTI,

+# ITHREADS, IMP_SYS, LARGE_FILES, PERLIO and CRYPT off), then make this target

+# to regenerate config_H.vc.

+# repeat for config.vc64 and config_H.vc64 if you have a suitable build

+# environment, otherwise hand-edit them to maintain the same differences with

+# config.vc and config_H.vc as before.

+# unfortunately, some further manual editing is also then required to restore all

+# the special __GNUC__ handling that is otherwise lost.

 regen_config_h:

-	perl config_sh.PL $(CFG_VARS) $(CFGSH_TMPL) > ..\config.sh

+	$(MINIPERL) -I..\lib config_sh.PL $(CFG_VARS) $(CFGSH_TMPL) > ..\config.sh

 	cd ..

-	-del /f perl.exe perl*.dll

-	perl configpm

+	miniperl configpm

 	cd win32

 	-del /f $(CFGH_TMPL)

-	-mkdir $(COREDIR)

-	-perl config_h.PL "INST_VER=$(INST_VER)"

+	-$(MINIPERL) -I..\lib config_h.PL "INST_VER=$(INST_VER)"

 	rename config.h $(CFGH_TMPL)

 

 $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl

@@ -917,7 +925,7 @@ $(MINIDIR) :
 	if not exist "$(MINIDIR)" mkdir "$(MINIDIR)"

 

 $(MINICORE_OBJ) : $(CORE_NOCFG_H)

-	$(CC) -c $(CFLAGS) -DPERL_EXTERNAL_GLOB $(OBJOUT_FLAG)$@ ..\$(*F).c

+	$(CC) -c $(CFLAGS) -DPERL_EXTERNAL_GLOB -DPERL_IS_MINIPERL $(OBJOUT_FLAG)$@ ..\$(*F).c

 

 $(MINIWIN32_OBJ) : $(CORE_NOCFG_H)

 	$(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*F).c

@@ -931,6 +939,7 @@ perllib$(o)	: perllib.c .\perlhost.h .\vdir.h .\vmem.h
 

 # 1. we don't want to rebuild miniperl.exe when config.h changes

 # 2. we don't want to rebuild miniperl.exe with non-default config.h

+# 3. we can't have miniperl.exe depend on git_version.h, as miniperl creates it

 $(MINI_OBJ)	: $(CORE_NOCFG_H)

 

 $(WIN32_OBJ)	: $(CORE_H)

@@ -938,8 +947,8 @@ $(CORE_OBJ)	: $(CORE_H)
 $(DLL_OBJ)	: $(CORE_H)

 $(X2P_OBJ)	: $(CORE_H)

 

-perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym ..\pp.sym ..\makedef.pl

-	$(MINIPERL) -I..\lib buildext.pl --create-perllibst-h

+perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym ..\pp.sym ..\makedef.pl create_perllibst_h.pl

+	$(MINIPERL) -I..\lib create_perllibst_h.pl

 	$(MINIPERL) -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) $(BUILDOPT) \

 	    CCTYPE=$(CCTYPE) > perldll.def

 

@@ -1049,29 +1058,24 @@ MakePPPort_clean:
 	-if exist $(MINIPERL) $(MINIPERL) -I..\lib ..\mkppport --clean

 

 #-------------------------------------------------------------------------------

-Extensions: buildext.pl $(PERLDEP) $(CONFIGPM)

+Extensions: ..\make_ext.pl $(PERLDEP) $(CONFIGPM)

 	$(XCOPY) ..\*.h $(COREDIR)\*.*

-	$(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --dynamic

-	-if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --dynamic

+	$(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(MAKE)" --dir=$(EXTDIR) --dynamic

 

-Extensions_reonly: buildext.pl $(PERLDEP) $(CONFIGPM)

+Extensions_reonly: ..\make_ext.pl $(PERLDEP) $(CONFIGPM)

 	$(XCOPY) ..\*.h $(COREDIR)\*.*

-	$(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --dynamic +re

-	-if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --dynamic +re

+	$(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(MAKE)" --dir=$(EXTDIR) --dynamic +re

 

-Extensions_static : buildext.pl $(PERLDEP) $(CONFIGPM)

+Extensions_static : ..\make_ext.pl list_static_libs.pl $(PERLDEP) $(CONFIGPM)

 	$(XCOPY) ..\*.h $(COREDIR)\*.*

-	$(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --static

-	-if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --static

-	$(MINIPERL) -I..\lib buildext.pl --list-static-libs > Extensions_static

+	$(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(MAKE)" --dir=$(EXTDIR) --static

+	$(MINIPERL) -I..\lib list_static_libs.pl > Extensions_static

 

 Extensions_clean: 

-	-if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) clean

-	-if exist $(MINIPERL) if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext clean

+	-if exist $(MINIPERL) $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(MAKE)" --dir=$(EXTDIR) --all --target=clean

 

 Extensions_realclean: 

-	-if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) realclean

-	-if exist $(MINIPERL) if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext realclean

+	-if exist $(MINIPERL) $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(MAKE)" --dir=$(EXTDIR) --all --target=realclean

 

 #-------------------------------------------------------------------------------

 

@@ -1087,7 +1091,6 @@ utils: $(PERLEXE) $(X2P)
 	cd ..\utils

 	$(MAKE) PERL=$(MINIPERL)

 	cd ..\pod

-	copy ..\vms\perlvms.pod .\perlvms.pod

 	copy ..\README.aix      ..\pod\perlaix.pod

 	copy ..\README.amiga    ..\pod\perlamiga.pod

 	copy ..\README.apollo   ..\pod\perlapollo.pod

@@ -1100,6 +1103,7 @@ utils: $(PERLEXE) $(X2P)
 	copy ..\README.dos      ..\pod\perldos.pod

 	copy ..\README.epoc     ..\pod\perlepoc.pod

 	copy ..\README.freebsd  ..\pod\perlfreebsd.pod

+	copy ..\README.haiku    ..\pod\perlhaiku.pod

 	copy ..\README.hpux     ..\pod\perlhpux.pod

 	copy ..\README.hurd     ..\pod\perlhurd.pod

 	copy ..\README.irix     ..\pod\perlirix.pod

@@ -1125,15 +1129,17 @@ utils: $(PERLEXE) $(X2P)
 	copy ..\README.tw       ..\pod\perltw.pod

 	copy ..\README.uts      ..\pod\perluts.pod

 	copy ..\README.vmesa    ..\pod\perlvmesa.pod

-	copy ..\README.vms      ..\pod\perlvms.pod

 	copy ..\README.vos      ..\pod\perlvos.pod

 	copy ..\README.win32    ..\pod\perlwin32.pod

-	copy ..\pod\perl5100delta.pod ..\pod\perldelta.pod

+	copy ..\pod\perl5101delta.pod ..\pod\perldelta.pod

 	$(MAKE) -f ..\win32\pod.mak converters

 	cd ..\lib

 	$(PERLEXE) lib_pm.PL

 	cd ..\win32

 	$(PERLEXE) $(PL2BAT) $(UTILS)

+	$(PERLEXE) ..\autodoc.pl ..

+	$(PERLEXE) ..\pod\perlmodlib.pl -q

+	$(PERLEXE) ..\pod\buildtoc --build-toc -q

 

 # Note that the pod cleanup in this next section is parsed (and regenerated

 # by pod/buildtoc so please check that script before making changes here

@@ -1179,6 +1185,10 @@ distclean: realclean
 	-if exist $(LIBDIR)\Encode rmdir /s /q $(LIBDIR)\Encode

 	-if exist $(LIBDIR)\Filter\Util rmdir /s /q $(LIBDIR)\Filter\Util

 	-if exist $(LIBDIR)\Hash rmdir /s /q $(LIBDIR)\Hash

+	-if exist $(LIBDIR)\App rmdir /s /q $(LIBDIR)\App

+	-if exist $(LIBDIR)\Module\Pluggable rmdir /s /q $(LIBDIR)\Module\Pluggable

+	-if exist $(LIBDIR)\TAP rmdir /s /q $(LIBDIR)\TAP

+	-if exist $(LIBDIR)\mro rmdir /s /q $(LIBDIR)\mro

 	-if exist $(LIBDIR)\IO\Compress rmdir /s /q $(LIBDIR)\IO\Compress

 	-if exist $(LIBDIR)\IO\Socket rmdir /s /q $(LIBDIR)\IO\Socket

 	-if exist $(LIBDIR)\IO\Uncompress rmdir /s /q $(LIBDIR)\IO\Uncompress

@@ -1190,18 +1200,18 @@ distclean: realclean
 	-if exist $(LIBDIR)\threads rmdir /s /q $(LIBDIR)\threads

 	-if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS

 	-if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API

-	-cd $(PODDIR) && del /f *.html *.bat checkpods \

-	    perlaix.pod perlamiga.pod perlapollo.pod perlbeos.pod \

-	    perlbs2000.pod perlce.pod perlcn.pod perlcygwin.pod \

-	    perldelta.pod perldgux.pod perldos.pod perlepoc.pod \

-	    perlfreebsd.pod perlhpux.pod perlhurd.pod perlirix.pod \

-	    perljp.pod perlko.pod perllinux.pod perlmachten.pod \

-	    perlmacos.pod perlmacosx.pod perlmint.pod perlmpeix.pod \

-	    perlnetware.pod perlopenbsd.pod perlos2.pod perlos390.pod \

-	    perlos400.pod perlplan9.pod perlqnx.pod perlriscos.pod \

-	    perlsolaris.pod perlsymbian.pod perltru64.pod perltw.pod \

-	    perluts.pod perlvmesa.pod perlvms.pod perlvms.pod perlvos.pod \

-	    perlwin32.pod \

+	-cd $(PODDIR) && del /f *.html *.bat podchecker \

+	    perlaix.pod perlamiga.pod perlapi.pod perlapollo.pod \

+	    perlbeos.pod perlbs2000.pod perlce.pod perlcn.pod \

+	    perlcygwin.pod perldelta.pod perldgux.pod perldos.pod \

+	    perlepoc.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \

+	    perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \

+	    perllinux.pod perlmachten.pod perlmacos.pod perlmacosx.pod \

+	    perlmint.pod perlmodlib.pod perlmpeix.pod perlnetware.pod \

+	    perlopenbsd.pod perlos2.pod perlos390.pod perlos400.pod \

+	    perlplan9.pod perlqnx.pod perlriscos.pod perlsolaris.pod \

+	    perlsymbian.pod perltoc.pod perltru64.pod perltw.pod \

+	    perluts.pod perlvmesa.pod perlvos.pod perlwin32.pod \

 	    pod2html pod2latex pod2man pod2text pod2usage \

 	    podchecker podselect

 	-cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \

@@ -1211,6 +1221,7 @@ distclean: realclean
 	-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new \

 	        perlmainst.c

 	-del /f $(CONFIGPM)

+	-del /f ..\lib\Config_git.pl

 	-del /f bin\*.bat

 	-del /f perllibst.h

 	-del /f $(PERLEXE_ICO) perl.base

@@ -1221,6 +1232,7 @@ distclean: realclean
 	-if exist pod2htmd.tmp del pod2htmd.tmp

 	-if exist pod2htmi.tmp del pod2htmi.tmp

 	-if exist $(HTMLDIR) rmdir /s /q $(HTMLDIR)

+	-del /f ..\t\test_state

 

 install : all installbare installhtml

 

@@ -1305,6 +1317,7 @@ _clean :
 	-@$(DEL) perlmainst$(o)

 	-@$(DEL) config.w32

 	-@$(DEL) config.h

+	-@$(DEL) ..\git_version.h

 	-@$(DEL) $(GLOBEXE)

 	-@$(DEL) $(PERLEXE)

 	-@$(DEL) $(WPERLEXE)

diff --git a/gnu/usr.bin/perl/win32/buildext.pl b/gnu/usr.bin/perl/win32/buildext.pl
deleted file mode 100644
index 65b79beb941..00000000000
--- a/gnu/usr.bin/perl/win32/buildext.pl
+++ /dev/null
@@ -1,107 +0,0 @@
-=head1 NAME
-
-buildext.pl - build extensions
-
-=head1 SYNOPSIS
-
-    buildext.pl make [-make_opts] dep directory [target] !ext1 !ext2
-
-E.g.
-
-    buildext.pl nmake -nologo perldll.def ..\ext
-
-    buildext.pl nmake -nologo perldll.def ..\ext clean
-
-    buildext.pl dmake perldll.def ..\ext
-
-    buildext.pl dmake perldll.def ..\ext clean
-
-Will skip building extensions which are marked with an '!' char.
-Mostly because they still not ported to specified platform.
-
-=cut
-
-use File::Basename;
-use Cwd;
-use FindExt;
-
-# @ARGV with '!' at first position are exclusions
-my %excl = map {$_=>1} map {/^!(.*)$/} @ARGV;
-@ARGV = grep {!/^!/} @ARGV;
-
-my $here = getcwd();
-my $perl = $^X;
-$here =~ s,/,\\,g;
-if ($perl =~ m#^\.\.#)
- {
-  $perl = "$here\\$perl";
- }
-(my $topdir = $perl) =~ s/\\[^\\]+$//;
-# miniperl needs to find perlglob and pl2bat
-$ENV{PATH} = "$topdir;$topdir\\win32\\bin;$ENV{PATH}";
-#print "PATH=$ENV{PATH}\n";
-my $pl2bat = "$topdir\\win32\\bin\\pl2bat";
-unless (-f "$pl2bat.bat") {
-    my @args = ($perl, ("$pl2bat.pl") x 2);
-    print "@args\n";
-    system(@args) unless defined $::Cross::platform;
-}
-my $make = shift;
-$make .= " ".shift while $ARGV[0]=~/^-/;
-my $dep  = shift;
-my $dmod = -M $dep;
-my $dir  = shift;
-chdir($dir) || die "Cannot cd to $dir\n";
-my $targ  = shift;
-(my $ext = getcwd()) =~ s,/,\\,g;
-my $code;
-FindExt::scan_ext($ext);
-
-my @ext = FindExt::extensions();
-
-foreach my $dir (sort @ext)
- {
-  if (exists $excl{$dir}) {
-    warn "Skipping extension $ext\\$dir, not ported to current platform";
-    next;
-  }
-  if (chdir("$ext\\$dir"))
-   {
-    my $mmod = -M 'Makefile';
-    if (!(-f 'Makefile') || $mmod > $dmod)
-     {
-      print "\nRunning Makefile.PL in $dir\n";
-      my @perl = ($perl, "-I$here\\..\\lib", 'Makefile.PL',
-                  'INSTALLDIRS=perl', 'PERL_CORE=1');
-      if (defined $::Cross::platform) {
-	@perl = (@perl[0,1],"-MCross=$::Cross::platform",@perl[2..$#perl]);
-      }
-      print join(' ', @perl), "\n";
-      $code = system(@perl);
-      warn "$code from $dir's Makefile.PL" if $code;
-      $mmod = -M 'Makefile';
-      if ($mmod > $dmod)
-       {
-        warn "Makefile $mmod > $dmod ($dep)\n";
-       }
-     }  
-    if ($targ)
-     {
-      print "Making $targ in $dir\n$make $targ\n";
-      $code = system("$make $targ");
-      die "Unsuccessful make($dir): code=$code" if $code!=0;
-     }
-    else
-     {
-      print "Making $dir\n$make\n";
-      $code = system($make);
-      die "Unsuccessful make($dir): code=$code" if $code!=0;
-     }
-    chdir($here) || die "Cannot cd to $here:$!";
-   }
-  else
-   {
-    warn "Cannot cd to $ext\\$dir:$!";
-   }
- }
-
diff --git a/gnu/usr.bin/perl/win32/config.bc b/gnu/usr.bin/perl/win32/config.bc
index 2c1ffd745bb..ed25fbec03c 100644
--- a/gnu/usr.bin/perl/win32/config.bc
+++ b/gnu/usr.bin/perl/win32/config.bc
@@ -6,7 +6,6 @@ Header=''
 Id='$Id'
 Locker=''
 Log='$Log'
-Mcc='Mcc'
 RCSfile='$RCSfile'
 Revision='$Revision'
 Source=''
@@ -95,9 +94,11 @@ d_accessx='undef'
 d_aintl='undef'
 d_alarm='define'
 d_archlib='define'
+d_asctime64='undef'
 d_asctime_r='undef'
 d_atolf='undef'
 d_atoll='undef'
+d_attribute_deprecated='undef'
 d_attribute_format='undef'
 d_attribute_malloc='undef'
 d_attribute_nonnull='undef'
@@ -132,10 +133,12 @@ d_crypt_r='undef'
 d_csh='undef'
 d_ctermid='undef'
 d_ctermid_r='undef'
+d_ctime64='undef'
 d_ctime_r='undef'
 d_cuserid='undef'
 d_dbl_dig='define'
 d_dbminitproto='undef'
+d_difftime64='undef'
 d_difftime='define'
 d_dir_dd_fd='undef'
 d_dirfd='undef'
@@ -166,14 +169,14 @@ d_faststdio='define'
 d_fchdir='undef'
 d_fchmod='undef'
 d_fchown='undef'
-d_fcntl='undef'
 d_fcntl_can_lock='undef'
+d_fcntl='undef'
 d_fd_macros='define'
 d_fd_set='define'
 d_fds_bits='define'
 d_fgetpos='define'
-d_finite='undef'
 d_finitel='undef'
+d_finite='undef'
 d_flexfnam='define'
 d_flock='define'
 d_flockproto='define'
@@ -194,6 +197,9 @@ d_fsync='undef'
 d_ftello='undef'
 d_ftime='define'
 d_futimes='undef'
+d_gdbm_ndbm_h_uses_prototypes='undef'
+d_gdbmndbm_h_uses_prototypes='undef'
+d_getaddrinfo='undef'
 d_getcwd='define'
 d_getespwnam='undef'
 d_getfsstat='undef'
@@ -215,6 +221,7 @@ d_getlogin='define'
 d_getlogin_r='undef'
 d_getmnt='undef'
 d_getmntent='undef'
+d_getnameinfo='undef'
 d_getnbyaddr='undef'
 d_getnbyname='undef'
 d_getnent='undef'
@@ -250,6 +257,7 @@ d_getservprotos='define'
 d_getspnam='undef'
 d_getspnam_r='undef'
 d_gettimeod='define'
+d_gmtime64='undef'
 d_gmtime_r='undef'
 d_gnulibc='undef'
 d_grpasswd='undef'
@@ -259,6 +267,8 @@ d_ilogbl='undef'
 d_inc_version_list='undef'
 d_index='undef'
 d_inetaton='undef'
+d_inetntop='undef'
+d_inetpton='undef'
 d_int64_t='undef'
 d_isascii='define'
 d_isfinite='undef'
@@ -270,6 +280,7 @@ d_lchown='undef'
 d_ldbl_dig='define'
 d_libm_lib_version='undef'
 d_link='define'
+d_localtime64='undef'
 d_localtime_r='undef'
 d_localtime_r_needs_tzset='undef'
 d_locconv='define'
@@ -294,26 +305,29 @@ d_mkdtemp='undef'
 d_mkfifo='undef'
 d_mkstemp='undef'
 d_mkstemps='undef'
+d_mktime64='undef'
 d_mktime='define'
 d_mmap='undef'
 d_modfl='undef'
 d_modfl_pow32_bug='undef'
 d_modflproto='undef'
 d_mprotect='undef'
-d_msg='undef'
+d_msgctl='undef'
 d_msg_ctrunc='undef'
 d_msg_dontroute='undef'
+d_msgget='undef'
+d_msghdr_s='undef'
 d_msg_oob='undef'
 d_msg_peek='undef'
 d_msg_proxy='undef'
-d_msgctl='undef'
-d_msgget='undef'
-d_msghdr_s='undef'
 d_msgrcv='undef'
 d_msgsnd='undef'
+d_msg='undef'
 d_msync='undef'
 d_munmap='undef'
 d_mymalloc='undef'
+d_ndbm='undef'
+d_ndbm_h_uses_prototypes='undef'
 d_nice='undef'
 d_nl_langinfo='undef'
 d_nv_preserves_uv='define'
@@ -345,7 +359,7 @@ d_pwgecos='undef'
 d_pwpasswd='undef'
 d_pwquota='undef'
 d_qgcvt='undef'
-d_quad='undef'
+d_quad='define'
 d_random_r='undef'
 d_readdir64_r='undef'
 d_readdir='define'
@@ -471,6 +485,7 @@ d_tcsetpgrp='undef'
 d_telldir='define'
 d_telldirproto='define'
 d_time='define'
+d_timegm='undef'
 d_times='define'
 d_tm_tm_gmtoff='undef'
 d_tm_tm_zone='undef'
@@ -518,6 +533,7 @@ dlsrc='dl_win32.xs'
 doublesize='8'
 drand01='(rand()/(double)((unsigned)1<<RANDBITS))'
 drand48_r_proto='0'
+dtrace=''
 dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs'
 eagain='EAGAIN'
 ebcdic='undef'
@@ -534,6 +550,7 @@ eunicefix=':'
 exe_ext='.exe'
 expr='expr'
 extensions='~static_ext~ ~dynamic_ext~ ~nonxs_ext~'
+extern_C='extern'
 extras=''
 fflushNULL='define'
 fflushall='undef'
@@ -599,6 +616,7 @@ i64type='__int64'
 i8size='1'
 i8type='char'
 i_arpainet='define'
+i_assert='define'
 i_bsdioctl=''
 i_crypt='undef'
 i_db='undef'
@@ -611,6 +629,8 @@ i_float='define'
 i_fp='undef'
 i_fp_class='undef'
 i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
 i_grp='undef'
 i_ieeefp='undef'
 i_inttypes='undef'
@@ -620,6 +640,7 @@ i_limits='define'
 i_locale='define'
 i_machcthr='undef'
 i_malloc='define'
+i_mallocmalloc='undef'
 i_math='define'
 i_memory='undef'
 i_mntent='undef'
@@ -654,6 +675,7 @@ i_sysmode='undef'
 i_sysmount='undef'
 i_sysndir='undef'
 i_sysparam='undef'
+i_syspoll='undef'
 i_sysresrc='undef'
 i_syssecrt='undef'
 i_sysselct='undef'
@@ -799,6 +821,7 @@ nroff=''
 nvEUformat='"E"'
 nvFUformat='"F"'
 nvGUformat='"G"'
+nv_overflows_integers_at='256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0'
 nv_preserves_uv_bits='32'
 nveformat='"e"'
 nvfformat='"f"'
@@ -849,9 +872,14 @@ readdir64_r_proto='0'
 readdir_r_proto='0'
 revision='5'
 rm='del'
+rm_try=''
 rmail=''
 run=''
 runnm='true'
+sGMTIME_max="2147483647"
+sGMTIME_min="0"
+sLOCALTIME_max="2147483647"
+sLOCALTIME_min="0"
 sPRIEUldbl='"E"'
 sPRIFUldbl='"F"'
 sPRIGUldbl='"G"'
@@ -977,7 +1005,9 @@ use5005threads='undef'
 use64bitall='undef'
 use64bitint='undef'
 usecrosscompile='undef'
+usedevel='undef'
 usedl='define'
+usedtrace='undef'
 usefaststdio='undef'
 useithreads='undef'
 uselargefiles='undef'
diff --git a/gnu/usr.bin/perl/win32/config.vc b/gnu/usr.bin/perl/win32/config.vc
index d6635ed9756..84dd148a82d 100644
--- a/gnu/usr.bin/perl/win32/config.vc
+++ b/gnu/usr.bin/perl/win32/config.vc
@@ -6,7 +6,6 @@ Header=''
 Id='$Id'
 Locker=''
 Log='$Log'
-Mcc='Mcc'
 RCSfile='$RCSfile'
 Revision='$Revision'
 Source=''
@@ -95,9 +94,11 @@ d_accessx='undef'
 d_aintl='undef'
 d_alarm='define'
 d_archlib='define'
+d_asctime64='undef'
 d_asctime_r='undef'
 d_atolf='undef'
 d_atoll='undef'
+d_attribute_deprecated='undef'
 d_attribute_format='undef'
 d_attribute_malloc='undef'
 d_attribute_nonnull='undef'
@@ -132,10 +133,12 @@ d_crypt_r='undef'
 d_csh='undef'
 d_ctermid='undef'
 d_ctermid_r='undef'
+d_ctime64='undef'
 d_ctime_r='undef'
 d_cuserid='undef'
 d_dbl_dig='define'
 d_dbminitproto='undef'
+d_difftime64='undef'
 d_difftime='define'
 d_dir_dd_fd='undef'
 d_dirfd='undef'
@@ -166,14 +169,14 @@ d_faststdio='define'
 d_fchdir='undef'
 d_fchmod='undef'
 d_fchown='undef'
-d_fcntl='undef'
 d_fcntl_can_lock='undef'
+d_fcntl='undef'
 d_fd_macros='define'
 d_fd_set='define'
 d_fds_bits='define'
 d_fgetpos='define'
-d_finite='undef'
 d_finitel='undef'
+d_finite='undef'
 d_flexfnam='define'
 d_flock='define'
 d_flockproto='define'
@@ -194,6 +197,9 @@ d_fsync='undef'
 d_ftello='undef'
 d_ftime='define'
 d_futimes='undef'
+d_gdbm_ndbm_h_uses_prototypes='undef'
+d_gdbmndbm_h_uses_prototypes='undef'
+d_getaddrinfo='undef'
 d_getcwd='define'
 d_getespwnam='undef'
 d_getfsstat='undef'
@@ -215,6 +221,7 @@ d_getlogin='define'
 d_getlogin_r='undef'
 d_getmnt='undef'
 d_getmntent='undef'
+d_getnameinfo='undef'
 d_getnbyaddr='undef'
 d_getnbyname='undef'
 d_getnent='undef'
@@ -250,6 +257,7 @@ d_getservprotos='define'
 d_getspnam='undef'
 d_getspnam_r='undef'
 d_gettimeod='define'
+d_gmtime64='undef'
 d_gmtime_r='undef'
 d_gnulibc='undef'
 d_grpasswd='undef'
@@ -259,6 +267,8 @@ d_ilogbl='undef'
 d_inc_version_list='undef'
 d_index='undef'
 d_inetaton='undef'
+d_inetntop='undef'
+d_inetpton='undef'
 d_int64_t='undef'
 d_isascii='define'
 d_isfinite='undef'
@@ -270,6 +280,7 @@ d_lchown='undef'
 d_ldbl_dig='define'
 d_libm_lib_version='undef'
 d_link='define'
+d_localtime64='undef'
 d_localtime_r='undef'
 d_localtime_r_needs_tzset='undef'
 d_locconv='define'
@@ -294,26 +305,29 @@ d_mkdtemp='undef'
 d_mkfifo='undef'
 d_mkstemp='undef'
 d_mkstemps='undef'
+d_mktime64='undef'
 d_mktime='define'
 d_mmap='undef'
 d_modfl='undef'
 d_modfl_pow32_bug='undef'
 d_modflproto='undef'
 d_mprotect='undef'
-d_msg='undef'
+d_msgctl='undef'
 d_msg_ctrunc='undef'
 d_msg_dontroute='undef'
+d_msgget='undef'
+d_msghdr_s='undef'
 d_msg_oob='undef'
 d_msg_peek='undef'
 d_msg_proxy='undef'
-d_msgctl='undef'
-d_msgget='undef'
-d_msghdr_s='undef'
 d_msgrcv='undef'
 d_msgsnd='undef'
+d_msg='undef'
 d_msync='undef'
 d_munmap='undef'
 d_mymalloc='undef'
+d_ndbm='undef'
+d_ndbm_h_uses_prototypes='undef'
 d_nice='undef'
 d_nl_langinfo='undef'
 d_nv_preserves_uv='define'
@@ -345,7 +359,7 @@ d_pwgecos='undef'
 d_pwpasswd='undef'
 d_pwquota='undef'
 d_qgcvt='undef'
-d_quad='undef'
+d_quad='define'
 d_random_r='undef'
 d_readdir64_r='undef'
 d_readdir='define'
@@ -471,6 +485,7 @@ d_tcsetpgrp='undef'
 d_telldir='define'
 d_telldirproto='define'
 d_time='define'
+d_timegm='undef'
 d_times='define'
 d_tm_tm_gmtoff='undef'
 d_tm_tm_zone='undef'
@@ -518,6 +533,7 @@ dlsrc='dl_win32.xs'
 doublesize='8'
 drand01='(rand()/(double)((unsigned)1<<RANDBITS))'
 drand48_r_proto='0'
+dtrace=''
 dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs'
 eagain='EAGAIN'
 ebcdic='undef'
@@ -534,6 +550,7 @@ eunicefix=':'
 exe_ext='.exe'
 expr='expr'
 extensions='~static_ext~ ~dynamic_ext~ ~nonxs_ext~'
+extern_C='extern'
 extras=''
 fflushNULL='define'
 fflushall='undef'
@@ -599,6 +616,7 @@ i64type='__int64'
 i8size='1'
 i8type='char'
 i_arpainet='define'
+i_assert='define'
 i_bsdioctl=''
 i_crypt='undef'
 i_db='undef'
@@ -611,6 +629,8 @@ i_float='define'
 i_fp='undef'
 i_fp_class='undef'
 i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
 i_grp='undef'
 i_ieeefp='undef'
 i_inttypes='undef'
@@ -620,6 +640,7 @@ i_limits='define'
 i_locale='define'
 i_machcthr='undef'
 i_malloc='define'
+i_mallocmalloc='undef'
 i_math='define'
 i_memory='undef'
 i_mntent='undef'
@@ -654,6 +675,7 @@ i_sysmode='undef'
 i_sysmount='undef'
 i_sysndir='undef'
 i_sysparam='undef'
+i_syspoll='undef'
 i_sysresrc='undef'
 i_syssecrt='undef'
 i_sysselct='undef'
@@ -748,14 +770,14 @@ lns='copy'
 localtime_r_proto='0'
 locincpth='/usr/local/include /opt/local/include /usr/gnu/include /opt/gnu/include /usr/GNU/include /opt/GNU/include'
 loclibpth='/usr/local/lib /opt/local/lib /usr/gnu/lib /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib'
-longdblsize='10'
+longdblsize='8'
 longlongsize='8'
 longsize='4'
 lp=''
 lpr=''
 ls='dir'
-lseeksize='8'
-lseektype='__int64'
+lseeksize='4'
+lseektype='long'
 mad='undef'
 madlyh=''
 madlyobj=''
@@ -799,6 +821,7 @@ nroff=''
 nvEUformat='"E"'
 nvFUformat='"F"'
 nvGUformat='"G"'
+nv_overflows_integers_at='256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0'
 nv_preserves_uv_bits='32'
 nveformat='"e"'
 nvfformat='"f"'
@@ -849,9 +872,14 @@ readdir64_r_proto='0'
 readdir_r_proto='0'
 revision='5'
 rm='del'
+rm_try=''
 rmail=''
 run=''
 runnm='true'
+sGMTIME_max="2147483647"
+sGMTIME_min="0"
+sLOCALTIME_max="2147483647"
+sLOCALTIME_min="0"
 sPRIEUldbl='"E"'
 sPRIFUldbl='"F"'
 sPRIGUldbl='"G"'
@@ -977,7 +1005,9 @@ use5005threads='undef'
 use64bitall='undef'
 use64bitint='undef'
 usecrosscompile='undef'
+usedevel='undef'
 usedl='define'
+usedtrace='undef'
 usefaststdio='undef'
 useithreads='undef'
 uselargefiles='undef'
diff --git a/gnu/usr.bin/perl/win32/config_H.bc b/gnu/usr.bin/perl/win32/config_H.bc
index c14c5b7c373..a1bfda3854e 100644
--- a/gnu/usr.bin/perl/win32/config_H.bc
+++ b/gnu/usr.bin/perl/win32/config_H.bc
@@ -7,14 +7,14 @@
  * that running config_h.SH again will wipe out any changes you've made.
  * For a more permanent change edit undef and rerun config_h.SH.
  *
- * $Id: Config_h.U,v 3.0.1.5 1997/02/28 14:57:43 ram Exp $
+ * $Id: Config_h.U 1 2006-08-24 12:32:52Z rmanfredi $
  */
 
 /*
  * Package name      : perl5
  * Source directory  : 
- * Configuration time: Mon Mar 17 20:15:35 2003
- * Configured by     : gsar
+ * Configuration time: Fri Dec 12 15:47:15 2008
+ * Configured by     : shay
  * Target system     : 
  */
 
@@ -68,16 +68,11 @@
  */
 #define	HAS_CHSIZE		/**/
 
-/* HASCONST:
- *	This symbol, if defined, indicates that this C compiler knows about
- *	the const type. There is no need to actually test for that symbol
- *	within your programs. The mere use of the "const" keyword will
- *	trigger the necessary tests.
+/* HAS_CRYPT:
+ *	This symbol, if defined, indicates that the crypt routine is available
+ *	to encrypt passwords and the like.
  */
-#define HASCONST	/**/
-#ifndef HASCONST
-#define const
-#endif
+/*#define HAS_CRYPT		/**/
 
 /* HAS_CTERMID:
  *	This symbol, if defined, indicates that the ctermid routine is
@@ -112,6 +107,26 @@
  */
 #define HAS_DLERROR	/**/
 
+/* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ *	This symbol, if defined, indicates that the bug that prevents
+ *	setuid scripts from being secure is not present in this kernel.
+ */
+/* DOSUID:
+ *	This symbol, if defined, indicates that the C program should
+ *	check the script that it is executing for setuid/setgid bits, and
+ *	attempt to emulate setuid/setgid on systems that have disabled
+ *	setuid #! scripts because the kernel can't do it securely.
+ *	It is up to the package designer to make sure that this emulation
+ *	is done securely.  Among other things, it should do an fstat on
+ *	the script it just opened to make sure it really is a setuid/setgid
+ *	script, it should make sure the arguments passed correspond exactly
+ *	to the argument on the #! line, and it should not trust any
+ *	subprocesses to which it must pass the filename rather than the
+ *	file descriptor of the script to be executed.
+ */
+/*#define SETUID_SCRIPTS_ARE_SECURE_NOW	/**/
+/*#define DOSUID		/**/
+
 /* HAS_DUP2:
  *	This symbol, if defined, indicates that the dup2 routine is
  *	available to duplicate file descriptors.
@@ -355,6 +370,13 @@
  */
 #define HAS_PIPE		/**/
 
+/* HAS_POLL:
+ *	This symbol, if defined, indicates that the poll routine is
+ *	available to poll active file descriptors.  Please check I_POLL and
+ *	I_SYS_POLL to know which header should be included as well.
+ */
+/*#define HAS_POLL		/**/
+
 /* HAS_READDIR:
  *	This symbol, if defined, indicates that the readdir routine is
  *	available to read directory entries. You may have to include
@@ -419,6 +441,13 @@
  */
 /*#define HAS_SETEUID		/**/
 
+/* HAS_SETGROUPS:
+ *	This symbol, if defined, indicates that the setgroups() routine is
+ *	available to set the list of process groups.  If unavailable, multiple
+ *	groups are probably not supported.
+ */
+/*#define HAS_SETGROUPS		/**/
+
 /* HAS_SETLINEBUF:
  *	This symbol, if defined, indicates that the setlinebuf routine is
  *	available to change stderr or stdout from block-buffered or unbuffered
@@ -512,13 +541,6 @@
  */
 #define HAS_STRCOLL	/**/
 
-/* USE_STRUCT_COPY:
- *	This symbol, if defined, indicates that this C compiler knows how
- *	to copy structures.  If undefined, you'll need to use a block copy
- *	routine of some sort instead.
- */
-#define	USE_STRUCT_COPY	/**/
-
 /* HAS_STRTOD:
  *	This symbol, if defined, indicates that the strtod routine is
  *	available to provide better numeric string conversion than atof().
@@ -597,15 +619,6 @@
  */
 /*#define HAS_USLEEP		/**/
 
-/* HASVOLATILE:
- *	This symbol, if defined, indicates that this C compiler knows about
- *	the volatile declaration.
- */
-#define	HASVOLATILE	/**/
-#ifndef HASVOLATILE
-#define volatile
-#endif
-
 /* HAS_WAIT4:
  *	This symbol, if defined, indicates that wait4() exists.
  */
@@ -629,6 +642,19 @@
  */
 #define HAS_WCTOMB		/**/
 
+/* Groups_t:
+ *	This symbol holds the type used for the second argument to
+ *	getgroups() and setgroups().  Usually, this is the same as
+ *	gidtype (gid_t) , but sometimes it isn't.
+ *	It can be int, ushort, gid_t, etc... 
+ *	It may be necessary to include <sys/types.h> to get any 
+ *	typedef'ed information.  This is only required if you have
+ *	getgroups() or setgroups()..
+ */
+#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
+#define Groups_t gid_t	/* Type for 2nd arg to [sg]etgroups() */
+#endif
+
 /* I_ARPA_INET:
  *	This symbol, if defined, indicates to the C program that it should
  *	include <arpa/inet.h> to get inet_addr and friends declarations.
@@ -646,26 +672,6 @@
 /*#define I_DBM	/**/
 #define I_RPCSVC_DBM	/**/
 
-/* I_DIRENT:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <dirent.h>. Using this symbol also triggers the definition
- *	of the Direntry_t define which ends up being 'struct dirent' or
- *	'struct direct' depending on the availability of <dirent.h>.
- */
-/* DIRNAMLEN:
- *	This symbol, if defined, indicates to the C program that the length
- *	of directory entry names is provided by a d_namlen field.  Otherwise
- *	you need to do strlen() on the d_name field.
- */
-/* Direntry_t:
- *	This symbol is set to 'struct direct' or 'struct dirent' depending on
- *	whether dirent is available or not. You should use this pseudo type to
- *	portably declare your directory entries.
- */
-#define I_DIRENT		/**/
-#define DIRNAMLEN	/**/
-#define Direntry_t struct direct
-
 /* I_DLFCN:
  *	This symbol, if defined, indicates that <dlfcn.h> exists and should
  *	be included.
@@ -684,6 +690,12 @@
  */
 #define I_FLOAT		/**/
 
+/* I_GDBM:
+ *	This symbol, if defined, indicates that <gdbm.h> exists and should
+ *	be included.
+ */
+/*#define I_GDBM	/**/
+
 /* I_LIMITS:
  *	This symbol, if defined, indicates to the C program that it should
  *	include <limits.h> to get definition of symbols like WORD_BIT or
@@ -709,12 +721,6 @@
  */
 /*#define I_MEMORY		/**/
 
-/* I_NET_ERRNO:
- *	This symbol, if defined, indicates that <net/errno.h> exists and 
- *	should be included.
- */
-/*#define I_NET_ERRNO		/**/
-
 /* I_NETINET_IN:
  *	This symbol, if defined, indicates to the C program that it should
  *	include <netinet/in.h>. Otherwise, you may try <sys/in.h>.
@@ -780,6 +786,13 @@
  */
 /*#define I_SYS_PARAM		/**/
 
+/* I_SYS_POLL:
+ *	This symbol, if defined, indicates that the program may include
+ *	<sys/poll.h>.  When I_POLL is also defined, it's probably safest
+ *	to only include <poll.h>.
+ */
+/*#define I_SYS_POLL	/**/
+
 /* I_SYS_RESOURCE:
  *	This symbol, if defined, indicates to the C program that it should
  *	include <sys/resource.h>.
@@ -868,40 +881,47 @@
  */
 /*#define I_VFORK	/**/
 
-/* HAS_ACCESSX:
- *	This symbol, if defined, indicates that the accessx routine is
- *	available to do extended access checks.
+/* INTSIZE:
+ *	This symbol contains the value of sizeof(int) so that the C
+ *	preprocessor can make decisions based on it.
  */
-/*#define HAS_ACCESSX		/**/
-
-/* HAS_EACCESS:
- *	This symbol, if defined, indicates that the eaccess routine is
- *	available to do extended access checks.
+/* LONGSIZE:
+ *	This symbol contains the value of sizeof(long) so that the C
+ *	preprocessor can make decisions based on it.
  */
-/*#define HAS_EACCESS		/**/
-
-/* I_SYS_ACCESS:
- *     This symbol, if defined, indicates to the C program that it should
- *     include <sys/access.h>.
+/* SHORTSIZE:
+ *	This symbol contains the value of sizeof(short) so that the C
+ *	preprocessor can make decisions based on it.
  */
-/*#define   I_SYS_ACCESS                /**/
+#define INTSIZE 4		/**/
+#define LONGSIZE 4		/**/
+#define SHORTSIZE 2		/**/
 
-/* I_SYS_SECURITY:
- *     This symbol, if defined, indicates to the C program that it should
- *     include <sys/security.h>.
+/* MULTIARCH:
+ *	This symbol, if defined, signifies that the build
+ *	process will produce some binary files that are going to be
+ *	used in a cross-platform environment.  This is the case for
+ *	example with the NeXT "fat" binaries that contain executables
+ *	for several CPUs.
  */
-/*#define   I_SYS_SECURITY	/**/
+/*#define MULTIARCH		/**/
 
-/* USE_CROSS_COMPILE:
- *	This symbol, if defined, indicates that Perl is being cross-compiled.
- */
-/* PERL_TARGETARCH:
- *	This symbol, if defined, indicates the target architecture
- *	Perl has been cross-compiled to.  Undefined if not a cross-compile.
+/* HAS_QUAD:
+ *	This symbol, if defined, tells that there's a 64-bit integer type,
+ *	Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one
+ *	of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, QUAD_IS_INT64_T,
+ *	or QUAD_IS___INT64.
  */
-#ifndef USE_CROSS_COMPILE
-/*#define	USE_CROSS_COMPILE	/**/
-#define	PERL_TARGETARCH	""	/**/
+#define HAS_QUAD	/**/
+#ifdef HAS_QUAD
+#   define Quad_t __int64	/**/
+#   define Uquad_t unsigned __int64	/**/
+#   define QUADKIND 5	/**/
+#   define QUAD_IS_INT	1
+#   define QUAD_IS_LONG	2
+#   define QUAD_IS_LONG_LONG	3
+#   define QUAD_IS_INT64_T	4
+#   define QUAD_IS___INT64	5
 #endif
 
 /* OSNAME:
@@ -915,27 +935,7 @@
  *	feature tests from Configure are generally more reliable.
  */
 #define OSNAME "MSWin32"		/**/
-#define OSVERS "4.0"		/**/
-
-/* MULTIARCH:
- *	This symbol, if defined, signifies that the build
- *	process will produce some binary files that are going to be
- *	used in a cross-platform environment.  This is the case for
- *	example with the NeXT "fat" binaries that contain executables
- *	for several CPUs.
- */
-/*#define MULTIARCH		/**/
-
-/* MEM_ALIGNBYTES:
- *	This symbol contains the number of bytes required to align a
- *	double, or a long double when applicable. Usual values are 2,
- *	4 and 8. The default is eight, for safety.
- */
-#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH)
-#  define MEM_ALIGNBYTES 8
-#else
-#define MEM_ALIGNBYTES 8
-#endif
+#define OSVERS "5.1"		/**/
 
 /* ARCHLIB:
  *	This variable, if defined, holds the name of the directory in
@@ -950,7 +950,7 @@
  *	This symbol contains the ~name expanded version of ARCHLIB, to be used
  *	in programs that are not prepared to deal with ~ expansion at run-time.
  */
-#define ARCHLIB "c:\\perl\\5.10.0\\lib\\MSWin32-x86"		/**/
+#define ARCHLIB "c:\\perl\\lib"		/**/
 /*#define ARCHLIB_EXP ""	/**/
 
 /* ARCHNAME:
@@ -961,18 +961,6 @@
  */
 #define ARCHNAME "MSWin32-x86"		/**/
 
-/* HAS_ATOLF:
- *	This symbol, if defined, indicates that the atolf routine is
- *	available to convert strings into long doubles.
- */
-/*#define HAS_ATOLF		/**/
-
-/* HAS_ATOLL:
- *	This symbol, if defined, indicates that the atoll routine is
- *	available to convert strings into long longs.
- */
-/*#define HAS_ATOLL		/**/
-
 /* BIN:
  *	This symbol holds the path of the bin directory where the package will
  *	be installed. Program must be prepared to deal with ~name substitution.
@@ -985,68 +973,9 @@
  *	This symbol, if defined, indicates that we'd like to relocate entries
  *	in @INC at run time based on the location of the perl binary.
  */
-#define BIN "c:\\perl\\5.10.0\\bin\\MSWin32-x86"	/**/
-#define BIN_EXP "c:\\perl\\5.10.0\\bin\\MSWin32-x86"	/**/
-/*#define PERL_RELOCATABLE_INC "" 		/**/
-
-/* INTSIZE:
- *	This symbol contains the value of sizeof(int) so that the C
- *	preprocessor can make decisions based on it.
- */
-/* LONGSIZE:
- *	This symbol contains the value of sizeof(long) so that the C
- *	preprocessor can make decisions based on it.
- */
-/* SHORTSIZE:
- *	This symbol contains the value of sizeof(short) so that the C
- *	preprocessor can make decisions based on it.
- */
-#define INTSIZE 4		/**/
-#define LONGSIZE 4		/**/
-#define SHORTSIZE 2		/**/
-
-/* BYTEORDER:
- *	This symbol holds the hexadecimal constant defined in byteorder,
- *	in a UV, i.e. 0x1234 or 0x4321 or 0x12345678, etc...
- *	If the compiler supports cross-compiling or multiple-architecture
- *	binaries (eg. on NeXT systems), use compiler-defined macros to
- *	determine the byte order.
- *	On NeXT 3.2 (and greater), you can build "Fat" Multiple Architecture
- *	Binaries (MAB) on either big endian or little endian machines.
- *	The endian-ness is available at compile-time.  This only matters
- *	for perl, where the config.h can be generated and installed on 
- *	one system, and used by a different architecture to build an
- *	extension.  Older versions of NeXT that might not have
- *	defined either *_ENDIAN__ were all on Motorola 680x0 series,
- *	so the default case (for NeXT) is big endian to catch them. 
- *	This might matter for NeXT 3.0.
- */
-#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH)
-#  ifdef __LITTLE_ENDIAN__
-#    if LONGSIZE == 4
-#      define BYTEORDER 0x1234
-#    else
-#      if LONGSIZE == 8
-#        define BYTEORDER 0x12345678
-#      endif
-#    endif
-#  else
-#    ifdef __BIG_ENDIAN__
-#      if LONGSIZE == 4
-#        define BYTEORDER 0x4321
-#      else
-#        if LONGSIZE == 8
-#          define BYTEORDER 0x87654321
-#        endif
-#      endif
-#    endif
-#  endif
-#  if !defined(BYTEORDER) && (defined(NeXT) || defined(__NeXT__))
-#    define BYTEORDER 0x4321
-#  endif
-#else
-#define BYTEORDER 0x1234	/* large digits for MSB */
-#endif /* NeXT */
+#define BIN "c:\\perl\\bin"	/**/
+#define BIN_EXP "c:\\perl\\bin"	/**/
+#define PERL_RELOCATABLE_INC "undef" 		/**/
 
 /* CAT2:
  *	This macro concatenates 2 tokens together.
@@ -1057,19 +986,16 @@
 #if 42 == 1
 #define CAT2(a,b)	a/**/b
 #define STRINGIFY(a)	"a"
-		/* If you can get stringification with catify, tell me how! */
 #endif
 #if 42 == 42
-#define PeRl_CaTiFy(a, b)	a ## b	
+#define PeRl_CaTiFy(a, b)	a ## b
 #define PeRl_StGiFy(a)	#a
-/* the additional level of indirection enables these macros to be
- * used as arguments to other macros.  See K&R 2nd ed., page 231. */
 #define CAT2(a,b)	PeRl_CaTiFy(a,b)
 #define StGiFy(a)	PeRl_StGiFy(a)
 #define STRINGIFY(a)	PeRl_StGiFy(a)
 #endif
 #if 42 != 1 && 42 != 42
-#   include "Bletch: How does this C preprocessor concatenate tokens?"
+#include "Bletch: How does this C preprocessor concatenate tokens?"
 #endif
 
 /* CPPSTDIN:
@@ -1102,12 +1028,6 @@
 #define CPPRUN "cpp32 -oCON"
 #define CPPLAST ""
 
-/* HAS__FWALK:
- *	This symbol, if defined, indicates that the _fwalk system call is
- *	available to apply a function to all the file handles.
- */
-/*#define HAS__FWALK		/**/
-
 /* HAS_ACCESS:
  *	This manifest constant lets the C program know that the access()
  *	system call is available to check for accessibility using real UID/GID.
@@ -1115,11 +1035,11 @@
  */
 #define HAS_ACCESS		/**/
 
-/* HAS_AINTL:
- *	This symbol, if defined, indicates that the aintl routine is
- *	available.  If copysignl is also present we can emulate modfl.
+/* HAS_ACCESSX:
+ *	This symbol, if defined, indicates that the accessx routine is
+ *	available to do extended access checks.
  */
-/*#define HAS_AINTL		/ **/
+/*#define HAS_ACCESSX		/**/
 
 /* HAS_ASCTIME_R:
  *	This symbol, if defined, indicates that the asctime_r routine
@@ -1155,107 +1075,32 @@
 /* HASATTRIBUTE_UNUSED:
  *	Can we handle GCC attribute for unused variables and arguments
  */
+/* HASATTRIBUTE_DEPRECATED:
+ *	Can we handle GCC attribute for marking deprecated APIs
+ */
 /* HASATTRIBUTE_WARN_UNUSED_RESULT:
  *	Can we handle GCC attribute for warning on unused results
  */
+/*#define HASATTRIBUTE_DEPRECATED	/**/
 /*#define HASATTRIBUTE_FORMAT	/**/
 /*#define PRINTF_FORMAT_NULL_OK	/**/
+/*#define HASATTRIBUTE_NORETURN	/**/
 /*#define HASATTRIBUTE_MALLOC	/**/
 /*#define HASATTRIBUTE_NONNULL	/**/
-/*#define HASATTRIBUTE_NORETURN	/**/
 /*#define HASATTRIBUTE_PURE	/**/
 /*#define HASATTRIBUTE_UNUSED	/**/
 /*#define HASATTRIBUTE_WARN_UNUSED_RESULT	/**/
 
-/* HAS_BUILTIN_CHOOSE_EXPR:
- *	Can we handle GCC builtin for compile-time ternary-like expressions
- */
-/* HAS_BUILTIN_EXPECT:
- *	Can we handle GCC builtin for telling that certain values are more
- *	likely
- */
-/*#define HAS_BUILTIN_EXPECT    / **/
-/*#define HAS_BUILTIN_CHOOSE_EXPR /**/
-
-/* HAS_C99_VARIADIC_MACROS:
- *	If defined, the compiler supports C99 variadic macros.
- */
-/*#define HAS_C99_VARIADIC_MACROS	/**/
-
-/* CASTI32:
- *	This symbol is defined if the C compiler can cast negative
- *	or large floating point numbers to 32-bit ints.
- */
-#define	CASTI32		/**/
-
-/* CASTNEGFLOAT:
- *	This symbol is defined if the C compiler can cast negative
- *	numbers to unsigned longs, ints and shorts.
- */
-/* CASTFLAGS:
- *	This symbol contains flags that say what difficulties the compiler
- *	has casting odd floating values to unsigned long:
- *		0 = ok
- *		1 = couldn't cast < 0
- *		2 = couldn't cast >= 0x80000000
- *		4 = couldn't cast in argument expression list
- */
-#define	CASTNEGFLOAT		/**/
-#define CASTFLAGS 0		/**/
-
-/* HAS_CLASS:
- *	This symbol, if defined, indicates that the class routine is
- *	available to classify doubles.  Available for example in AIX.
- *	The returned values are defined in <float.h> and are:
- *
- *	FP_PLUS_NORM	Positive normalized, nonzero
- *	FP_MINUS_NORM	Negative normalized, nonzero
- *	FP_PLUS_DENORM	Positive denormalized, nonzero
- *	FP_MINUS_DENORM	Negative denormalized, nonzero
- *	FP_PLUS_ZERO	+0.0
- *	FP_MINUS_ZERO	-0.0
- *	FP_PLUS_INF	+INF
- *	FP_MINUS_INF	-INF
- *	FP_NANS		Signaling Not a Number (NaNS)
- *	FP_NANQ		Quiet Not a Number (NaNQ)
- */
-/*#define HAS_CLASS		/**/
-
-/* HAS_CLEARENV:
- *	This symbol, if defined, indicates that the clearenv () routine is
- *	available for use.
- */
-/*#define HAS_CLEARENV		/**/
-
-/* VOID_CLOSEDIR:
- *	This symbol, if defined, indicates that the closedir() routine
- *	does not return a value.
- */
-/*#define VOID_CLOSEDIR		/**/
-
-/* HAS_STRUCT_CMSGHDR:
- *	This symbol, if defined, indicates that the struct cmsghdr
- *	is supported.
- */
-/*#define HAS_STRUCT_CMSGHDR	/**/
-
-/* HAS_COPYSIGNL:
- *	This symbol, if defined, indicates that the copysignl routine is
- *	available.  If aintl is also present we can emulate modfl.
- */
-/*#define HAS_COPYSIGNL		/**/
-
-/* USE_CPLUSPLUS:
- *	This symbol, if defined, indicates that a C++ compiler was
- *	used to compiled Perl and will be used to compile extensions.
- */
-/*#define USE_CPLUSPLUS		/**/
-
-/* HAS_CRYPT:
- *	This symbol, if defined, indicates that the crypt routine is available
- *	to encrypt passwords and the like.
+/* HASCONST:
+ *	This symbol, if defined, indicates that this C compiler knows about
+ *	the const type. There is no need to actually test for that symbol
+ *	within your programs. The mere use of the "const" keyword will
+ *	trigger the necessary tests.
  */
-/*#define HAS_CRYPT		/**/
+#define HASCONST	/**/
+#ifndef HASCONST
+#define const
+#endif
 
 /* HAS_CRYPT_R:
  *	This symbol, if defined, indicates that the crypt_r routine
@@ -1307,48 +1152,6 @@
 /*#define HAS_CTIME_R	   /**/
 #define CTIME_R_PROTO 0	   /**/
 
-/* HAS_DBMINIT_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the dbminit() function.  Otherwise, it is up
- *	to the program to supply one.  A good guess is
- *		extern int dbminit(char *);
- */
-/*#define	HAS_DBMINIT_PROTO	/**/
-
-/* HAS_DIRFD:
- *	This manifest constant lets the C program know that dirfd
- *	is available.
- */
-/*#define HAS_DIRFD		/**/
-
-/* DLSYM_NEEDS_UNDERSCORE:
- *	This symbol, if defined, indicates that we need to prepend an
- *	underscore to the symbol name before calling dlsym().  This only
- *	makes sense if you *have* dlsym, which we will presume is the
- *	case if you're using dl_dlopen.xs.
- */
-/*#define 	DLSYM_NEEDS_UNDERSCORE 	/**/
-
-/* SETUID_SCRIPTS_ARE_SECURE_NOW:
- *	This symbol, if defined, indicates that the bug that prevents
- *	setuid scripts from being secure is not present in this kernel.
- */
-/* DOSUID:
- *	This symbol, if defined, indicates that the C program should
- *	check the script that it is executing for setuid/setgid bits, and
- *	attempt to emulate setuid/setgid on systems that have disabled
- *	setuid #! scripts because the kernel can't do it securely.
- *	It is up to the package designer to make sure that this emulation
- *	is done securely.  Among other things, it should do an fstat on
- *	the script it just opened to make sure it really is a setuid/setgid
- *	script, it should make sure the arguments passed correspond exactly
- *	to the argument on the #! line, and it should not trust any
- *	subprocesses to which it must pass the filename rather than the
- *	file descriptor of the script to be executed.
- */
-/*#define SETUID_SCRIPTS_ARE_SECURE_NOW	/**/
-/*#define DOSUID		/**/
-
 /* HAS_DRAND48_R:
  *	This symbol, if defined, indicates that the drand48_r routine
  *	is available to drand48 re-entrantly.
@@ -1370,6 +1173,12 @@
  */
 /*#define	HAS_DRAND48_PROTO	/**/
 
+/* HAS_EACCESS:
+ *	This symbol, if defined, indicates that the eaccess routine is
+ *	available to do extended access checks.
+ */
+/*#define HAS_EACCESS		/**/
+
 /* HAS_ENDGRENT:
  *	This symbol, if defined, indicates that the getgrent routine is
  *	available for finalizing sequential access of the group database.
@@ -1484,210 +1293,12 @@
 /*#define HAS_ENDSERVENT_R	   /**/
 #define ENDSERVENT_R_PROTO 0	   /**/
 
-/* HAS_FAST_STDIO:
- *	This symbol, if defined, indicates that the "fast stdio"
- *	is available to manipulate the stdio buffers directly.
- */
-#define HAS_FAST_STDIO		/**/
-
-/* HAS_FCHDIR:
- *	This symbol, if defined, indicates that the fchdir routine is
- *	available to change directory using a file descriptor.
- */
-/*#define HAS_FCHDIR		/**/
-
-/* FCNTL_CAN_LOCK:
- *	This symbol, if defined, indicates that fcntl() can be used
- *	for file locking.  Normally on Unix systems this is defined.
- *	It may be undefined on VMS.
- */
-/*#define FCNTL_CAN_LOCK		/**/
-
-/* HAS_FD_SET:
- *	This symbol, when defined, indicates presence of the fd_set typedef
- *	in <sys/types.h>
- */
-#define HAS_FD_SET	/**/
-
-/* HAS_FINITE:
- *	This symbol, if defined, indicates that the finite routine is
- *	available to check whether a double is finite (non-infinity non-NaN).
- */
-/*#define HAS_FINITE		/**/
-
-/* HAS_FINITEL:
- *	This symbol, if defined, indicates that the finitel routine is
- *	available to check whether a long double is finite
- *	(non-infinity non-NaN).
- */
-/*#define HAS_FINITEL		/**/
-
 /* FLEXFILENAMES:
  *	This symbol, if defined, indicates that the system supports filenames
  *	longer than 14 characters.
  */
 #define	FLEXFILENAMES		/**/
 
-/* HAS_FLOCK_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the flock() function.  Otherwise, it is up
- *	to the program to supply one.  A good guess is
- *		extern int flock(int, int);
- */
-#define	HAS_FLOCK_PROTO	/**/
-
-/* HAS_FP_CLASS:
- *	This symbol, if defined, indicates that the fp_class routine is
- *	available to classify doubles.  Available for example in Digital UNIX.
- *	The returned values are defined in <math.h> and are:
- *
- *	FP_SNAN           Signaling NaN (Not-a-Number)
- *	FP_QNAN           Quiet NaN (Not-a-Number)
- *	FP_POS_INF        +infinity
- *	FP_NEG_INF        -infinity
- *	FP_POS_NORM       Positive normalized
- *	FP_NEG_NORM       Negative normalized
- *	FP_POS_DENORM     Positive denormalized
- *	FP_NEG_DENORM     Negative denormalized
- *	FP_POS_ZERO       +0.0 (positive zero)
- *	FP_NEG_ZERO       -0.0 (negative zero)
- */
-/*#define HAS_FP_CLASS		/**/
-
-/* HAS_FPCLASS:
- *	This symbol, if defined, indicates that the fpclass routine is
- *	available to classify doubles.  Available for example in Solaris/SVR4.
- *	The returned values are defined in <ieeefp.h> and are:
- *
- *	FP_SNAN		signaling NaN
- *	FP_QNAN		quiet NaN
- *	FP_NINF		negative infinity
- *	FP_PINF		positive infinity
- *	FP_NDENORM	negative denormalized non-zero
- *	FP_PDENORM	positive denormalized non-zero
- *	FP_NZERO	negative zero
- *	FP_PZERO	positive zero
- *	FP_NNORM	negative normalized non-zero
- *	FP_PNORM	positive normalized non-zero
- */
-/*#define HAS_FPCLASS		/**/
-
-/* HAS_FPCLASSIFY:
- *	This symbol, if defined, indicates that the fpclassify routine is
- *	available to classify doubles.  Available for example in HP-UX.
- *	The returned values are defined in <math.h> and are
- *
- *           FP_NORMAL     Normalized
- *           FP_ZERO       Zero
- *           FP_INFINITE   Infinity
- *           FP_SUBNORMAL  Denormalized
- *           FP_NAN        NaN
- *
- */
-/*#define HAS_FPCLASSIFY		/**/
-
-/* HAS_FPCLASSL:
- *	This symbol, if defined, indicates that the fpclassl routine is
- *	available to classify long doubles.  Available for example in IRIX.
- *	The returned values are defined in <ieeefp.h> and are:
- *
- *	FP_SNAN		signaling NaN
- *	FP_QNAN		quiet NaN
- *	FP_NINF		negative infinity
- *	FP_PINF		positive infinity
- *	FP_NDENORM	negative denormalized non-zero
- *	FP_PDENORM	positive denormalized non-zero
- *	FP_NZERO	negative zero
- *	FP_PZERO	positive zero
- *	FP_NNORM	negative normalized non-zero
- *	FP_PNORM	positive normalized non-zero
- */
-/*#define HAS_FPCLASSL		/**/
-
-/* HAS_FPOS64_T:
- *	This symbol will be defined if the C compiler supports fpos64_t.
- */
-/*#define	HAS_FPOS64_T    	/**/
-
-/* HAS_FREXPL:
- *	This symbol, if defined, indicates that the frexpl routine is
- *	available to break a long double floating-point number into
- *	a normalized fraction and an integral power of 2.
- */
-/*#define HAS_FREXPL		/**/
-
-/* HAS_STRUCT_FS_DATA:
- *	This symbol, if defined, indicates that the struct fs_data
- *	to do statfs() is supported.
- */
-/*#define HAS_STRUCT_FS_DATA	/**/
-
-/* HAS_FSEEKO:
- *	This symbol, if defined, indicates that the fseeko routine is
- *	available to fseek beyond 32 bits (useful for ILP32 hosts).
- */
-/*#define HAS_FSEEKO		/**/
-
-/* HAS_FSTATFS:
- *	This symbol, if defined, indicates that the fstatfs routine is
- *	available to stat filesystems by file descriptors.
- */
-/*#define HAS_FSTATFS		/**/
-
-/* HAS_FSYNC:
- *	This symbol, if defined, indicates that the fsync routine is
- *	available to write a file's modified data and attributes to
- *	permanent storage.
- */
-/*#define HAS_FSYNC		/**/
-
-/* HAS_FTELLO:
- *	This symbol, if defined, indicates that the ftello routine is
- *	available to ftell beyond 32 bits (useful for ILP32 hosts).
- */
-/*#define HAS_FTELLO		/**/
-
-/* HAS_FUTIMES:
- *	This symbol, if defined, indicates that the futimes routine is
- *	available to change file descriptor time stamps with struct timevals.
- */
-/*#define HAS_FUTIMES		/**/
-
-/* Gconvert:
- *	This preprocessor macro is defined to convert a floating point
- *	number to a string without a trailing decimal point.  This
- *	emulates the behavior of sprintf("%g"), but is sometimes much more
- *	efficient.  If gconvert() is not available, but gcvt() drops the
- *	trailing decimal point, then gcvt() is used.  If all else fails,
- *	a macro using sprintf("%g") is used. Arguments for the Gconvert
- *	macro are: value, number of digits, whether trailing zeros should
- *	be retained, and the output buffer.
- *	The usual values are:
- *		d_Gconvert='gconvert((x),(n),(t),(b))'
- *		d_Gconvert='gcvt((x),(n),(b))'
- *		d_Gconvert='sprintf((b),"%.*g",(n),(x))'
- *	The last two assume trailing zeros should not be kept.
- */
-#define Gconvert(x,n,t,b) gcvt((x),(n),(b))
-
-/* HAS_GETCWD:
- *	This symbol, if defined, indicates that the getcwd routine is
- *	available to get the current working directory.
- */
-#define HAS_GETCWD		/**/
-
-/* HAS_GETESPWNAM:
- *	This symbol, if defined, indicates that the getespwnam system call is
- *	available to retrieve enchanced (shadow) password entries by name.
- */
-/*#define HAS_GETESPWNAM		/**/
-
-/* HAS_GETFSSTAT:
- *	This symbol, if defined, indicates that the getfsstat routine is
- *	available to stat filesystems in bulk.
- */
-/*#define HAS_GETFSSTAT		/**/
-
 /* HAS_GETGRENT:
  *	This symbol, if defined, indicates that the getgrent routine is
  *	available for sequential access of the group database.
@@ -1827,12 +1438,6 @@
  */
 #define	HAS_GETHOST_PROTOS	/**/
 
-/* HAS_GETITIMER:
- *	This symbol, if defined, indicates that the getitimer routine is
- *	available to return interval timers.
- */
-/*#define HAS_GETITIMER		/**/
-
 /* HAS_GETLOGIN_R:
  *	This symbol, if defined, indicates that the getlogin_r routine
  *	is available to getlogin re-entrantly.
@@ -1846,18 +1451,6 @@
 /*#define HAS_GETLOGIN_R	   /**/
 #define GETLOGIN_R_PROTO 0	   /**/
 
-/* HAS_GETMNT:
- *	This symbol, if defined, indicates that the getmnt routine is
- *	available to get filesystem mount info by filename.
- */
-/*#define HAS_GETMNT		/**/
-
-/* HAS_GETMNTENT:
- *	This symbol, if defined, indicates that the getmntent routine is
- *	available to iterate through mounted file systems to get their info.
- */
-/*#define HAS_GETMNTENT		/**/
-
 /* HAS_GETNETBYADDR:
  *	This symbol, if defined, indicates that the getnetbyaddr() routine is
  *	available to look up networks by their IP addresses.
@@ -1923,13 +1516,6 @@
  */
 /*#define	HAS_GETNET_PROTOS	/**/
 
-/* HAS_GETPAGESIZE:
- *	This symbol, if defined, indicates that the getpagesize system call
- *	is available to get system page size, which is the granularity of
- *	many memory management calls.
- */
-/*#define HAS_GETPAGESIZE		/**/
-
 /* HAS_GETPROTOENT:
  *	This symbol, if defined, indicates that the getprotoent() routine is
  *	available to look up protocols in some data base or another.
@@ -2005,12 +1591,6 @@
  */
 #define	HAS_GETPROTO_PROTOS	/**/
 
-/* HAS_GETPRPWNAM:
- *	This symbol, if defined, indicates that the getprpwnam system call is
- *	available to retrieve protected (shadow) password entries by name.
- */
-/*#define HAS_GETPRPWNAM		/**/
-
 /* HAS_GETPWENT:
  *	This symbol, if defined, indicates that the getpwent routine is
  *	available for sequential access of the passwd database.
@@ -2110,12 +1690,6 @@
  */
 #define	HAS_GETSERV_PROTOS	/**/
 
-/* HAS_GETSPNAM:
- *	This symbol, if defined, indicates that the getspnam system call is
- *	available to retrieve SysV shadow password entries by name.
- */
-/*#define HAS_GETSPNAM		/**/
-
 /* HAS_GETSPNAM_R:
  *	This symbol, if defined, indicates that the getspnam_r routine
  *	is available to getspnam re-entrantly.
@@ -2153,21 +1727,6 @@
 /*#define HAS_GMTIME_R	   /**/
 #define GMTIME_R_PROTO 0	   /**/
 
-/* HAS_GNULIBC:
- *	This symbol, if defined, indicates to the C program that 
- *	the GNU C library is being used.  A better check is to use
- *	the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc.
- */
-/*#define HAS_GNULIBC  	/**/
-#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)
-#   define _GNU_SOURCE
-#endif
-/* HAS_HASMNTOPT:
- *	This symbol, if defined, indicates that the hasmntopt routine is
- *	available to query the mount options of file systems.
- */
-/*#define HAS_HASMNTOPT		/**/
-
 /* HAS_HTONL:
  *	This symbol, if defined, indicates that the htonl() routine (and
  *	friends htons() ntohl() ntohs()) are available to do network
@@ -2193,70 +1752,6 @@
 #define HAS_NTOHL		/**/
 #define HAS_NTOHS		/**/
 
-/* HAS_ILOGBL:
- *	This symbol, if defined, indicates that the ilogbl routine is
- *	available.  If scalbnl is also present we can emulate frexpl.
- */
-/*#define HAS_ILOGBL		/**/
-
-/* HAS_INT64_T:
- *     This symbol will defined if the C compiler supports int64_t.
- *     Usually the <inttypes.h> needs to be included, but sometimes
- *	<sys/types.h> is enough.
- */
-/*#define     HAS_INT64_T               /**/
-
-/* HAS_ISASCII:
- *	This manifest constant lets the C program know that isascii 
- *	is available.
- */
-#define HAS_ISASCII		/**/
-
-/* HAS_ISFINITE:
- *	This symbol, if defined, indicates that the isfinite routine is
- *	available to check whether a double is finite (non-infinity non-NaN).
- */
-/*#define HAS_ISFINITE		/**/
-
-/* HAS_ISINF:
- *	This symbol, if defined, indicates that the isinf routine is
- *	available to check whether a double is an infinity.
- */
-/*#define HAS_ISINF		/**/
-
-/* HAS_ISNAN:
- *	This symbol, if defined, indicates that the isnan routine is
- *	available to check whether a double is a NaN.
- */
-#define HAS_ISNAN		/**/
-
-/* HAS_ISNANL:
- *	This symbol, if defined, indicates that the isnanl routine is
- *	available to check whether a long double is a NaN.
- */
-/*#define HAS_ISNANL		/**/
-
-/* HAS_LCHOWN:
- *	This symbol, if defined, indicates that the lchown routine is
- *	available to operate on a symbolic link (instead of following the
- *	link).
- */
-/*#define HAS_LCHOWN		/**/
-
-/* HAS_LDBL_DIG:
- *	This symbol, if defined, indicates that this system's <float.h>
- *	or <limits.h> defines the symbol LDBL_DIG, which is the number
- *	of significant digits in a long double precision number. Unlike
- *	for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined.
- */
-#define HAS_LDBL_DIG 	/**/
-
-/* LIBM_LIB_VERSION:
- *	This symbol, if defined, indicates that libm exports _LIB_VERSION
- *	and that math.h defines the enum to manipulate it.
- */
-/*#define LIBM_LIB_VERSION         /**/
-
 /* HAS_LOCALTIME_R:
  *	This symbol, if defined, indicates that the localtime_r routine
  *	is available to localtime re-entrantly.
@@ -2264,9 +1759,16 @@
 /* LOCALTIME_R_NEEDS_TZSET:
  *	Many libc's localtime_r implementations do not call tzset,
  *	making them differ from localtime(), and making timezone
- *	changes using $ENV{TZ} without explicitly calling tzset
+ *	changes using \undef{TZ} without explicitly calling tzset
  *	impossible. This symbol makes us call tzset before localtime_r
  */
+/*#define LOCALTIME_R_NEEDS_TZSET /**/
+#ifdef LOCALTIME_R_NEEDS_TZSET
+#define L_R_TZSET tzset(),
+#else
+#define L_R_TZSET
+#endif
+
 /* LOCALTIME_R_PROTO:
  *	This symbol encodes the prototype of localtime_r.
  *	It is zero if d_localtime_r is undef, and one of the
@@ -2274,7 +1776,6 @@
  *	is defined.
  */
 /*#define HAS_LOCALTIME_R	   /**/
-/*#define LOCALTIME_R_NEEDS_TZSET	   /**/
 #define LOCALTIME_R_PROTO 0	   /**/
 
 /* HAS_LONG_DOUBLE:
@@ -2282,7 +1783,7 @@
  *	doubles.
  */
 /* LONG_DOUBLESIZE:
- *	This symbol contains the size of a long double, so that the 
+ *	This symbol contains the size of a long double, so that the
  *	C preprocessor can make decisions based on it.  It is only
  *	defined if the system supports long doubles.
  */
@@ -2295,7 +1796,7 @@
  *	This symbol will be defined if the C compiler supports long long.
  */
 /* LONGLONGSIZE:
- *	This symbol contains the size of a long long, so that the 
+ *	This symbol contains the size of a long long, so that the
  *	C preprocessor can make decisions based on it.  It is only
  *	defined if the system supports long long.
  */
@@ -2312,36 +1813,12 @@
  */
 #define	HAS_LSEEK_PROTO	/**/
 
-/* HAS_MADVISE:
- *	This symbol, if defined, indicates that the madvise system call is
- *	available to map a file into memory.
- */
-/*#define HAS_MADVISE		/**/
-
-/* HAS_MALLOC_SIZE:
- *	This symbol, if defined, indicates that the malloc_size
- *	routine is available for use.
- */
-/*#define HAS_MALLOC_SIZE		/**/
-
-/* HAS_MALLOC_GOOD_SIZE:
- *	This symbol, if defined, indicates that the malloc_good_size
- *	routine is available for use.
- */
-/*#define HAS_MALLOC_GOOD_SIZE	/**/
-
 /* HAS_MEMCHR:
  *	This symbol, if defined, indicates that the memchr routine is available
  *	to locate characters within a C string.
  */
 #define HAS_MEMCHR	/**/
 
-/* HAS_MKDTEMP:
- *	This symbol, if defined, indicates that the mkdtemp routine is
- *	available to exclusively create a uniquely named temporary directory.
- */
-/*#define HAS_MKDTEMP		/**/
-
 /* HAS_MKSTEMP:
  *	This symbol, if defined, indicates that the mkstemp routine is
  *	available to exclusively create and open a uniquely named
@@ -2349,13 +1826,6 @@
  */
 /*#define HAS_MKSTEMP		/**/
 
-/* HAS_MKSTEMPS:
- *	This symbol, if defined, indicates that the mkstemps routine is
- *	available to excluslvely create and open a uniquely named
- *	(with a suffix) temporary file.
- */
-/*#define HAS_MKSTEMPS		/**/
-
 /* HAS_MMAP:
  *	This symbol, if defined, indicates that the mmap system call is
  *	available to map a file into memory.
@@ -2368,77 +1838,12 @@
 /*#define HAS_MMAP		/**/
 #define Mmap_t void *	/**/
 
-/* HAS_MODFL:
- *	This symbol, if defined, indicates that the modfl routine is
- *	available to split a long double x into a fractional part f and
- *	an integer part i such that |f| < 1.0 and (f + i) = x.
- */
-/* HAS_MODFL_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the modfl() function.  Otherwise, it is up
- *	to the program to supply one.
- */
-/* HAS_MODFL_POW32_BUG:
- *	This symbol, if defined, indicates that the modfl routine is
- *	broken for long doubles >= pow(2, 32).
- *	For example from 4294967303.150000 one would get 4294967302.000000
- *	and 1.150000.  The bug has been seen in certain versions of glibc,
- *	release 2.2.2 is known to be okay.
- */
-/*#define HAS_MODFL		/**/
-/*#define HAS_MODFL_PROTO		/**/
-/*#define HAS_MODFL_POW32_BUG		/**/
-
-/* HAS_MPROTECT:
- *	This symbol, if defined, indicates that the mprotect system call is
- *	available to modify the access protection of a memory mapped file.
- */
-/*#define HAS_MPROTECT		/**/
-
 /* HAS_MSG:
  *	This symbol, if defined, indicates that the entire msg*(2) library is
  *	supported (IPC mechanism based on message queues).
  */
 /*#define HAS_MSG		/**/
 
-/* HAS_STRUCT_MSGHDR:
- *	This symbol, if defined, indicates that the struct msghdr
- *	is supported.
- */
-/*#define HAS_STRUCT_MSGHDR	/**/
-
-/* HAS_NL_LANGINFO:
- *	This symbol, if defined, indicates that the nl_langinfo routine is
- *	available to return local data.  You will also need <langinfo.h>
- *	and therefore I_LANGINFO.
- */
-/*#define HAS_NL_LANGINFO		/**/
-
-/* HAS_OFF64_T:
- *	This symbol will be defined if the C compiler supports off64_t.
- */
-/*#define	HAS_OFF64_T    		/**/
-
-/* HAS_OPEN3:
- *	This manifest constant lets the C program know that the three
- *	argument form of open(2) is available.
- */
-/*#define HAS_OPEN3		/**/
-
-/* HAS_PROCSELFEXE:
- *	This symbol is defined if PROCSELFEXE_PATH is a symlink
- *	to the absolute pathname of the executing program.
- */
-/* PROCSELFEXE_PATH:
- *	If HAS_PROCSELFEXE is defined this symbol is the filename
- *	of the symbolic link pointing to the absolute pathname of
- *	the executing program.
- */
-/*#define HAS_PROCSELFEXE	/**/
-#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH)
-#define PROCSELFEXE_PATH		/**/
-#endif
-
 /* OLD_PTHREAD_CREATE_JOINABLE:
  *	This symbol, if defined, indicates how to create pthread
  *	in joinable (aka undetached) state.  NOTE: not defined
@@ -2455,15 +1860,8 @@
  */
 /*#define HAS_PTHREAD_ATFORK		/**/
 
-/* HAS_PTHREAD_ATTR_SETSCOPE:
- *	This symbol, if defined, indicates that the pthread_attr_setscope
- *	system call is available to set the contention scope attribute of
- *	a thread attribute object.
- */
-/*#define HAS_PTHREAD_ATTR_SETSCOPE		/ **/
-
 /* HAS_PTHREAD_YIELD:
- *	This symbol, if defined, indicates that the pthread_yield 
+ *	This symbol, if defined, indicates that the pthread_yield
  *	routine is available to yield the execution of the current
  *	thread.	 sched_yield is preferable to pthread_yield.
  */
@@ -2520,69 +1918,12 @@
 /*#define HAS_READDIR_R	   /**/
 #define READDIR_R_PROTO 0	   /**/
 
-/* HAS_READV:
- *	This symbol, if defined, indicates that the readv routine is
- *	available to do gather reads.  You will also need <sys/uio.h>
- *	and there I_SYSUIO.
- */
-/*#define HAS_READV		/**/
-
-/* HAS_RECVMSG:
- *	This symbol, if defined, indicates that the recvmsg routine is
- *	available to send structured socket messages.
- */
-/*#define HAS_RECVMSG		/**/
-
-/* HAS_SAFE_BCOPY:
- *	This symbol, if defined, indicates that the bcopy routine is available
- *	to copy potentially overlapping memory blocks. Normally, you should
- *	probably use memmove() or memcpy(). If neither is defined, roll your
- *	own version.
- */
-/*#define HAS_SAFE_BCOPY	/**/
-
-/* HAS_SAFE_MEMCPY:
- *	This symbol, if defined, indicates that the memcpy routine is available
- *	to copy potentially overlapping memory blocks.  If you need to
- *	copy overlapping memory blocks, you should check HAS_MEMMOVE and
- *	use memmove() instead, if available.
- */
-/*#define HAS_SAFE_MEMCPY	/**/
-
-/* HAS_SANE_MEMCMP:
- *	This symbol, if defined, indicates that the memcmp routine is available
- *	and can be used to compare relative magnitudes of chars with their high
- *	bits set.  If it is not defined, roll your own version.
- */
-#define HAS_SANE_MEMCMP	/**/
-
-/* HAS_SBRK_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the sbrk() function.  Otherwise, it is up
- *	to the program to supply one.  Good guesses are
- *		extern void* sbrk(int);
- *		extern void* sbrk(size_t);
- */
-/*#define	HAS_SBRK_PROTO	/**/
-
-/* HAS_SCALBNL:
- *	This symbol, if defined, indicates that the scalbnl routine is
- *	available.  If ilogbl is also present we can emulate frexpl.
- */
-/*#define HAS_SCALBNL		/**/
-
 /* HAS_SEM:
  *	This symbol, if defined, indicates that the entire sem*(2) library is
  *	supported.
  */
 /*#define HAS_SEM		/**/
 
-/* HAS_SENDMSG:
- *	This symbol, if defined, indicates that the sendmsg routine is
- *	available to send structured socket messages.
- */
-/*#define HAS_SENDMSG		/**/
-
 /* HAS_SETGRENT:
  *	This symbol, if defined, indicates that the setgrent routine is
  *	available for initializing sequential access of the group database.
@@ -2602,13 +1943,6 @@
 /*#define HAS_SETGRENT_R	   /**/
 #define SETGRENT_R_PROTO 0	   /**/
 
-/* HAS_SETGROUPS:
- *	This symbol, if defined, indicates that the setgroups() routine is
- *	available to set the list of process groups.  If unavailable, multiple
- *	groups are probably not supported.
- */
-/*#define HAS_SETGROUPS		/**/
-
 /* HAS_SETHOSTENT:
  *	This symbol, if defined, indicates that the sethostent() routine is
  *	available.
@@ -2628,12 +1962,6 @@
 /*#define HAS_SETHOSTENT_R	   /**/
 #define SETHOSTENT_R_PROTO 0	   /**/
 
-/* HAS_SETITIMER:
- *	This symbol, if defined, indicates that the setitimer routine is
- *	available to set interval timers.
- */
-/*#define HAS_SETITIMER		/**/
-
 /* HAS_SETLOCALE_R:
  *	This symbol, if defined, indicates that the setlocale_r routine
  *	is available to setlocale re-entrantly.
@@ -2684,12 +2012,6 @@
 /*#define HAS_SETPGRP		/**/
 /*#define USE_BSD_SETPGRP	/**/
 
-/* HAS_SETPROCTITLE:
- *	This symbol, if defined, indicates that the setproctitle routine is
- *	available to set process title.
- */
-/*#define HAS_SETPROCTITLE		/**/
-
 /* HAS_SETPROTOENT_R:
  *	This symbol, if defined, indicates that the setprotoent_r routine
  *	is available to setprotoent re-entrantly.
@@ -2748,12 +2070,6 @@
  */
 #define HAS_SETVBUF		/**/
 
-/* USE_SFIO:
- *	This symbol, if defined, indicates that sfio should
- *	be used.
- */
-/*#define	USE_SFIO		/**/
-
 /* HAS_SHM:
  *	This symbol, if defined, indicates that the entire shm*(2) library is
  *	supported.
@@ -2774,81 +2090,6 @@
 #define Shmat_t void *	/**/
 /*#define HAS_SHMAT_PROTOTYPE	/**/
 
-/* HAS_SIGACTION:
- *	This symbol, if defined, indicates that Vr4's sigaction() routine
- *	is available.
- */
-/*#define HAS_SIGACTION	/**/
-
-/* HAS_SIGPROCMASK:
- *	This symbol, if defined, indicates that the sigprocmask
- *	system call is available to examine or change the signal mask
- *	of the calling process.
- */
-/*#define HAS_SIGPROCMASK		/**/
-
-/* HAS_SIGSETJMP:
- *	This variable indicates to the C program that the sigsetjmp()
- *	routine is available to save the calling process's registers
- *	and stack environment for later use by siglongjmp(), and
- *	to optionally save the process's signal mask.  See
- *	Sigjmp_buf, Sigsetjmp, and Siglongjmp.
- */
-/* Sigjmp_buf:
- *	This is the buffer type to be used with Sigsetjmp and Siglongjmp.
- */
-/* Sigsetjmp:
- *	This macro is used in the same way as sigsetjmp(), but will invoke
- *	traditional setjmp() if sigsetjmp isn't available.
- *	See HAS_SIGSETJMP.
- */
-/* Siglongjmp:
- *	This macro is used in the same way as siglongjmp(), but will invoke
- *	traditional longjmp() if siglongjmp isn't available.
- *	See HAS_SIGSETJMP.
- */
-/*#define HAS_SIGSETJMP	/**/
-#ifdef HAS_SIGSETJMP
-#define Sigjmp_buf sigjmp_buf
-#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask))
-#define Siglongjmp(buf,retval) siglongjmp((buf),(retval))
-#else
-#define Sigjmp_buf jmp_buf
-#define Sigsetjmp(buf,save_mask) setjmp((buf))
-#define Siglongjmp(buf,retval) longjmp((buf),(retval))
-#endif
-
-/* USE_SITECUSTOMIZE:
- *	This symbol, if defined, indicates that sitecustomize should
- *	be used.
- */
-/*#define	USE_SITECUSTOMIZE		/**/
-
-/* HAS_SNPRINTF:
- *	This symbol, if defined, indicates that the snprintf () library
- *	function is available for use.
- */
-/* HAS_VSNPRINTF:
- *	This symbol, if defined, indicates that the vsnprintf () library
- *	function is available for use.
- */
-#define HAS_SNPRINTF	/**/
-#define HAS_VSNPRINTF	/**/
-
-/* HAS_SOCKATMARK:
- *	This symbol, if defined, indicates that the sockatmark routine is
- *	available to test whether a socket is at the out-of-band mark.
- */
-/*#define HAS_SOCKATMARK		/**/
-
-/* HAS_SOCKATMARK_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the sockatmark() function.  Otherwise, it is up
- *	to the program to supply one.  A good guess is
- *		extern int sockatmark(int);
- */
-/*#define	HAS_SOCKATMARK_PROTO	/**/
-
 /* HAS_SOCKET:
  *	This symbol, if defined, indicates that the BSD socket interface is
  *	supported.
@@ -2896,26 +2137,6 @@
 /*#define	HAS_MSG_PROXY	/**/
 /*#define	HAS_SCM_RIGHTS	/**/
 
-/* HAS_SOCKS5_INIT:
- *	This symbol, if defined, indicates that the socks5_init routine is
- *	available to initialize SOCKS 5.
- */
-/*#define HAS_SOCKS5_INIT		/**/
-
-/* SPRINTF_RETURNS_STRLEN:
- *	This variable defines whether sprintf returns the length of the string
- *	(as per the ANSI spec). Some C libraries retain compatibility with
- *	pre-ANSI C and return a pointer to the passed in buffer; for these
- *	this variable will be undef.
- */
-#define SPRINTF_RETURNS_STRLEN       /**/
-
-/* HAS_SQRTL:
- *	This symbol, if defined, indicates that the sqrtl routine is
- *	available to do long double square roots.
- */
-/*#define HAS_SQRTL		/**/
-
 /* HAS_SRAND48_R:
  *	This symbol, if defined, indicates that the srand48_r routine
  *	is available to srand48 re-entrantly.
@@ -2942,22 +2163,6 @@
 /*#define HAS_SRANDOM_R	   /**/
 #define SRANDOM_R_PROTO 0	   /**/
 
-/* HAS_SETRESGID_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the setresgid() function.  Otherwise, it is up
- *	to the program to supply one.  Good guesses are
- *		extern int setresgid(uid_t ruid, uid_t euid, uid_t suid);
- */
-/*#define	HAS_SETRESGID_PROTO	/**/
-
-/* HAS_SETRESUID_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the setresuid() function.  Otherwise, it is up
- *	to the program to supply one.  Good guesses are
- *		extern int setresuid(uid_t ruid, uid_t euid, uid_t suid);
- */
-/*#define	HAS_SETRESUID_PROTO	/**/
-
 /* USE_STAT_BLOCKS:
  *	This symbol is defined if this system has a stat structure declaring
  *	st_blksize and st_blocks.
@@ -2966,28 +2171,912 @@
 /*#define USE_STAT_BLOCKS 	/**/
 #endif
 
-/* HAS_STRUCT_STATFS_F_FLAGS:
- *	This symbol, if defined, indicates that the struct statfs
- *	does have the f_flags member containing the mount flags of
- *	the filesystem containing the file.
- *	This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3),
- *	not from <sys/statfs.h> (SYSV).  Older BSDs (like Ultrix) do not
- *	have statfs() and struct statfs, they have ustat() and getmnt()
- *	with struct ustat and struct fs_data.
+/* USE_STRUCT_COPY:
+ *	This symbol, if defined, indicates that this C compiler knows how
+ *	to copy structures.  If undefined, you'll need to use a block copy
+ *	routine of some sort instead.
  */
-/*#define HAS_STRUCT_STATFS_F_FLAGS		/**/
+#define	USE_STRUCT_COPY	/**/
 
-/* HAS_STRUCT_STATFS:
- *	This symbol, if defined, indicates that the struct statfs
- *	to do statfs() is supported.
+/* HAS_STRERROR:
+ *	This symbol, if defined, indicates that the strerror routine is
+ *	available to translate error numbers to strings. See the writeup
+ *	of Strerror() in this file before you try to define your own.
  */
-/*#define HAS_STRUCT_STATFS	/**/
+/* HAS_SYS_ERRLIST:
+ *	This symbol, if defined, indicates that the sys_errlist array is
+ *	available to translate error numbers to strings. The extern int
+ *	sys_nerr gives the size of that table.
+ */
+/* Strerror:
+ *	This preprocessor symbol is defined as a macro if strerror() is
+ *	not available to translate error numbers to strings but sys_errlist[]
+ *	array is there.
+ */
+#define HAS_STRERROR		/**/
+#define HAS_SYS_ERRLIST	/**/
+#define Strerror(e) strerror(e)
 
-/* HAS_FSTATVFS:
- *	This symbol, if defined, indicates that the fstatvfs routine is
- *	available to stat filesystems by file descriptors.
+/* HAS_STRERROR_R:
+ *	This symbol, if defined, indicates that the strerror_r routine
+ *	is available to strerror re-entrantly.
  */
-/*#define HAS_FSTATVFS		/**/
+/* STRERROR_R_PROTO:
+ *	This symbol encodes the prototype of strerror_r.
+ *	It is zero if d_strerror_r is undef, and one of the
+ *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r
+ *	is defined.
+ */
+/*#define HAS_STRERROR_R	   /**/
+#define STRERROR_R_PROTO 0	   /**/
+
+/* HAS_STRTOUL:
+ *	This symbol, if defined, indicates that the strtoul routine is
+ *	available to provide conversion of strings to unsigned long.
+ */
+#define HAS_STRTOUL	/**/
+
+/* HAS_TIME:
+ *	This symbol, if defined, indicates that the time() routine exists.
+ */
+/* Time_t:
+ *	This symbol holds the type returned by time(). It can be long,
+ *	or time_t on BSD sites (in which case <sys/types.h> should be
+ *	included).
+ */
+#define HAS_TIME		/**/
+#define Time_t time_t		/* Time type */
+
+/* HAS_TIMES:
+ *	This symbol, if defined, indicates that the times() routine exists.
+ *	Note that this became obsolete on some systems (SUNOS), which now
+ * use getrusage(). It may be necessary to include <sys/times.h>.
+ */
+#define HAS_TIMES		/**/
+
+/* HAS_TMPNAM_R:
+ *	This symbol, if defined, indicates that the tmpnam_r routine
+ *	is available to tmpnam re-entrantly.
+ */
+/* TMPNAM_R_PROTO:
+ *	This symbol encodes the prototype of tmpnam_r.
+ *	It is zero if d_tmpnam_r is undef, and one of the
+ *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r
+ *	is defined.
+ */
+/*#define HAS_TMPNAM_R	   /**/
+#define TMPNAM_R_PROTO 0	   /**/
+
+/* HAS_TTYNAME_R:
+ *	This symbol, if defined, indicates that the ttyname_r routine
+ *	is available to ttyname re-entrantly.
+ */
+/* TTYNAME_R_PROTO:
+ *	This symbol encodes the prototype of ttyname_r.
+ *	It is zero if d_ttyname_r is undef, and one of the
+ *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
+ *	is defined.
+ */
+/*#define HAS_TTYNAME_R	   /**/
+#define TTYNAME_R_PROTO 0	   /**/
+
+/* HAS_UNION_SEMUN:
+ *	This symbol, if defined, indicates that the union semun is
+ *	defined by including <sys/sem.h>.  If not, the user code
+ *	probably needs to define it as:
+ *	union semun {
+ *	    int val;
+ *	    struct semid_ds *buf;
+ *	    unsigned short *array;
+ *	}
+ */
+/* USE_SEMCTL_SEMUN:
+ *	This symbol, if defined, indicates that union semun is
+ *	used for semctl IPC_STAT.
+ */
+/* USE_SEMCTL_SEMID_DS:
+ *	This symbol, if defined, indicates that struct semid_ds * is
+ *	used for semctl IPC_STAT.
+ */
+#define HAS_UNION_SEMUN	/**/
+/*#define USE_SEMCTL_SEMUN	/**/
+/*#define USE_SEMCTL_SEMID_DS	/**/
+
+/* HAS_VFORK:
+ *	This symbol, if defined, indicates that vfork() exists.
+ */
+/*#define HAS_VFORK	/**/
+
+/* HAS_PSEUDOFORK:
+ *	This symbol, if defined, indicates that an emulation of the
+ *	fork routine is available.
+ */
+/*#define HAS_PSEUDOFORK	/**/
+
+/* Signal_t:
+ *	This symbol's value is either "void" or "int", corresponding to the
+ *	appropriate return type of a signal handler.  Thus, you can declare
+ *	a signal handler using "Signal_t (*handler)()", and define the
+ *	handler using "Signal_t handler(sig)".
+ */
+#define Signal_t void	/* Signal handler's return type */
+
+/* HASVOLATILE:
+ *	This symbol, if defined, indicates that this C compiler knows about
+ *	the volatile declaration.
+ */
+#define	HASVOLATILE	/**/
+#ifndef HASVOLATILE
+#define volatile
+#endif
+
+/* Fpos_t:
+ *	This symbol holds the type used to declare file positions in libc.
+ *	It can be fpos_t, long, uint, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Fpos_t fpos_t		/* File position type */
+
+/* Gid_t_f:
+ *	This symbol defines the format string used for printing a Gid_t.
+ */
+#define	Gid_t_f		"d"		/**/
+
+/* Gid_t_sign:
+ *	This symbol holds the signedess of a Gid_t.
+ *	1 for unsigned, -1 for signed.
+ */
+#define Gid_t_sign	-1		/* GID sign */
+
+/* Gid_t_size:
+ *	This symbol holds the size of a Gid_t in bytes.
+ */
+#define Gid_t_size 4		/* GID size */
+
+/* Gid_t:
+ *	This symbol holds the return type of getgid() and the type of
+ *	argument to setrgid() and related functions.  Typically,
+ *	it is the type of group ids in the kernel. It can be int, ushort,
+ *	gid_t, etc... It may be necessary to include <sys/types.h> to get
+ *	any typedef'ed information.
+ */
+#define Gid_t gid_t		/* Type for getgid(), etc... */
+
+/* I_DIRENT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <dirent.h>. Using this symbol also triggers the definition
+ *	of the Direntry_t define which ends up being 'struct dirent' or
+ *	'struct direct' depending on the availability of <dirent.h>.
+ */
+/* DIRNAMLEN:
+ *	This symbol, if defined, indicates to the C program that the length
+ *	of directory entry names is provided by a d_namlen field.  Otherwise
+ *	you need to do strlen() on the d_name field.
+ */
+/* Direntry_t:
+ *	This symbol is set to 'struct direct' or 'struct dirent' depending on
+ *	whether dirent is available or not. You should use this pseudo type to
+ *	portably declare your directory entries.
+ */
+#define I_DIRENT		/**/
+#define DIRNAMLEN	/**/
+#define Direntry_t struct direct
+
+/* I_GRP:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <grp.h>.
+ */
+/* GRPASSWD:
+ *	This symbol, if defined, indicates to the C program that struct group
+ *	in <grp.h> contains gr_passwd.
+ */
+/*#define I_GRP		/**/
+/*#define GRPASSWD	/**/
+
+/* I_MACH_CTHREADS:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <mach/cthreads.h>.
+ */
+/*#define   I_MACH_CTHREADS	/**/
+
+/* I_NDBM:
+ *	This symbol, if defined, indicates that <ndbm.h> exists and should
+ *	be included.
+ */
+/* I_GDBMNDBM:
+ *	This symbol, if defined, indicates that <gdbm/ndbm.h> exists and should
+ *	be included.  This was the location of the ndbm.h compatibility file
+ *	in RedHat 7.1.
+ */
+/* I_GDBM_NDBM:
+ *	This symbol, if defined, indicates that <gdbm-ndbm.h> exists and should
+ *	be included.  This is the location of the ndbm.h compatibility file
+ *	in Debian 4.0.
+ */
+/* NDBM_H_USES_PROTOTYPES:
+ *	This symbol, if defined, indicates that <ndbm.h> uses real ANSI C
+ *	prototypes instead of K&R style function declarations without any
+ *	parameter information. While ANSI C prototypes are supported in C++,
+ *	K&R style function declarations will yield errors.
+ */
+/* GDBMNDBM_H_USES_PROTOTYPES:
+ *	This symbol, if defined, indicates that <gdbm/ndbm.h> uses real ANSI C
+ *	prototypes instead of K&R style function declarations without any
+ *	parameter information. While ANSI C prototypes are supported in C++,
+ *	K&R style function declarations will yield errors.
+ */
+/* GDBM_NDBM_H_USES_PROTOTYPES:
+ *	This symbol, if defined, indicates that <gdbm-ndbm.h> uses real ANSI C
+ *	prototypes instead of K&R style function declarations without any
+ *	parameter information. While ANSI C prototypes are supported in C++,
+ *	K&R style function declarations will yield errors.
+ */
+/*#define I_NDBM	/**/
+/*#define I_GDBMNDBM	/**/
+/*#define I_GDBM_NDBM	/**/
+/*#define NDBM_H_USES_PROTOTYPES	/**/
+/*#define GDBMNDBM_H_USES_PROTOTYPES	/**/
+/*#define GDBM_NDBM_H_USES_PROTOTYPES	/**/
+
+/* I_NETDB:
+ *	This symbol, if defined, indicates that <netdb.h> exists and
+ *	should be included.
+ */
+/*#define I_NETDB		/**/
+
+/* I_NET_ERRNO:
+ *	This symbol, if defined, indicates that <net/errno.h> exists and
+ *	should be included.
+ */
+/*#define I_NET_ERRNO		/**/
+
+/* I_PTHREAD:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <pthread.h>.
+ */
+/*#define   I_PTHREAD	/**/
+
+/* I_PWD:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <pwd.h>.
+ */
+/* PWQUOTA:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_quota.
+ */
+/* PWAGE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_age.
+ */
+/* PWCHANGE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_change.
+ */
+/* PWCLASS:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_class.
+ */
+/* PWEXPIRE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_expire.
+ */
+/* PWCOMMENT:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_comment.
+ */
+/* PWGECOS:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_gecos.
+ */
+/* PWPASSWD:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_passwd.
+ */
+/*#define I_PWD		/**/
+/*#define PWQUOTA	/**/
+/*#define PWAGE	/**/
+/*#define PWCHANGE	/**/
+/*#define PWCLASS	/**/
+/*#define PWEXPIRE	/**/
+/*#define PWCOMMENT	/**/
+/*#define PWGECOS	/**/
+/*#define PWPASSWD	/**/
+
+/* I_SYS_ACCESS:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <sys/access.h>.
+ */
+/*#define   I_SYS_ACCESS                /**/
+
+/* I_SYS_SECURITY:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <sys/security.h>.
+ */
+/*#define   I_SYS_SECURITY	/**/
+
+/* I_SYSUIO:
+ *	This symbol, if defined, indicates that <sys/uio.h> exists and
+ *	should be included.
+ */
+/*#define	I_SYSUIO		/**/
+
+/* I_STDARG:
+ *	This symbol, if defined, indicates that <stdarg.h> exists and should
+ *	be included.
+ */
+/* I_VARARGS:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <varargs.h>.
+ */
+#define I_STDARG		/**/
+/*#define I_VARARGS	/**/
+
+/* PERL_INC_VERSION_LIST:
+ *	This variable specifies the list of subdirectories in over
+ *	which perl.c:incpush() and lib/lib.pm will automatically
+ *	search when adding directories to @INC, in a format suitable
+ *	for a C initialization string.  See the inc_version_list entry
+ *	in Porting/Glossary for more details.
+ */
+/*#define PERL_INC_VERSION_LIST 0		/**/
+
+/* INSTALL_USR_BIN_PERL:
+ *	This symbol, if defined, indicates that Perl is to be installed
+ * 	also as /usr/bin/perl.
+ */
+/*#define INSTALL_USR_BIN_PERL	/**/
+
+/* Off_t:
+ *	This symbol holds the type used to declare offsets in the kernel.
+ *	It can be int, long, off_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+/* LSEEKSIZE:
+ *	This symbol holds the number of bytes used by the Off_t.
+ */
+/* Off_t_size:
+ *	This symbol holds the number of bytes used by the Off_t.
+ */
+#define Off_t long		/* <offset> type */
+#define LSEEKSIZE 4		/* <offset> size */
+#define Off_t_size 4	/* <offset> size */
+
+/* Free_t:
+ *	This variable contains the return type of free().  It is usually
+ * void, but occasionally int.
+ */
+/* Malloc_t:
+ *	This symbol is the type of pointer returned by malloc and realloc.
+ */
+#define Malloc_t void *			/**/
+#define Free_t void			/**/
+
+/* PERL_MALLOC_WRAP:
+ *	This symbol, if defined, indicates that we'd like malloc wrap checks.
+ */
+#define PERL_MALLOC_WRAP		/**/
+
+/* MYMALLOC:
+ *	This symbol, if defined, indicates that we're using our own malloc.
+ */
+/*#define MYMALLOC			/**/
+
+/* Mode_t:
+ *	This symbol holds the type used to declare file modes
+ *	for systems calls.  It is usually mode_t, but may be
+ *	int or unsigned short.  It may be necessary to include <sys/types.h>
+ *	to get any typedef'ed information.
+ */
+#define Mode_t mode_t	 /* file mode parameter for system calls */
+
+/* Netdb_host_t:
+ *	This symbol holds the type used for the 1st argument
+ *	to gethostbyaddr().
+ */
+/* Netdb_hlen_t:
+ *	This symbol holds the type used for the 2nd argument
+ *	to gethostbyaddr().
+ */
+/* Netdb_name_t:
+ *	This symbol holds the type used for the argument to
+ *	gethostbyname().
+ */
+/* Netdb_net_t:
+ *	This symbol holds the type used for the 1st argument to
+ *	getnetbyaddr().
+ */
+#define Netdb_host_t		char * /**/
+#define Netdb_hlen_t		int /**/
+#define Netdb_name_t		char * /**/
+#define Netdb_net_t		long /**/
+
+/* PERL_OTHERLIBDIRS:
+ *	This variable contains a colon-separated set of paths for the perl
+ *	binary to search for additional library files or modules.
+ *	These directories will be tacked to the end of @INC.
+ *	Perl will automatically search below each path for version-
+ *	and architecture-specific directories.  See PERL_INC_VERSION_LIST
+ *	for more details.
+ */
+/*#define PERL_OTHERLIBDIRS ""		/**/
+
+/* Pid_t:
+ *	This symbol holds the type used to declare process ids in the kernel.
+ *	It can be int, uint, pid_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Pid_t int		/* PID type */
+
+/* PRIVLIB:
+ *	This symbol contains the name of the private library for this package.
+ *	The library is private in the sense that it needn't be in anyone's
+ *	execution path, but it should be accessible by the world.  The program
+ *	should be prepared to do ~ expansion.
+ */
+/* PRIVLIB_EXP:
+ *	This symbol contains the ~name expanded version of PRIVLIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define PRIVLIB "c:\\perl\\lib"		/**/
+#define PRIVLIB_EXP (win32_get_privlib("5.11.0"))	/**/
+
+/* CAN_PROTOTYPE:
+ *	If defined, this macro indicates that the C compiler can handle
+ *	function prototypes.
+ */
+/* _:
+ *	This macro is used to declare function parameters for folks who want
+ *	to make declarations with prototypes using a different style than
+ *	the above macros.  Use double parentheses.  For example:
+ *
+ *		int main _((int argc, char *argv[]));
+ */
+#define	CAN_PROTOTYPE	/**/
+#ifdef CAN_PROTOTYPE
+#define	_(args) args
+#else
+#define	_(args) ()
+#endif
+
+/* Select_fd_set_t:
+ *	This symbol holds the type used for the 2nd, 3rd, and 4th
+ *	arguments to select.  Usually, this is 'fd_set *', if HAS_FD_SET
+ *	is defined, and 'int *' otherwise.  This is only useful if you
+ *	have select(), of course.
+ */
+#define Select_fd_set_t 	Perl_fd_set *	/**/
+
+/* SH_PATH:
+ *	This symbol contains the full pathname to the shell used on this
+ *	on this system to execute Bourne shell scripts.  Usually, this will be
+ *	/bin/sh, though it's possible that some systems will have /bin/ksh,
+ *	/bin/pdksh, /bin/ash, /bin/bash, or even something such as
+ *	D:/bin/sh.exe.
+ */
+#define SH_PATH "cmd /x /c"  /**/
+
+/* SIG_NAME:
+ *	This symbol contains a list of signal names in order of
+ *	signal number. This is intended
+ *	to be used as a static array initialization, like this:
+ *		char *sig_name[] = { SIG_NAME };
+ *	The signals in the list are separated with commas, and each signal
+ *	is surrounded by double quotes. There is no leading SIG in the signal
+ *	name, i.e. SIGQUIT is known as "QUIT".
+ *	Gaps in the signal numbers (up to NSIG) are filled in with NUMnn,
+ *	etc., where nn is the actual signal number (e.g. NUM37).
+ *	The signal number for sig_name[i] is stored in sig_num[i].
+ *	The last element is 0 to terminate the list with a NULL.  This
+ *	corresponds to the 0 at the end of the sig_name_init list.
+ *	Note that this variable is initialized from the sig_name_init,
+ *	not from sig_name (which is unused).
+ */
+/* SIG_NUM:
+ *	This symbol contains a list of signal numbers, in the same order as the
+ *	SIG_NAME list. It is suitable for static array initialization, as in:
+ *		int sig_num[] = { SIG_NUM };
+ *	The signals in the list are separated with commas, and the indices
+ *	within that list and the SIG_NAME list match, so it's easy to compute
+ *	the signal name from a number or vice versa at the price of a small
+ *	dynamic linear lookup.
+ *	Duplicates are allowed, but are moved to the end of the list.
+ *	The signal number corresponding to sig_name[i] is sig_number[i].
+ *	if (i < NSIG) then sig_number[i] == i.
+ *	The last element is 0, corresponding to the 0 at the end of
+ *	the sig_name_init list.
+ *	Note that this variable is initialized from the sig_num_init,
+ *	not from sig_num (which is unused).
+ */
+/* SIG_SIZE:
+ *	This variable contains the number of elements of the SIG_NAME
+ *	and SIG_NUM arrays, excluding the final NULL entry.
+ */
+#define SIG_NAME "ZERO", "HUP", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "USR1", "USR2", "CHLD", "NUM19", "USR3", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0		/**/
+#define SIG_NUM  0, 1, 2, 21, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 18, 0		/**/
+#define SIG_SIZE 27			/**/
+
+/* SITEARCH:
+ *	This symbol contains the name of the private library for this package.
+ *	The library is private in the sense that it needn't be in anyone's
+ *	execution path, but it should be accessible by the world.  The program
+ *	should be prepared to do ~ expansion.
+ *	The standard distribution will put nothing in this directory.
+ *	After perl has been installed, users may install their own local
+ *	architecture-dependent modules in this directory with
+ *		MakeMaker Makefile.PL
+ *	or equivalent.  See INSTALL for details.
+ */
+/* SITEARCH_EXP:
+ *	This symbol contains the ~name expanded version of SITEARCH, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define SITEARCH "c:\\perl\\site\\lib"		/**/
+/*#define SITEARCH_EXP ""	/**/
+
+/* SITELIB:
+ *	This symbol contains the name of the private library for this package.
+ *	The library is private in the sense that it needn't be in anyone's
+ *	execution path, but it should be accessible by the world.  The program
+ *	should be prepared to do ~ expansion.
+ *	The standard distribution will put nothing in this directory.
+ *	After perl has been installed, users may install their own local
+ *	architecture-independent modules in this directory with
+ *		MakeMaker Makefile.PL
+ *	or equivalent.  See INSTALL for details.
+ */
+/* SITELIB_EXP:
+ *	This symbol contains the ~name expanded version of SITELIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+/* SITELIB_STEM:
+ *	This define is SITELIB_EXP with any trailing version-specific component
+ *	removed.  The elements in inc_version_list (inc_version_list.U) can
+ *	be tacked onto this variable to generate a list of directories to search.
+ */
+#define SITELIB "c:\\perl\\site\\lib"		/**/
+#define SITELIB_EXP (win32_get_sitelib("5.11.0"))	/**/
+#define SITELIB_STEM ""		/**/
+
+/* Size_t_size:
+ *	This symbol holds the size of a Size_t in bytes.
+ */
+#define Size_t_size 4		/**/
+
+/* Size_t:
+ *	This symbol holds the type used to declare length parameters
+ *	for string functions.  It is usually size_t, but may be
+ *	unsigned long, int, etc.  It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Size_t size_t	 /* length paramater for string functions */
+
+/* Sock_size_t:
+ *	This symbol holds the type used for the size argument of
+ *	various socket calls (just the base type, not the pointer-to).
+ */
+#define Sock_size_t		int /**/
+
+/* STDCHAR:
+ *	This symbol is defined to be the type of char used in stdio.h.
+ *	It has the values "unsigned char" or "char".
+ */
+#define STDCHAR unsigned char	/**/
+
+/* Uid_t_f:
+ *	This symbol defines the format string used for printing a Uid_t.
+ */
+#define	Uid_t_f		"d"		/**/
+
+/* Uid_t_sign:
+ *	This symbol holds the signedess of a Uid_t.
+ *	1 for unsigned, -1 for signed.
+ */
+#define Uid_t_sign	-1		/* UID sign */
+
+/* Uid_t_size:
+ *	This symbol holds the size of a Uid_t in bytes.
+ */
+#define Uid_t_size 4		/* UID size */
+
+/* Uid_t:
+ *	This symbol holds the type used to declare user ids in the kernel.
+ *	It can be int, ushort, uid_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Uid_t uid_t		/* UID type */
+
+/* USE_ITHREADS:
+ *	This symbol, if defined, indicates that Perl should be built to
+ *	use the interpreter-based threading implementation.
+ */
+/* USE_5005THREADS:
+ *	This symbol, if defined, indicates that Perl should be built to
+ *	use the 5.005-based threading implementation.
+ *	Only valid up to 5.8.x.
+ */
+/* OLD_PTHREADS_API:
+ *	This symbol, if defined, indicates that Perl should
+ *	be built to use the old draft POSIX threads API.
+ */
+/* USE_REENTRANT_API:
+ *	This symbol, if defined, indicates that Perl should
+ *	try to use the various _r versions of library functions.
+ *	This is extremely experimental.
+ */
+/*#define	USE_5005THREADS		/**/
+/*#define	USE_ITHREADS		/**/
+#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
+#define		USE_THREADS		/* until src is revised*/
+#endif
+/*#define	OLD_PTHREADS_API		/**/
+/*#define	USE_REENTRANT_API	/**/
+
+/* PERL_VENDORARCH:
+ *	If defined, this symbol contains the name of a private library.
+ *	The library is private in the sense that it needn't be in anyone's
+ *	execution path, but it should be accessible by the world.
+ *	It may have a ~ on the front.
+ *	The standard distribution will put nothing in this directory.
+ *	Vendors who distribute perl may wish to place their own
+ *	architecture-dependent modules and extensions in this directory with
+ *		MakeMaker Makefile.PL INSTALLDIRS=vendor
+ *	or equivalent.  See INSTALL for details.
+ */
+/* PERL_VENDORARCH_EXP:
+ *	This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+/*#define PERL_VENDORARCH ""		/**/
+/*#define PERL_VENDORARCH_EXP ""		/**/
+
+/* PERL_VENDORLIB_EXP:
+ *	This symbol contains the ~name expanded version of VENDORLIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+/* PERL_VENDORLIB_STEM:
+ *	This define is PERL_VENDORLIB_EXP with any trailing version-specific component
+ *	removed.  The elements in inc_version_list (inc_version_list.U) can
+ *	be tacked onto this variable to generate a list of directories to search.
+ */
+/*#define PERL_VENDORLIB_EXP ""		/**/
+/*#define PERL_VENDORLIB_STEM ""		/**/
+
+/* VOIDFLAGS:
+ *	This symbol indicates how much support of the void type is given by this
+ *	compiler.  What various bits mean:
+ *
+ *	    1 = supports declaration of void
+ *	    2 = supports arrays of pointers to functions returning void
+ *	    4 = supports comparisons between pointers to void functions and
+ *		    addresses of void functions
+ *	    8 = suports declaration of generic void pointers
+ *
+ *	The package designer should define VOIDUSED to indicate the requirements
+ *	of the package.  This can be done either by #defining VOIDUSED before
+ *	including config.h, or by defining defvoidused in Myinit.U.  If the
+ *	latter approach is taken, only those flags will be tested.  If the
+ *	level of void support necessary is not present, defines void to int.
+ */
+#ifndef VOIDUSED
+#define VOIDUSED 15
+#endif
+#define VOIDFLAGS 15
+#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
+#define void int		/* is void to be avoided? */
+#define M_VOID			/* Xenix strikes again */
+#endif
+
+/* USE_CROSS_COMPILE:
+ *	This symbol, if defined, indicates that Perl is being cross-compiled.
+ */
+/* PERL_TARGETARCH:
+ *	This symbol, if defined, indicates the target architecture
+ *	Perl has been cross-compiled to.  Undefined if not a cross-compile.
+ */
+#ifndef USE_CROSS_COMPILE
+/*#define	USE_CROSS_COMPILE	/**/
+#define	PERL_TARGETARCH	""	/**/
+#endif
+
+/* MEM_ALIGNBYTES:
+ *	This symbol contains the number of bytes required to align a
+ *	double, or a long double when applicable. Usual values are 2,
+ *	4 and 8. The default is eight, for safety.
+ */
+#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH)
+#  define MEM_ALIGNBYTES 8
+#else
+#define MEM_ALIGNBYTES 8
+#endif
+
+/* BYTEORDER:
+ *	This symbol holds the hexadecimal constant defined in byteorder,
+ *	in a UV, i.e. 0x1234 or 0x4321 or 0x12345678, etc...
+ *	If the compiler supports cross-compiling or multiple-architecture
+ *	binaries (eg. on NeXT systems), use compiler-defined macros to
+ *	determine the byte order.
+ *	On NeXT 3.2 (and greater), you can build "Fat" Multiple Architecture
+ *	Binaries (MAB) on either big endian or little endian machines.
+ *	The endian-ness is available at compile-time.  This only matters
+ *	for perl, where the config.h can be generated and installed on
+ *	one system, and used by a different architecture to build an
+ *	extension.  Older versions of NeXT that might not have
+ *	defined either *_ENDIAN__ were all on Motorola 680x0 series,
+ *	so the default case (for NeXT) is big endian to catch them.
+ *	This might matter for NeXT 3.0.
+ */
+#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH)
+#  ifdef __LITTLE_ENDIAN__
+#    if LONGSIZE == 4
+#      define BYTEORDER 0x1234
+#    else
+#      if LONGSIZE == 8
+#        define BYTEORDER 0x12345678
+#      endif
+#    endif
+#  else
+#    ifdef __BIG_ENDIAN__
+#      if LONGSIZE == 4
+#        define BYTEORDER 0x4321
+#      else
+#        if LONGSIZE == 8
+#          define BYTEORDER 0x87654321
+#        endif
+#      endif
+#    endif
+#  endif
+#  if !defined(BYTEORDER) && (defined(NeXT) || defined(__NeXT__))
+#    define BYTEORDER 0x4321
+#  endif
+#else
+#define BYTEORDER 0x1234	/* large digits for MSB */
+#endif /* NeXT */
+
+/* CASTI32:
+ *	This symbol is defined if the C compiler can cast negative
+ *	or large floating point numbers to 32-bit ints.
+ */
+#define	CASTI32		/**/
+
+/* CASTNEGFLOAT:
+ *	This symbol is defined if the C compiler can cast negative
+ *	numbers to unsigned longs, ints and shorts.
+ */
+/* CASTFLAGS:
+ *	This symbol contains flags that say what difficulties the compiler
+ *	has casting odd floating values to unsigned long:
+ *		0 = ok
+ *		1 = couldn't cast < 0
+ *		2 = couldn't cast >= 0x80000000
+ *		4 = couldn't cast in argument expression list
+ */
+#define	CASTNEGFLOAT		/**/
+#define CASTFLAGS 0		/**/
+
+/* VOID_CLOSEDIR:
+ *	This symbol, if defined, indicates that the closedir() routine
+ *	does not return a value.
+ */
+/*#define VOID_CLOSEDIR		/**/
+
+/* HAS_FD_SET:
+ *	This symbol, when defined, indicates presence of the fd_set typedef
+ *	in <sys/types.h>
+ */
+#define HAS_FD_SET	/**/
+
+/* Gconvert:
+ *	This preprocessor macro is defined to convert a floating point
+ *	number to a string without a trailing decimal point.  This
+ *	emulates the behavior of sprintf("%g"), but is sometimes much more
+ *	efficient.  If gconvert() is not available, but gcvt() drops the
+ *	trailing decimal point, then gcvt() is used.  If all else fails,
+ *	a macro using sprintf("%g") is used. Arguments for the Gconvert
+ *	macro are: value, number of digits, whether trailing zeros should
+ *	be retained, and the output buffer.
+ *	The usual values are:
+ *		d_Gconvert='gconvert((x),(n),(t),(b))'
+ *		d_Gconvert='gcvt((x),(n),(b))'
+ *		d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+ *	The last two assume trailing zeros should not be kept.
+ */
+#define Gconvert(x,n,t,b) gcvt((x),(n),(b))
+
+/* HAS_GETPAGESIZE:
+ *	This symbol, if defined, indicates that the getpagesize system call
+ *	is available to get system page size, which is the granularity of
+ *	many memory management calls.
+ */
+/*#define HAS_GETPAGESIZE		/**/
+
+/* HAS_GNULIBC:
+ *	This symbol, if defined, indicates to the C program that
+ *	the GNU C library is being used.  A better check is to use
+ *	the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc.
+ */
+/*#define HAS_GNULIBC  	/**/
+#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)
+#   define _GNU_SOURCE
+#endif
+
+/* HAS_ISASCII:
+ *	This manifest constant lets the C program know that isascii
+ *	is available.
+ */
+#define HAS_ISASCII		/**/
+
+/* HAS_LCHOWN:
+ *	This symbol, if defined, indicates that the lchown routine is
+ *	available to operate on a symbolic link (instead of following the
+ *	link).
+ */
+/*#define HAS_LCHOWN		/**/
+
+/* HAS_OPEN3:
+ *	This manifest constant lets the C program know that the three
+ *	argument form of open(2) is available.
+ */
+/*#define HAS_OPEN3		/**/
+
+/* HAS_SAFE_BCOPY:
+ *	This symbol, if defined, indicates that the bcopy routine is available
+ *	to copy potentially overlapping memory blocks. Normally, you should
+ *	probably use memmove() or memcpy(). If neither is defined, roll your
+ *	own version.
+ */
+/*#define HAS_SAFE_BCOPY	/**/
+
+/* HAS_SAFE_MEMCPY:
+ *	This symbol, if defined, indicates that the memcpy routine is available
+ *	to copy potentially overlapping memory blocks.  If you need to
+ *	copy overlapping memory blocks, you should check HAS_MEMMOVE and
+ *	use memmove() instead, if available.
+ */
+/*#define HAS_SAFE_MEMCPY	/**/
+
+/* HAS_SANE_MEMCMP:
+ *	This symbol, if defined, indicates that the memcmp routine is available
+ *	and can be used to compare relative magnitudes of chars with their high
+ *	bits set.  If it is not defined, roll your own version.
+ */
+#define HAS_SANE_MEMCMP	/**/
+
+/* HAS_SIGACTION:
+ *	This symbol, if defined, indicates that Vr4's sigaction() routine
+ *	is available.
+ */
+/*#define HAS_SIGACTION	/**/
+
+/* HAS_SIGSETJMP:
+ *	This variable indicates to the C program that the sigsetjmp()
+ *	routine is available to save the calling process's registers
+ *	and stack environment for later use by siglongjmp(), and
+ *	to optionally save the process's signal mask.  See
+ *	Sigjmp_buf, Sigsetjmp, and Siglongjmp.
+ */
+/* Sigjmp_buf:
+ *	This is the buffer type to be used with Sigsetjmp and Siglongjmp.
+ */
+/* Sigsetjmp:
+ *	This macro is used in the same way as sigsetjmp(), but will invoke
+ *	traditional setjmp() if sigsetjmp isn't available.
+ *	See HAS_SIGSETJMP.
+ */
+/* Siglongjmp:
+ *	This macro is used in the same way as siglongjmp(), but will invoke
+ *	traditional longjmp() if siglongjmp isn't available.
+ *	See HAS_SIGSETJMP.
+ */
+/*#define HAS_SIGSETJMP	/**/
+#ifdef HAS_SIGSETJMP
+#define Sigjmp_buf sigjmp_buf
+#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask))
+#define Siglongjmp(buf,retval) siglongjmp((buf),(retval))
+#else
+#define Sigjmp_buf jmp_buf
+#define Sigsetjmp(buf,save_mask) setjmp((buf))
+#define Siglongjmp(buf,retval) longjmp((buf),(retval))
+#endif
 
 /* USE_STDIO_PTR:
  *	This symbol is defined if the _ptr and _cnt fields (or similar)
@@ -3059,37 +3148,763 @@
 #define FILE_bufsiz(fp)	((fp)->level + (fp)->curp - (fp)->buffer)
 #endif
 
-/* HAS_STRERROR:
- *	This symbol, if defined, indicates that the strerror routine is
- *	available to translate error numbers to strings. See the writeup
- *	of Strerror() in this file before you try to define your own.
+/* HAS_VPRINTF:
+ *	This symbol, if defined, indicates that the vprintf routine is available
+ *	to printf with a pointer to an argument list.  If unavailable, you
+ *	may need to write your own, probably in terms of _doprnt().
  */
-/* HAS_SYS_ERRLIST:
- *	This symbol, if defined, indicates that the sys_errlist array is
- *	available to translate error numbers to strings. The extern int
- *	sys_nerr gives the size of that table.
+/* USE_CHAR_VSPRINTF:
+ *	This symbol is defined if this system has vsprintf() returning type
+ *	(char*).  The trend seems to be to declare it as "int vsprintf()".  It
+ *	is up to the package author to declare vsprintf correctly based on the
+ *	symbol.
  */
-/* Strerror:
- *	This preprocessor symbol is defined as a macro if strerror() is
- *	not available to translate error numbers to strings but sys_errlist[]
- *	array is there.
+#define HAS_VPRINTF	/**/
+/*#define USE_CHAR_VSPRINTF 	/**/
+
+/* DOUBLESIZE:
+ *	This symbol contains the size of a double, so that the C preprocessor
+ *	can make decisions based on it.
  */
-#define HAS_STRERROR		/**/
-#define HAS_SYS_ERRLIST	/**/
-#define Strerror(e) strerror(e)
+#define DOUBLESIZE 8		/**/
 
-/* HAS_STRERROR_R:
- *	This symbol, if defined, indicates that the strerror_r routine
- *	is available to strerror re-entrantly.
+/* I_TIME:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <time.h>.
  */
-/* STRERROR_R_PROTO:
- *	This symbol encodes the prototype of strerror_r.
- *	It is zero if d_strerror_r is undef, and one of the
- *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r
- *	is defined.
+/* I_SYS_TIME:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/time.h>.
  */
-/*#define HAS_STRERROR_R	   /**/
-#define STRERROR_R_PROTO 0	   /**/
+/* I_SYS_TIME_KERNEL:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/time.h> with KERNEL defined.
+ */
+/* HAS_TM_TM_ZONE:
+ *	This symbol, if defined, indicates to the C program that
+ *	the struct tm has a tm_zone field.
+ */
+/* HAS_TM_TM_GMTOFF:
+ *	This symbol, if defined, indicates to the C program that
+ *	the struct tm has a tm_gmtoff field.
+ */
+#define I_TIME		/**/
+/*#define I_SYS_TIME		/**/
+/*#define I_SYS_TIME_KERNEL		/**/
+/*#define HAS_TM_TM_ZONE		/**/
+/*#define HAS_TM_TM_GMTOFF		/**/
+
+/* VAL_O_NONBLOCK:
+ *	This symbol is to be used during open() or fcntl(F_SETFL) to turn on
+ *	non-blocking I/O for the file descriptor. Note that there is no way
+ *	back, i.e. you cannot turn it blocking again this way. If you wish to
+ *	alternatively switch between blocking and non-blocking, use the
+ *	ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
+ */
+/* VAL_EAGAIN:
+ *	This symbol holds the errno error code set by read() when no data was
+ *	present on the non-blocking file descriptor.
+ */
+/* RD_NODATA:
+ *	This symbol holds the return code from read() when no data is present
+ *	on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
+ *	not defined, then you can't distinguish between no data and EOF by
+ *	issuing a read(). You'll have to find another way to tell for sure!
+ */
+/* EOF_NONBLOCK:
+ *	This symbol, if defined, indicates to the C program that a read() on
+ *	a non-blocking file descriptor will return 0 on EOF, and not the value
+ *	held in RD_NODATA (-1 usually, in that case!).
+ */
+#define VAL_O_NONBLOCK O_NONBLOCK
+#define VAL_EAGAIN EAGAIN
+#define RD_NODATA -1
+#define EOF_NONBLOCK
+
+/* PTRSIZE:
+ *	This symbol contains the size of a pointer, so that the C preprocessor
+ *	can make decisions based on it.  It will be sizeof(void *) if
+ *	the compiler supports (void *); otherwise it will be
+ *	sizeof(char *).
+ */
+#define PTRSIZE 4		/**/
+
+/* Drand01:
+ *	This macro is to be used to generate uniformly distributed
+ *	random numbers over the range [0., 1.[.  You may have to supply
+ *	an 'extern double drand48();' in your program since SunOS 4.1.3
+ *	doesn't provide you with anything relevant in its headers.
+ *	See HAS_DRAND48_PROTO.
+ */
+/* Rand_seed_t:
+ *	This symbol defines the type of the argument of the
+ *	random seed function.
+ */
+/* seedDrand01:
+ *	This symbol defines the macro to be used in seeding the
+ *	random number generator (see Drand01).
+ */
+/* RANDBITS:
+ *	This symbol indicates how many bits are produced by the
+ *	function used to generate normalized random numbers.
+ *	Values include 15, 16, 31, and 48.
+ */
+#define Drand01()		(rand()/(double)((unsigned)1<<RANDBITS))		/**/
+#define Rand_seed_t		unsigned		/**/
+#define seedDrand01(x)	srand((Rand_seed_t)x)	/**/
+#define RANDBITS		15		/**/
+
+/* SSize_t:
+ *	This symbol holds the type used by functions that return
+ *	a count of bytes or an error condition.  It must be a signed type.
+ *	It is usually ssize_t, but may be long or int, etc.
+ *	It may be necessary to include <sys/types.h> or <unistd.h>
+ *	to get any typedef'ed information.
+ *	We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
+ */
+#define SSize_t int	 /* signed count of bytes */
+
+/* EBCDIC:
+ *     This symbol, if defined, indicates that this system uses
+ *	EBCDIC encoding.
+ */
+/*#define	EBCDIC 		/**/
+
+/* PERL_USE_DEVEL:
+ *	This symbol, if defined, indicates that Perl was configured with
+ *	-Dusedevel, to enable development features.  This should not be
+ *	done for production builds.
+ */
+/*#define	PERL_USE_DEVEL		/**/
+
+/* HAS_ATOLF:
+ *	This symbol, if defined, indicates that the atolf routine is
+ *	available to convert strings into long doubles.
+ */
+/*#define HAS_ATOLF		/**/
+
+/* HAS_ATOLL:
+ *	This symbol, if defined, indicates that the atoll routine is
+ *	available to convert strings into long longs.
+ */
+/*#define HAS_ATOLL		/**/
+
+/* HAS__FWALK:
+ *	This symbol, if defined, indicates that the _fwalk system call is
+ *	available to apply a function to all the file handles.
+ */
+/*#define HAS__FWALK		/**/
+
+/* HAS_AINTL:
+ *	This symbol, if defined, indicates that the aintl routine is
+ *	available.  If copysignl is also present we can emulate modfl.
+ */
+/*#define HAS_AINTL		/**/
+
+/* HAS_BUILTIN_CHOOSE_EXPR:
+ *	Can we handle GCC builtin for compile-time ternary-like expressions
+ */
+/* HAS_BUILTIN_EXPECT:
+ *	Can we handle GCC builtin for telling that certain values are more
+ *	likely
+ */
+/*#define HAS_BUILTIN_EXPECT	/**/
+/*#define HAS_BUILTIN_CHOOSE_EXPR	/**/
+
+/* HAS_C99_VARIADIC_MACROS:
+ *	If defined, the compiler supports C99 variadic macros.
+ */
+/*#define	HAS_C99_VARIADIC_MACROS	/**/
+
+/* HAS_CLASS:
+ *	This symbol, if defined, indicates that the class routine is
+ *	available to classify doubles.  Available for example in AIX.
+ *	The returned values are defined in <float.h> and are:
+ *
+ *	FP_PLUS_NORM	Positive normalized, nonzero
+ *	FP_MINUS_NORM	Negative normalized, nonzero
+ *	FP_PLUS_DENORM	Positive denormalized, nonzero
+ *	FP_MINUS_DENORM	Negative denormalized, nonzero
+ *	FP_PLUS_ZERO	+0.0
+ *	FP_MINUS_ZERO	-0.0
+ *	FP_PLUS_INF	+INF
+ *	FP_MINUS_INF	-INF
+ *	FP_NANS		Signaling Not a Number (NaNS)
+ *	FP_NANQ		Quiet Not a Number (NaNQ)
+ */
+/*#define HAS_CLASS		/**/
+
+/* HAS_CLEARENV:
+ *	This symbol, if defined, indicates that the clearenv () routine is
+ *	available for use.
+ */
+/*#define HAS_CLEARENV		/**/
+
+/* HAS_STRUCT_CMSGHDR:
+ *	This symbol, if defined, indicates that the struct cmsghdr
+ *	is supported.
+ */
+/*#define HAS_STRUCT_CMSGHDR	/**/
+
+/* HAS_COPYSIGNL:
+ *	This symbol, if defined, indicates that the copysignl routine is
+ *	available.  If aintl is also present we can emulate modfl.
+ */
+/*#define HAS_COPYSIGNL		/**/
+
+/* USE_CPLUSPLUS:
+ *	This symbol, if defined, indicates that a C++ compiler was
+ *	used to compiled Perl and will be used to compile extensions.
+ */
+/*#define USE_CPLUSPLUS		/**/
+
+/* HAS_DBMINIT_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the dbminit() function.  Otherwise, it is up
+ *	to the program to supply one.  A good guess is
+ *		extern int dbminit(char *);
+ */
+/*#define	HAS_DBMINIT_PROTO	/**/
+
+/* HAS_DIR_DD_FD:
+ *	This symbol, if defined, indicates that the the DIR* dirstream
+ *	structure contains a member variable named dd_fd.
+ */
+/*#define HAS_DIR_DD_FD		/**/
+
+/* HAS_DIRFD:
+ *	This manifest constant lets the C program know that dirfd
+ *	is available.
+ */
+/*#define HAS_DIRFD		/**/
+
+/* DLSYM_NEEDS_UNDERSCORE:
+ *	This symbol, if defined, indicates that we need to prepend an
+ *	underscore to the symbol name before calling dlsym().  This only
+ *	makes sense if you *have* dlsym, which we will presume is the
+ *	case if you're using dl_dlopen.xs.
+ */
+/*#define 	DLSYM_NEEDS_UNDERSCORE 	/**/
+
+/* HAS_FAST_STDIO:
+ *	This symbol, if defined, indicates that the "fast stdio"
+ *	is available to manipulate the stdio buffers directly.
+ */
+#define HAS_FAST_STDIO		/**/
+
+/* HAS_FCHDIR:
+ *	This symbol, if defined, indicates that the fchdir routine is
+ *	available to change directory using a file descriptor.
+ */
+/*#define HAS_FCHDIR		/**/
+
+/* FCNTL_CAN_LOCK:
+ *	This symbol, if defined, indicates that fcntl() can be used
+ *	for file locking.  Normally on Unix systems this is defined.
+ *	It may be undefined on VMS.
+ */
+/*#define FCNTL_CAN_LOCK		/**/
+
+/* HAS_FINITE:
+ *	This symbol, if defined, indicates that the finite routine is
+ *	available to check whether a double is finite (non-infinity non-NaN).
+ */
+/*#define HAS_FINITE		/**/
+
+/* HAS_FINITEL:
+ *	This symbol, if defined, indicates that the finitel routine is
+ *	available to check whether a long double is finite
+ *	(non-infinity non-NaN).
+ */
+/*#define HAS_FINITEL		/**/
+
+/* HAS_FLOCK_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the flock() function.  Otherwise, it is up
+ *	to the program to supply one.  A good guess is
+ *		extern int flock(int, int);
+ */
+#define	HAS_FLOCK_PROTO	/**/
+
+/* HAS_FP_CLASS:
+ *	This symbol, if defined, indicates that the fp_class routine is
+ *	available to classify doubles.  Available for example in Digital UNIX.
+ *	The returned values are defined in <math.h> and are:
+ *
+ *	FP_SNAN           Signaling NaN (Not-a-Number)
+ *	FP_QNAN           Quiet NaN (Not-a-Number)
+ *	FP_POS_INF        +infinity
+ *	FP_NEG_INF        -infinity
+ *	FP_POS_NORM       Positive normalized
+ *	FP_NEG_NORM       Negative normalized
+ *	FP_POS_DENORM     Positive denormalized
+ *	FP_NEG_DENORM     Negative denormalized
+ *	FP_POS_ZERO       +0.0 (positive zero)
+ *	FP_NEG_ZERO       -0.0 (negative zero)
+ */
+/*#define HAS_FP_CLASS		/**/
+
+/* HAS_FPCLASS:
+ *	This symbol, if defined, indicates that the fpclass routine is
+ *	available to classify doubles.  Available for example in Solaris/SVR4.
+ *	The returned values are defined in <ieeefp.h> and are:
+ *
+ *	FP_SNAN		signaling NaN
+ *	FP_QNAN		quiet NaN
+ *	FP_NINF		negative infinity
+ *	FP_PINF		positive infinity
+ *	FP_NDENORM	negative denormalized non-zero
+ *	FP_PDENORM	positive denormalized non-zero
+ *	FP_NZERO	negative zero
+ *	FP_PZERO	positive zero
+ *	FP_NNORM	negative normalized non-zero
+ *	FP_PNORM	positive normalized non-zero
+ */
+/*#define HAS_FPCLASS		/**/
+
+/* HAS_FPCLASSIFY:
+ *	This symbol, if defined, indicates that the fpclassify routine is
+ *	available to classify doubles.  Available for example in HP-UX.
+ *	The returned values are defined in <math.h> and are
+ *
+ *           FP_NORMAL     Normalized
+ *           FP_ZERO       Zero
+ *           FP_INFINITE   Infinity
+ *           FP_SUBNORMAL  Denormalized
+ *           FP_NAN        NaN
+ *
+ */
+/*#define HAS_FPCLASSIFY		/**/
+
+/* HAS_FPCLASSL:
+ *	This symbol, if defined, indicates that the fpclassl routine is
+ *	available to classify long doubles.  Available for example in IRIX.
+ *	The returned values are defined in <ieeefp.h> and are:
+ *
+ *	FP_SNAN		signaling NaN
+ *	FP_QNAN		quiet NaN
+ *	FP_NINF		negative infinity
+ *	FP_PINF		positive infinity
+ *	FP_NDENORM	negative denormalized non-zero
+ *	FP_PDENORM	positive denormalized non-zero
+ *	FP_NZERO	negative zero
+ *	FP_PZERO	positive zero
+ *	FP_NNORM	negative normalized non-zero
+ *	FP_PNORM	positive normalized non-zero
+ */
+/*#define HAS_FPCLASSL		/**/
+
+/* HAS_FPOS64_T:
+ *	This symbol will be defined if the C compiler supports fpos64_t.
+ */
+/*#define	HAS_FPOS64_T    	/**/
+
+/* HAS_FREXPL:
+ *	This symbol, if defined, indicates that the frexpl routine is
+ *	available to break a long double floating-point number into
+ *	a normalized fraction and an integral power of 2.
+ */
+/*#define HAS_FREXPL		/**/
+
+/* HAS_STRUCT_FS_DATA:
+ *	This symbol, if defined, indicates that the struct fs_data
+ *	to do statfs() is supported.
+ */
+/*#define HAS_STRUCT_FS_DATA	/**/
+
+/* HAS_FSEEKO:
+ *	This symbol, if defined, indicates that the fseeko routine is
+ *	available to fseek beyond 32 bits (useful for ILP32 hosts).
+ */
+/*#define HAS_FSEEKO		/**/
+
+/* HAS_FSTATFS:
+ *	This symbol, if defined, indicates that the fstatfs routine is
+ *	available to stat filesystems by file descriptors.
+ */
+/*#define HAS_FSTATFS		/**/
+
+/* HAS_FSYNC:
+ *	This symbol, if defined, indicates that the fsync routine is
+ *	available to write a file's modified data and attributes to
+ *	permanent storage.
+ */
+/*#define HAS_FSYNC		/**/
+
+/* HAS_FTELLO:
+ *	This symbol, if defined, indicates that the ftello routine is
+ *	available to ftell beyond 32 bits (useful for ILP32 hosts).
+ */
+/*#define HAS_FTELLO		/**/
+
+/* HAS_FUTIMES:
+ *	This symbol, if defined, indicates that the futimes routine is
+ *	available to change file descriptor time stamps with struct timevals.
+ */
+/*#define HAS_FUTIMES		/**/
+
+/* HAS_GETCWD:
+ *	This symbol, if defined, indicates that the getcwd routine is
+ *	available to get the current working directory.
+ */
+#define HAS_GETCWD		/**/
+
+/* HAS_GETESPWNAM:
+ *	This symbol, if defined, indicates that the getespwnam system call is
+ *	available to retrieve enchanced (shadow) password entries by name.
+ */
+/*#define HAS_GETESPWNAM		/**/
+
+/* HAS_GETFSSTAT:
+ *	This symbol, if defined, indicates that the getfsstat routine is
+ *	available to stat filesystems in bulk.
+ */
+/*#define HAS_GETFSSTAT		/**/
+
+/* HAS_GETITIMER:
+ *	This symbol, if defined, indicates that the getitimer routine is
+ *	available to return interval timers.
+ */
+/*#define HAS_GETITIMER		/**/
+
+/* HAS_GETMNT:
+ *	This symbol, if defined, indicates that the getmnt routine is
+ *	available to get filesystem mount info by filename.
+ */
+/*#define HAS_GETMNT		/**/
+
+/* HAS_GETMNTENT:
+ *	This symbol, if defined, indicates that the getmntent routine is
+ *	available to iterate through mounted file systems to get their info.
+ */
+/*#define HAS_GETMNTENT		/**/
+
+/* HAS_GETPRPWNAM:
+ *	This symbol, if defined, indicates that the getprpwnam system call is
+ *	available to retrieve protected (shadow) password entries by name.
+ */
+/*#define HAS_GETPRPWNAM		/**/
+
+/* HAS_GETSPNAM:
+ *	This symbol, if defined, indicates that the getspnam system call is
+ *	available to retrieve SysV shadow password entries by name.
+ */
+/*#define HAS_GETSPNAM		/**/
+
+/* HAS_HASMNTOPT:
+ *	This symbol, if defined, indicates that the hasmntopt routine is
+ *	available to query the mount options of file systems.
+ */
+/*#define HAS_HASMNTOPT		/**/
+
+/* HAS_ILOGBL:
+ *	This symbol, if defined, indicates that the ilogbl routine is
+ *	available.  If scalbnl is also present we can emulate frexpl.
+ */
+/*#define HAS_ILOGBL		/**/
+
+/* HAS_INT64_T:
+ *     This symbol will defined if the C compiler supports int64_t.
+ *     Usually the <inttypes.h> needs to be included, but sometimes
+ *	<sys/types.h> is enough.
+ */
+/*#define     HAS_INT64_T               /**/
+
+/* HAS_ISFINITE:
+ *	This symbol, if defined, indicates that the isfinite routine is
+ *	available to check whether a double is finite (non-infinity non-NaN).
+ */
+/*#define HAS_ISFINITE		/**/
+
+/* HAS_ISINF:
+ *	This symbol, if defined, indicates that the isinf routine is
+ *	available to check whether a double is an infinity.
+ */
+/*#define HAS_ISINF		/**/
+
+/* HAS_ISNAN:
+ *	This symbol, if defined, indicates that the isnan routine is
+ *	available to check whether a double is a NaN.
+ */
+#define HAS_ISNAN		/**/
+
+/* HAS_ISNANL:
+ *	This symbol, if defined, indicates that the isnanl routine is
+ *	available to check whether a long double is a NaN.
+ */
+/*#define HAS_ISNANL		/**/
+
+/* HAS_LDBL_DIG:
+ *	This symbol, if defined, indicates that this system's <float.h>
+ *	or <limits.h> defines the symbol LDBL_DIG, which is the number
+ *	of significant digits in a long double precision number. Unlike
+ *	for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined.
+ */
+#define HAS_LDBL_DIG 	/**/
+
+/* LIBM_LIB_VERSION:
+ *	This symbol, if defined, indicates that libm exports _LIB_VERSION
+ *	and that math.h defines the enum to manipulate it.
+ */
+/*#define LIBM_LIB_VERSION		/**/
+
+/* HAS_MADVISE:
+ *	This symbol, if defined, indicates that the madvise system call is
+ *	available to map a file into memory.
+ */
+/*#define HAS_MADVISE		/**/
+
+/* HAS_MALLOC_SIZE:
+ *	This symbol, if defined, indicates that the malloc_size
+ *	routine is available for use.
+ */
+/*#define HAS_MALLOC_SIZE		/**/
+
+/* HAS_MALLOC_GOOD_SIZE:
+ *	This symbol, if defined, indicates that the malloc_good_size
+ *	routine is available for use.
+ */
+/*#define HAS_MALLOC_GOOD_SIZE	/**/
+
+/* HAS_MKDTEMP:
+ *	This symbol, if defined, indicates that the mkdtemp routine is
+ *	available to exclusively create a uniquely named temporary directory.
+ */
+/*#define HAS_MKDTEMP		/**/
+
+/* HAS_MKSTEMPS:
+ *	This symbol, if defined, indicates that the mkstemps routine is
+ *	available to excluslvely create and open a uniquely named
+ *	(with a suffix) temporary file.
+ */
+/*#define HAS_MKSTEMPS		/**/
+
+/* HAS_MODFL:
+ *	This symbol, if defined, indicates that the modfl routine is
+ *	available to split a long double x into a fractional part f and
+ *	an integer part i such that |f| < 1.0 and (f + i) = x.
+ */
+/* HAS_MODFL_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the modfl() function.  Otherwise, it is up
+ *	to the program to supply one.
+ */
+/* HAS_MODFL_POW32_BUG:
+ *	This symbol, if defined, indicates that the modfl routine is
+ *	broken for long doubles >= pow(2, 32).
+ *	For example from 4294967303.150000 one would get 4294967302.000000
+ *	and 1.150000.  The bug has been seen in certain versions of glibc,
+ *	release 2.2.2 is known to be okay.
+ */
+/*#define HAS_MODFL		/**/
+/*#define HAS_MODFL_PROTO		/**/
+/*#define HAS_MODFL_POW32_BUG		/**/
+
+/* HAS_MPROTECT:
+ *	This symbol, if defined, indicates that the mprotect system call is
+ *	available to modify the access protection of a memory mapped file.
+ */
+/*#define HAS_MPROTECT		/**/
+
+/* HAS_STRUCT_MSGHDR:
+ *	This symbol, if defined, indicates that the struct msghdr
+ *	is supported.
+ */
+/*#define HAS_STRUCT_MSGHDR	/**/
+
+/* HAS_NL_LANGINFO:
+ *	This symbol, if defined, indicates that the nl_langinfo routine is
+ *	available to return local data.  You will also need <langinfo.h>
+ *	and therefore I_LANGINFO.
+ */
+/*#define HAS_NL_LANGINFO		/**/
+
+/* HAS_OFF64_T:
+ *	This symbol will be defined if the C compiler supports off64_t.
+ */
+/*#define	HAS_OFF64_T    		/**/
+
+/* HAS_PROCSELFEXE:
+ *	This symbol is defined if PROCSELFEXE_PATH is a symlink
+ *	to the absolute pathname of the executing program.
+ */
+/* PROCSELFEXE_PATH:
+ *	If HAS_PROCSELFEXE is defined this symbol is the filename
+ *	of the symbolic link pointing to the absolute pathname of
+ *	the executing program.
+ */
+/*#define HAS_PROCSELFEXE	/**/
+#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH)
+#define PROCSELFEXE_PATH		/**/
+#endif
+
+/* HAS_PTHREAD_ATTR_SETSCOPE:
+ *	This symbol, if defined, indicates that the pthread_attr_setscope
+ *	system call is available to set the contention scope attribute of
+ *	a thread attribute object.
+ */
+/*#define HAS_PTHREAD_ATTR_SETSCOPE		/**/
+
+/* HAS_READV:
+ *	This symbol, if defined, indicates that the readv routine is
+ *	available to do gather reads.  You will also need <sys/uio.h>
+ *	and there I_SYSUIO.
+ */
+/*#define HAS_READV		/**/
+
+/* HAS_RECVMSG:
+ *	This symbol, if defined, indicates that the recvmsg routine is
+ *	available to send structured socket messages.
+ */
+/*#define HAS_RECVMSG		/**/
+
+/* HAS_SBRK_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the sbrk() function.  Otherwise, it is up
+ *	to the program to supply one.  Good guesses are
+ *		extern void* sbrk(int);
+ *		extern void* sbrk(size_t);
+ */
+/*#define	HAS_SBRK_PROTO	/**/
+
+/* HAS_SCALBNL:
+ *	This symbol, if defined, indicates that the scalbnl routine is
+ *	available.  If ilogbl is also present we can emulate frexpl.
+ */
+/*#define HAS_SCALBNL		/**/
+
+/* HAS_SENDMSG:
+ *	This symbol, if defined, indicates that the sendmsg routine is
+ *	available to send structured socket messages.
+ */
+/*#define HAS_SENDMSG		/**/
+
+/* HAS_SETITIMER:
+ *	This symbol, if defined, indicates that the setitimer routine is
+ *	available to set interval timers.
+ */
+/*#define HAS_SETITIMER		/**/
+
+/* HAS_SETPROCTITLE:
+ *	This symbol, if defined, indicates that the setproctitle routine is
+ *	available to set process title.
+ */
+/*#define HAS_SETPROCTITLE		/**/
+
+/* USE_SFIO:
+ *	This symbol, if defined, indicates that sfio should
+ *	be used.
+ */
+/*#define	USE_SFIO		/**/
+
+/* HAS_SIGNBIT:
+ *	This symbol, if defined, indicates that the signbit routine is
+ *	available to check if the given number has the sign bit set.
+ *	This should include correct testing of -0.0.  This will only be set
+ *	if the signbit() routine is safe to use with the NV type used internally
+ *	in perl.  Users should call Perl_signbit(), which will be #defined to
+ *	the system's signbit() function or macro if this symbol is defined.
+ */
+/*#define HAS_SIGNBIT		/**/
+
+/* HAS_SIGPROCMASK:
+ *	This symbol, if defined, indicates that the sigprocmask
+ *	system call is available to examine or change the signal mask
+ *	of the calling process.
+ */
+/*#define HAS_SIGPROCMASK		/**/
+
+/* USE_SITECUSTOMIZE:
+ *	This symbol, if defined, indicates that sitecustomize should
+ *	be used.
+ */
+#ifndef USE_SITECUSTOMIZE
+/*#define	USE_SITECUSTOMIZE		/**/
+#endif
+
+/* HAS_SNPRINTF:
+ *	This symbol, if defined, indicates that the snprintf () library
+ *	function is available for use.
+ */
+/* HAS_VSNPRINTF:
+ *	This symbol, if defined, indicates that the vsnprintf () library
+ *	function is available for use.
+ */
+#define HAS_SNPRINTF	/**/
+#define HAS_VSNPRINTF	/**/
+
+/* HAS_SOCKATMARK:
+ *	This symbol, if defined, indicates that the sockatmark routine is
+ *	available to test whether a socket is at the out-of-band mark.
+ */
+/*#define HAS_SOCKATMARK		/**/
+
+/* HAS_SOCKATMARK_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the sockatmark() function.  Otherwise, it is up
+ *	to the program to supply one.  A good guess is
+ *		extern int sockatmark(int);
+ */
+/*#define	HAS_SOCKATMARK_PROTO	/**/
+
+/* HAS_SOCKS5_INIT:
+ *	This symbol, if defined, indicates that the socks5_init routine is
+ *	available to initialize SOCKS 5.
+ */
+/*#define HAS_SOCKS5_INIT		/**/
+
+/* SPRINTF_RETURNS_STRLEN:
+ *	This variable defines whether sprintf returns the length of the string
+ *	(as per the ANSI spec). Some C libraries retain compatibility with
+ *	pre-ANSI C and return a pointer to the passed in buffer; for these
+ *	this variable will be undef.
+ */
+#define SPRINTF_RETURNS_STRLEN	/**/
+
+/* HAS_SQRTL:
+ *	This symbol, if defined, indicates that the sqrtl routine is
+ *	available to do long double square roots.
+ */
+/*#define HAS_SQRTL		/**/
+
+/* HAS_SETRESGID_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the setresgid() function.  Otherwise, it is up
+ *	to the program to supply one.  Good guesses are
+ *		extern int setresgid(uid_t ruid, uid_t euid, uid_t suid);
+ */
+/*#define	HAS_SETRESGID_PROTO	/**/
+
+/* HAS_SETRESUID_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the setresuid() function.  Otherwise, it is up
+ *	to the program to supply one.  Good guesses are
+ *		extern int setresuid(uid_t ruid, uid_t euid, uid_t suid);
+ */
+/*#define	HAS_SETRESUID_PROTO	/**/
+
+/* HAS_STRUCT_STATFS_F_FLAGS:
+ *	This symbol, if defined, indicates that the struct statfs
+ *	does have the f_flags member containing the mount flags of
+ *	the filesystem containing the file.
+ *	This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3),
+ *	not from <sys/statfs.h> (SYSV).  Older BSDs (like Ultrix) do not
+ *	have statfs() and struct statfs, they have ustat() and getmnt()
+ *	with struct ustat and struct fs_data.
+ */
+/*#define HAS_STRUCT_STATFS_F_FLAGS		/**/
+
+/* HAS_STRUCT_STATFS:
+ *	This symbol, if defined, indicates that the struct statfs
+ *	to do statfs() is supported.
+ */
+/*#define HAS_STRUCT_STATFS	/**/
+
+/* HAS_FSTATVFS:
+ *	This symbol, if defined, indicates that the fstatvfs routine is
+ *	available to stat filesystems by file descriptors.
+ */
+/*#define HAS_FSTATVFS		/**/
 
 /* HAS_STRFTIME:
  *	This symbol, if defined, indicates that the strftime routine is
@@ -3101,13 +3916,13 @@
  *	This symbol, if defined, indicates that the strlcat () routine is
  *	available to do string concatenation.
  */
-/*#define HAS_STRLCAT			/**/
+/*#define HAS_STRLCAT		/**/
 
 /* HAS_STRLCPY:
  *	This symbol, if defined, indicates that the strlcpy () routine is
  *	available to do string copying.
  */
-/*#define HAS_STRLCPY			/**/
+/*#define HAS_STRLCPY		/**/
 
 /* HAS_STRTOLD:
  *	This symbol, if defined, indicates that the strtold routine is
@@ -3127,12 +3942,6 @@
  */
 /*#define HAS_STRTOQ		/**/
 
-/* HAS_STRTOUL:
- *	This symbol, if defined, indicates that the strtoul routine is
- *	available to provide conversion of strings to unsigned long.
- */
-#define HAS_STRTOUL	/**/
-
 /* HAS_STRTOULL:
  *	This symbol, if defined, indicates that the strtoull routine is
  *	available to convert strings to unsigned long longs.
@@ -3162,49 +3971,42 @@
  */
 #define	HAS_TELLDIR_PROTO	/**/
 
-/* HAS_TIME:
- *	This symbol, if defined, indicates that the time() routine exists.
+/* HAS_CTIME64:
+ *	This symbol, if defined, indicates that the ctime64 () routine is
+ *	available to do the 64bit variant of ctime ()
  */
-/* Time_t:
- *	This symbol holds the type returned by time(). It can be long,
- *	or time_t on BSD sites (in which case <sys/types.h> should be
- *	included).
+/* HAS_LOCALTIME64:
+ *	This symbol, if defined, indicates that the localtime64 () routine is
+ *	available to do the 64bit variant of localtime ()
  */
-#define HAS_TIME		/**/
-#define Time_t time_t		/* Time type */
-
-/* HAS_TIMES:
- *	This symbol, if defined, indicates that the times() routine exists.
- *	Note that this became obsolete on some systems (SUNOS), which now
- * use getrusage(). It may be necessary to include <sys/times.h>.
+/* HAS_GMTIME64:
+ *	This symbol, if defined, indicates that the gmtime64 () routine is
+ *	available to do the 64bit variant of gmtime ()
  */
-#define HAS_TIMES		/**/
-
-/* HAS_TMPNAM_R:
- *	This symbol, if defined, indicates that the tmpnam_r routine
- *	is available to tmpnam re-entrantly.
+/* HAS_MKTIME64:
+ *	This symbol, if defined, indicates that the mktime64 () routine is
+ *	available to do the 64bit variant of mktime ()
  */
-/* TMPNAM_R_PROTO:
- *	This symbol encodes the prototype of tmpnam_r.
- *	It is zero if d_tmpnam_r is undef, and one of the
- *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r
- *	is defined.
+/* HAS_DIFFTIME64:
+ *	This symbol, if defined, indicates that the difftime64 () routine is
+ *	available to do the 64bit variant of difftime ()
  */
-/*#define HAS_TMPNAM_R	   /**/
-#define TMPNAM_R_PROTO 0	   /**/
-
-/* HAS_TTYNAME_R:
- *	This symbol, if defined, indicates that the ttyname_r routine
- *	is available to ttyname re-entrantly.
+/* HAS_ASCTIME64:
+ *	This symbol, if defined, indicates that the asctime64 () routine is
+ *	available to do the 64bit variant of asctime ()
  */
-/* TTYNAME_R_PROTO:
- *	This symbol encodes the prototype of ttyname_r.
- *	It is zero if d_ttyname_r is undef, and one of the
- *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
- *	is defined.
+/*#define	HAS_CTIME64		/**/
+/*#define	HAS_LOCALTIME64		/**/
+/*#define	HAS_GMTIME64		/**/
+/*#define	HAS_MKTIME64		/**/
+/*#define	HAS_DIFFTIME64		/**/
+/*#define	HAS_ASCTIME64		/**/
+
+/* HAS_TIMEGM:
+ *	This symbol, if defined, indicates that the timegm routine is
+ *	available to do the opposite of gmtime ()
  */
-/*#define HAS_TTYNAME_R	   /**/
-#define TTYNAME_R_PROTO 0	   /**/
+/*#define HAS_TIMEGM		/**/
 
 /* U32_ALIGNMENT_REQUIRED:
  *	This symbol, if defined, indicates that you must access
@@ -3220,28 +4022,6 @@
  */
 /*#define HAS_UALARM		/**/
 
-/* HAS_UNION_SEMUN:
- *	This symbol, if defined, indicates that the union semun is
- *	defined by including <sys/sem.h>.  If not, the user code
- *	probably needs to define it as:
- *	union semun {
- *	    int val;
- *	    struct semid_ds *buf;
- *	    unsigned short *array;
- *	}
- */
-/* USE_SEMCTL_SEMUN:
- *	This symbol, if defined, indicates that union semun is
- *	used for semctl IPC_STAT.
- */
-/* USE_SEMCTL_SEMID_DS:
- *	This symbol, if defined, indicates that struct semid_ds * is
- *	used for semctl IPC_STAT.
- */
-#define HAS_UNION_SEMUN	/**/
-/*#define USE_SEMCTL_SEMUN	/**/
-/*#define USE_SEMCTL_SEMID_DS	/**/
-
 /* HAS_UNORDERED:
  *	This symbol, if defined, indicates that the unordered routine is
  *	available to check whether two doubles are unordered
@@ -3269,39 +4049,6 @@
  */
 /*#define HAS_USTAT		/**/
 
-/* HAS_VFORK:
- *	This symbol, if defined, indicates that vfork() exists.
- */
-/*#define HAS_VFORK	/**/
-
-/* HAS_PSEUDOFORK:
- *	This symbol, if defined, indicates that an emulation of the
- *	fork routine is available.
- */
-/*#define HAS_PSEUDOFORK	/**/
-
-/* Signal_t:
- *	This symbol's value is either "void" or "int", corresponding to the
- *	appropriate return type of a signal handler.  Thus, you can declare
- *	a signal handler using "Signal_t (*handler)()", and define the
- *	handler using "Signal_t handler(sig)".
- */
-#define Signal_t void	/* Signal handler's return type */
-
-/* HAS_VPRINTF:
- *	This symbol, if defined, indicates that the vprintf routine is available
- *	to printf with a pointer to an argument list.  If unavailable, you
- *	may need to write your own, probably in terms of _doprnt().
- */
-/* USE_CHAR_VSPRINTF:
- *	This symbol is defined if this system has vsprintf() returning type
- *	(char*).  The trend seems to be to declare it as "int vsprintf()".  It
- *	is up to the package author to declare vsprintf correctly based on the
- *	symbol.
- */
-#define HAS_VPRINTF	/**/
-/*#define USE_CHAR_VSPRINTF 	/**/
-
 /* HAS_WRITEV:
  *	This symbol, if defined, indicates that the writev routine is
  *	available to do scatter writes.
@@ -3314,18 +4061,6 @@
  */
 #define USE_DYNAMIC_LOADING		/**/
 
-/* DOUBLESIZE:
- *	This symbol contains the size of a double, so that the C preprocessor
- *	can make decisions based on it.
- */
-#define DOUBLESIZE 8		/**/
-
-/* EBCDIC:
- *     This symbol, if defined, indicates that this system uses
- *	EBCDIC encoding.
- */
-/*#define	EBCDIC 		/**/
-
 /* FFLUSH_NULL:
  *	This symbol, if defined, tells that fflush(NULL) does flush
  *	all pending stdio output.
@@ -3340,50 +4075,11 @@
 #define	FFLUSH_NULL 		/**/
 /*#define	FFLUSH_ALL 		/**/
 
-/* Fpos_t:
- *	This symbol holds the type used to declare file positions in libc.
- *	It can be fpos_t, long, uint, etc... It may be necessary to include
- *	<sys/types.h> to get any typedef'ed information.
- */
-#define Fpos_t fpos_t		/* File position type */
-
-/* Gid_t_f:
- *	This symbol defines the format string used for printing a Gid_t.
- */
-#define	Gid_t_f		"d"		/**/
-
-/* Gid_t_sign:
- *	This symbol holds the signedess of a Gid_t.
- *	1 for unsigned, -1 for signed.
+/* I_ASSERT:
+ *	This symbol, if defined, indicates that <assert.h> exists and
+ *	could be included by the C program to get the assert() macro.
  */
-#define Gid_t_sign	-1		/* GID sign */
-
-/* Gid_t_size:
- *	This symbol holds the size of a Gid_t in bytes.
- */
-#define Gid_t_size 4		/* GID size */
-
-/* Gid_t:
- *	This symbol holds the return type of getgid() and the type of
- *	argument to setrgid() and related functions.  Typically,
- *	it is the type of group ids in the kernel. It can be int, ushort,
- *	gid_t, etc... It may be necessary to include <sys/types.h> to get
- *	any typedef'ed information.
- */
-#define Gid_t gid_t		/* Type for getgid(), etc... */
-
-/* Groups_t:
- *	This symbol holds the type used for the second argument to
- *	getgroups() and setgroups().  Usually, this is the same as
- *	gidtype (gid_t) , but sometimes it isn't.
- *	It can be int, ushort, gid_t, etc... 
- *	It may be necessary to include <sys/types.h> to get any 
- *	typedef'ed information.  This is only required if you have
- *	getgroups() or setgroups()..
- */
-#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
-#define Groups_t gid_t	/* Type for 2nd arg to [sg]etgroups() */
-#endif
+#define	I_ASSERT		/**/
 
 /* I_CRYPT:
  *	This symbol, if defined, indicates that <crypt.h> exists and
@@ -3433,17 +4129,6 @@
  */
 /*#define	I_FP_CLASS		/**/
 
-/* I_GRP:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <grp.h>.
- */
-/* GRPASSWD:
- *	This symbol, if defined, indicates to the C program that struct group
- *	in <grp.h> contains gr_passwd.
- */
-/*#define I_GRP		/**/
-/*#define GRPASSWD	/**/
-
 /* I_IEEEFP:
  *	This symbol, if defined, indicates that <ieeefp.h> exists and
  *	should be included.
@@ -3468,11 +4153,11 @@
  */
 /*#define	I_LIBUTIL		/**/
 
-/* I_MACH_CTHREADS:
- *     This symbol, if defined, indicates to the C program that it should
- *     include <mach/cthreads.h>.
+/* I_MALLOCMALLOC:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <malloc/malloc.h>.
  */
-/*#define   I_MACH_CTHREADS	/**/
+/*#define I_MALLOCMALLOC		/**/
 
 /* I_MNTENT:
  *	This symbol, if defined, indicates that <mntent.h> exists and
@@ -3480,18 +4165,6 @@
  */
 /*#define	I_MNTENT		/**/
 
-/* I_NDBM:
- *	This symbol, if defined, indicates that <ndbm.h> exists and should
- *	be included.
- */
-/*#define I_NDBM	/**/
-
-/* I_NETDB:
- *	This symbol, if defined, indicates that <netdb.h> exists and
- *	should be included.
- */
-/*#define I_NETDB		/**/
-
 /* I_NETINET_TCP:
  *     This symbol, if defined, indicates to the C program that it should
  *     include <netinet/tcp.h>.
@@ -3510,58 +4183,6 @@
  */
 /*#define	I_PROT		/**/
 
-/* I_PTHREAD:
- *     This symbol, if defined, indicates to the C program that it should
- *     include <pthread.h>.
- */
-/*#define   I_PTHREAD	/**/
-
-/* I_PWD:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <pwd.h>.
- */
-/* PWQUOTA:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_quota.
- */
-/* PWAGE:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_age.
- */
-/* PWCHANGE:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_change.
- */
-/* PWCLASS:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_class.
- */
-/* PWEXPIRE:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_expire.
- */
-/* PWCOMMENT:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_comment.
- */
-/* PWGECOS:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_gecos.
- */
-/* PWPASSWD:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_passwd.
- */
-/*#define I_PWD		/**/
-/*#define PWQUOTA	/**/
-/*#define PWAGE	/**/
-/*#define PWCHANGE	/**/
-/*#define PWCLASS	/**/
-/*#define PWEXPIRE	/**/
-/*#define PWCOMMENT	/**/
-/*#define PWGECOS	/**/
-/*#define PWPASSWD	/**/
-
 /* I_SHADOW:
  *	This symbol, if defined, indicates that <shadow.h> exists and
  *	should be included.
@@ -3609,12 +4230,6 @@
  */
 /*#define	I_SYS_STATVFS		/**/
 
-/* I_SYSUIO:
- *	This symbol, if defined, indicates that <sys/uio.h> exists and
- *	should be included.
- */
-/*#define	I_SYSUIO		/**/
-
 /* I_SYSUTSNAME:
  *	This symbol, if defined, indicates that <sys/utsname.h> exists and
  *	should be included.
@@ -3627,64 +4242,12 @@
  */
 /*#define	I_SYS_VFS		/**/
 
-/* I_TIME:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <time.h>.
- */
-/* I_SYS_TIME:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <sys/time.h>.
- */
-/* I_SYS_TIME_KERNEL:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <sys/time.h> with KERNEL defined.
- */
-/* HAS_TM_TM_ZONE:
- *	This symbol, if defined, indicates to the C program that
- *	the struct tm has a tm_zone field.
- */
-/* HAS_TM_TM_GMTOFF:
- *	This symbol, if defined, indicates to the C program that
- *	the struct tm has a tm_gmtoff field.
- */
-#define I_TIME		/**/
-/*#define I_SYS_TIME		/**/
-/*#define I_SYS_TIME_KERNEL		/**/
-/*#define HAS_TM_TM_ZONE		/**/
-/*#define HAS_TM_TM_GMTOFF		/**/
-
 /* I_USTAT:
  *	This symbol, if defined, indicates that <ustat.h> exists and
  *	should be included.
  */
 /*#define	I_USTAT		/**/
 
-/* I_STDARG:
- *	This symbol, if defined, indicates that <stdarg.h> exists and should
- *	be included.
- */
-/* I_VARARGS:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <varargs.h>.
- */
-#define I_STDARG		/**/
-/*#define I_VARARGS	/**/
-
-/* PERL_INC_VERSION_LIST:
- *	This variable specifies the list of subdirectories in over
- *	which perl.c:incpush() and lib/lib.pm will automatically
- *	search when adding directories to @INC, in a format suitable
- *	for a C initialization string.  See the inc_version_list entry
- *	in Porting/Glossary for more details.
- */
-#define PERL_INC_VERSION_LIST 0		/**/
-
-/* INSTALL_USR_BIN_PERL:
- *	This symbol, if defined, indicates that Perl is to be installed
- * 	also as /usr/bin/perl.
- */
-/*#define INSTALL_USR_BIN_PERL	/**/
-
 /* PERL_PRIfldbl:
  *	This symbol, if defined, contains the string used by stdio to
  *	format long doubles (format 'f') for output.
@@ -3706,82 +4269,12 @@
 /*#define PERL_PRIeldbl	"Le"	/**/
 /*#define PERL_SCNfldbl	"Lf"	/**/
 
-/* Off_t:
- *	This symbol holds the type used to declare offsets in the kernel.
- *	It can be int, long, off_t, etc... It may be necessary to include
- *	<sys/types.h> to get any typedef'ed information.
- */
-/* LSEEKSIZE:
- *	This symbol holds the number of bytes used by the Off_t.
- */
-/* Off_t_size:
- *	This symbol holds the number of bytes used by the Off_t.
- */
-#define Off_t __int64		/* <offset> type */
-#define LSEEKSIZE 8		/* <offset> size */
-#define Off_t_size 8	/* <offset> size */
-
 /* PERL_MAD:
  *	This symbol, if defined, indicates that the Misc Attribution
  *	Declaration code should be conditionally compiled.
  */
 /*#define	PERL_MAD		/**/
 
-/* Free_t:
- *	This variable contains the return type of free().  It is usually
- * void, but occasionally int.
- */
-/* Malloc_t:
- *	This symbol is the type of pointer returned by malloc and realloc.
- */
-#define Malloc_t void *			/**/
-#define Free_t void			/**/
-
-/* PERL_MALLOC_WRAP:
- *	This symbol, if defined, indicates that we'd like malloc wrap checks.
- */
-#define PERL_MALLOC_WRAP		/**/
-
-/* MYMALLOC:
- *	This symbol, if defined, indicates that we're using our own malloc.
- */
-/*#define MYMALLOC			/**/
-
-/* Mode_t:
- *	This symbol holds the type used to declare file modes 
- *	for systems calls.  It is usually mode_t, but may be
- *	int or unsigned short.  It may be necessary to include <sys/types.h>
- *	to get any typedef'ed information.
- */
-#define Mode_t mode_t	 /* file mode parameter for system calls */
-
-/* VAL_O_NONBLOCK:
- *	This symbol is to be used during open() or fcntl(F_SETFL) to turn on
- *	non-blocking I/O for the file descriptor. Note that there is no way
- *	back, i.e. you cannot turn it blocking again this way. If you wish to
- *	alternatively switch between blocking and non-blocking, use the
- *	ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
- */
-/* VAL_EAGAIN:
- *	This symbol holds the errno error code set by read() when no data was
- *	present on the non-blocking file descriptor.
- */
-/* RD_NODATA:
- *	This symbol holds the return code from read() when no data is present
- *	on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
- *	not defined, then you can't distinguish between no data and EOF by
- *	issuing a read(). You'll have to find another way to tell for sure!
- */
-/* EOF_NONBLOCK:
- *	This symbol, if defined, indicates to the C program that a read() on
- *	a non-blocking file descriptor will return 0 on EOF, and not the value
- *	held in RD_NODATA (-1 usually, in that case!).
- */
-#define VAL_O_NONBLOCK O_NONBLOCK
-#define VAL_EAGAIN EAGAIN
-#define RD_NODATA -1
-#define EOF_NONBLOCK
-
 /* NEED_VA_COPY:
  *	This symbol, if defined, indicates that the system stores
  *	the variable argument list datatype, va_list, in a format
@@ -3793,53 +4286,6 @@
  */
 /*#define	NEED_VA_COPY		/**/
 
-/* Netdb_host_t:
- *	This symbol holds the type used for the 1st argument
- *	to gethostbyaddr().
- */
-/* Netdb_hlen_t:
- *	This symbol holds the type used for the 2nd argument
- *	to gethostbyaddr().
- */
-/* Netdb_name_t:
- *	This symbol holds the type used for the argument to
- *	gethostbyname().
- */
-/* Netdb_net_t:
- *	This symbol holds the type used for the 1st argument to
- *	getnetbyaddr().
- */
-#define Netdb_host_t		char * /**/
-#define Netdb_hlen_t		int /**/
-#define Netdb_name_t		char * /**/
-#define Netdb_net_t		long /**/
-
-/* PERL_OTHERLIBDIRS:
- *	This variable contains a colon-separated set of paths for the perl
- *	binary to search for additional library files or modules.
- *	These directories will be tacked to the end of @INC.
- *	Perl will automatically search below each path for version-
- *	and architecture-specific directories.  See PERL_INC_VERSION_LIST
- *	for more details.
- */
-/*#define PERL_OTHERLIBDIRS ""		/**/
-
-/* HAS_QUAD:
- *	This symbol, if defined, tells that there's a 64-bit integer type,
- *	Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one
- *	of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, or QUAD_IS_INT64_T.
- */
-/*#define HAS_QUAD	/**/
-#ifdef HAS_QUAD
-#   define Quad_t __int64	/**/
-#   define Uquad_t unsigned __int64	/**/
-#   define QUADKIND 5	/**/
-#   define QUAD_IS_INT	1
-#   define QUAD_IS_LONG	2
-#   define QUAD_IS_LONG_LONG	3
-#   define QUAD_IS_INT64_T	4
-#endif
-
 /* IVTYPE:
  *	This symbol defines the C type used for Perl's IV.
  */
@@ -3914,7 +4360,13 @@
  *	This symbol contains the number of bits a variable of type NVTYPE
  *	can preserve of a variable of type UVTYPE.
  */
-/* NV_ZERO_IS_ALLBITS_ZERO
+/* NV_OVERFLOWS_INTEGERS_AT:
+ *	This symbol gives the largest integer value that NVs can hold. This
+ *	value + 1.0 cannot be stored accurately. It is expressed as constant
+ *	floating point expression to reduce the chance of decimale/binary
+ *	conversion issues. If it can not be determined, the value 0 is given.
+ */
+/* NV_ZERO_IS_ALLBITS_ZERO:
  *	This symbol, if defined, indicates that a variable of type NVTYPE
  *	stores 0.0 in memory as all bits zero.
  */
@@ -3946,8 +4398,9 @@
 #define	NVSIZE		8		/**/
 #define	NV_PRESERVES_UV
 #define	NV_PRESERVES_UV_BITS	32
-#define NV_ZERO_IS_ALLBITS_ZERO
-#if 4 == 8
+#define	NV_OVERFLOWS_INTEGERS_AT	256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0
+#define	NV_ZERO_IS_ALLBITS_ZERO
+#if UVSIZE == 8
 #   ifdef BYTEORDER
 #       if BYTEORDER == 0x1234
 #           undef BYTEORDER
@@ -4002,77 +4455,6 @@
 #define	NVff		"f"		/**/
 #define	NVgf		"g"		/**/
 
-/* Pid_t:
- *	This symbol holds the type used to declare process ids in the kernel.
- *	It can be int, uint, pid_t, etc... It may be necessary to include
- *	<sys/types.h> to get any typedef'ed information.
- */
-#define Pid_t int		/* PID type */
-
-/* PRIVLIB:
- *	This symbol contains the name of the private library for this package.
- *	The library is private in the sense that it needn't be in anyone's
- *	execution path, but it should be accessible by the world.  The program
- *	should be prepared to do ~ expansion.
- */
-/* PRIVLIB_EXP:
- *	This symbol contains the ~name expanded version of PRIVLIB, to be used
- *	in programs that are not prepared to deal with ~ expansion at run-time.
- */
-#define PRIVLIB "c:\\perl\\5.10.0\\lib"		/**/
-#define PRIVLIB_EXP (win32_get_privlib("5.10.0"))	/**/
-
-/* CAN_PROTOTYPE:
- *	If defined, this macro indicates that the C compiler can handle
- *	function prototypes.
- */
-/* _:
- *	This macro is used to declare function parameters for folks who want
- *	to make declarations with prototypes using a different style than
- *	the above macros.  Use double parentheses.  For example:
- *
- *		int main _((int argc, char *argv[]));
- */
-#define	CAN_PROTOTYPE	/**/
-#ifdef CAN_PROTOTYPE
-#define	_(args) args
-#else
-#define	_(args) ()
-#endif
-
-/* PTRSIZE:
- *	This symbol contains the size of a pointer, so that the C preprocessor
- *	can make decisions based on it.  It will be sizeof(void *) if
- *	the compiler supports (void *); otherwise it will be
- *	sizeof(char *).
- */
-#define PTRSIZE 4		/**/
-
-/* Drand01:
- *	This macro is to be used to generate uniformly distributed
- *	random numbers over the range [0., 1.[.  You may have to supply
- *	an 'extern double drand48();' in your program since SunOS 4.1.3
- *	doesn't provide you with anything relevant in its headers.
- *	See HAS_DRAND48_PROTO.
- */
-/* Rand_seed_t:
- *	This symbol defines the type of the argument of the
- *	random seed function.
- */
-/* seedDrand01:
- *	This symbol defines the macro to be used in seeding the
- *	random number generator (see Drand01).
- */
-/* RANDBITS:
- *	This symbol indicates how many bits are produced by the
- *	function used to generate normalized random numbers.
- *	Values include 15, 16, 31, and 48.
- */
-#define Drand01()		(rand()/(double)((unsigned)1<<RANDBITS))		/**/
-#define Rand_seed_t		unsigned		/**/
-#define seedDrand01(x)	srand((Rand_seed_t)x)	/**/
-#define RANDBITS		15		/**/
-
 /* SELECT_MIN_BITS:
  *	This symbol holds the minimum number of bits operated by select.
  *	That is, if you do select(n, ...), how many bits at least will be
@@ -4082,134 +4464,6 @@
  */
 #define SELECT_MIN_BITS 	32	/**/
 
-/* Select_fd_set_t:
- *	This symbol holds the type used for the 2nd, 3rd, and 4th
- *	arguments to select.  Usually, this is 'fd_set *', if HAS_FD_SET
- *	is defined, and 'int *' otherwise.  This is only useful if you 
- *	have select(), of course.
- */
-#define Select_fd_set_t 	Perl_fd_set *	/**/
-
-/* SH_PATH:
- *	This symbol contains the full pathname to the shell used on this
- *	on this system to execute Bourne shell scripts.  Usually, this will be
- *	/bin/sh, though it's possible that some systems will have /bin/ksh,
- *	/bin/pdksh, /bin/ash, /bin/bash, or even something such as
- *	D:/bin/sh.exe.
- */
-#define SH_PATH "cmd /x /c"  /**/
-
-/* SIG_NAME:
- *	This symbol contains a list of signal names in order of
- *	signal number. This is intended
- *	to be used as a static array initialization, like this:
- *		char *sig_name[] = { SIG_NAME };
- *	The signals in the list are separated with commas, and each signal
- *	is surrounded by double quotes. There is no leading SIG in the signal
- *	name, i.e. SIGQUIT is known as "QUIT".
- *	Gaps in the signal numbers (up to NSIG) are filled in with NUMnn,
- *	etc., where nn is the actual signal number (e.g. NUM37).
- *	The signal number for sig_name[i] is stored in sig_num[i].
- *	The last element is 0 to terminate the list with a NULL.  This
- *	corresponds to the 0 at the end of the sig_name_init list.
- *	Note that this variable is initialized from the sig_name_init,
- *	not from sig_name (which is unused).
- */
-/* SIG_NUM:
- *	This symbol contains a list of signal numbers, in the same order as the
- *	SIG_NAME list. It is suitable for static array initialization, as in:
- *		int sig_num[] = { SIG_NUM };
- *	The signals in the list are separated with commas, and the indices
- *	within that list and the SIG_NAME list match, so it's easy to compute
- *	the signal name from a number or vice versa at the price of a small
- *	dynamic linear lookup. 
- *	Duplicates are allowed, but are moved to the end of the list.
- *	The signal number corresponding to sig_name[i] is sig_number[i].
- *	if (i < NSIG) then sig_number[i] == i.  
- *	The last element is 0, corresponding to the 0 at the end of
- *	the sig_name_init list.
- *	Note that this variable is initialized from the sig_num_init,
- *	not from sig_num (which is unused).
- */
-/* SIG_SIZE:
- *	This variable contains the number of elements of the SIG_NAME
- *	and SIG_NUM arrays, excluding the final NULL entry.
- */
-#define SIG_NAME "ZERO", "HUP", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "USR1", "USR2", "CHLD", "NUM19", "USR3", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0		/**/
-#define SIG_NUM  0, 1, 2, 21, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 18, 0		/**/
-#define SIG_SIZE 27			/**/
-
-/* SITEARCH:
- *	This symbol contains the name of the private library for this package.
- *	The library is private in the sense that it needn't be in anyone's
- *	execution path, but it should be accessible by the world.  The program
- *	should be prepared to do ~ expansion.
- *	The standard distribution will put nothing in this directory.
- *	After perl has been installed, users may install their own local
- *	architecture-dependent modules in this directory with
- *		MakeMaker Makefile.PL
- *	or equivalent.  See INSTALL for details.
- */
-/* SITEARCH_EXP:
- *	This symbol contains the ~name expanded version of SITEARCH, to be used
- *	in programs that are not prepared to deal with ~ expansion at run-time.
- */
-#define SITEARCH "c:\\perl\\site\\5.10.0\\lib\\MSWin32-x86"		/**/
-/*#define SITEARCH_EXP ""	/**/
-
-/* SITELIB:
- *	This symbol contains the name of the private library for this package.
- *	The library is private in the sense that it needn't be in anyone's
- *	execution path, but it should be accessible by the world.  The program
- *	should be prepared to do ~ expansion.
- *	The standard distribution will put nothing in this directory.
- *	After perl has been installed, users may install their own local
- *	architecture-independent modules in this directory with
- *		MakeMaker Makefile.PL
- *	or equivalent.  See INSTALL for details.
- */
-/* SITELIB_EXP:
- *	This symbol contains the ~name expanded version of SITELIB, to be used
- *	in programs that are not prepared to deal with ~ expansion at run-time.
- */
-/* SITELIB_STEM:
- *	This define is SITELIB_EXP with any trailing version-specific component
- *	removed.  The elements in inc_version_list (inc_version_list.U) can
- *	be tacked onto this variable to generate a list of directories to search.
- */
-#define SITELIB "c:\\perl\\site\\5.10.0\\lib"		/**/
-#define SITELIB_EXP (win32_get_sitelib("5.10.0"))	/**/
-#define SITELIB_STEM ""		/**/
-
-/* Size_t_size:
- *	This symbol holds the size of a Size_t in bytes.
- */
-#define Size_t_size 4		/**/
-
-/* Size_t:
- *	This symbol holds the type used to declare length parameters
- *	for string functions.  It is usually size_t, but may be
- *	unsigned long, int, etc.  It may be necessary to include
- *	<sys/types.h> to get any typedef'ed information.
- */
-#define Size_t size_t	 /* length paramater for string functions */
-
-/* Sock_size_t:
- *	This symbol holds the type used for the size argument of
- *	various socket calls (just the base type, not the pointer-to).
- */
-#define Sock_size_t		int /**/
-
-/* SSize_t:
- *	This symbol holds the type used by functions that return
- *	a count of bytes or an error condition.  It must be a signed type.
- *	It is usually ssize_t, but may be long or int, etc.
- *	It may be necessary to include <sys/types.h> or <unistd.h>
- *	to get any typedef'ed information.
- *	We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
- */
-#define SSize_t int	 /* signed count of bytes */
-
 /* STARTPERL:
  *	This variable contains the string to put in front of a perl
  *	script to make sure (one hopes) that it runs with perl and not
@@ -4217,12 +4471,6 @@
  */
 #define STARTPERL "#!perl"		/**/
 
-/* STDCHAR:
- *	This symbol is defined to be the type of char used in stdio.h.
- *	It has the values "unsigned char" or "char".
- */
-#define STDCHAR unsigned char	/**/
-
 /* HAS_STDIO_STREAM_ARRAY:
  *	This symbol, if defined, tells that there is an array
  *	holding the stdio streams.
@@ -4232,30 +4480,30 @@
  *	Usual values include _iob, __iob, and __sF.
  */
 /*#define	HAS_STDIO_STREAM_ARRAY	/**/
+#ifdef HAS_STDIO_STREAM_ARRAY
 #define STDIO_STREAM_ARRAY	
+#endif
 
-/* Uid_t_f:
- *	This symbol defines the format string used for printing a Uid_t.
+/* GMTIME_MAX:
+ *	This symbol contains the maximum value for the time_t offset that
+ *	the system function gmtime () accepts, and defaults to 0
  */
-#define	Uid_t_f		"d"		/**/
-
-/* Uid_t_sign:
- *	This symbol holds the signedess of a Uid_t.
- *	1 for unsigned, -1 for signed.
+/* GMTIME_MIN:
+ *	This symbol contains the minimum value for the time_t offset that
+ *	the system function gmtime () accepts, and defaults to 0
  */
-#define Uid_t_sign	-1		/* UID sign */
-
-/* Uid_t_size:
- *	This symbol holds the size of a Uid_t in bytes.
+/* LOCALTIME_MAX:
+ *	This symbol contains the maximum value for the time_t offset that
+ *	the system function localtime () accepts, and defaults to 0
  */
-#define Uid_t_size 4		/* UID size */
-
-/* Uid_t:
- *	This symbol holds the type used to declare user ids in the kernel.
- *	It can be int, ushort, uid_t, etc... It may be necessary to include
- *	<sys/types.h> to get any typedef'ed information.
+/* LOCALTIME_MIN:
+ *	This symbol contains the minimum value for the time_t offset that
+ *	the system function localtime () accepts, and defaults to 0
  */
-#define Uid_t uid_t		/* UID type */
+#define GMTIME_MAX		2147483647	/**/
+#define GMTIME_MIN		0	/**/
+#define LOCALTIME_MAX	2147483647	/**/
+#define LOCALTIME_MIN	0	/**/
 
 /* USE_64_BIT_INT:
  *	This symbol, if defined, indicates that 64-bit integers should
@@ -4278,18 +4526,23 @@
 #ifndef USE_64_BIT_INT
 /*#define	USE_64_BIT_INT		/**/
 #endif
-
 #ifndef USE_64_BIT_ALL
 /*#define	USE_64_BIT_ALL		/**/
 #endif
 
+/* USE_DTRACE:
+ *	This symbol, if defined, indicates that Perl should
+ *	be built with support for DTrace.
+ */
+/*#define USE_DTRACE		/**/
+
 /* USE_FAST_STDIO:
  *	This symbol, if defined, indicates that Perl should
  *	be built to use 'fast stdio'.
  *	Defaults to define in Perls 5.8 and earlier, to undef later.
  */
 #ifndef USE_FAST_STDIO
-/*#define	USE_FAST_STDIO		/ **/
+/*#define	USE_FAST_STDIO		/**/
 #endif
 
 /* USE_LARGE_FILES:
@@ -4341,91 +4594,4 @@
 /*#define	USE_SOCKS		/**/
 #endif
 
-/* USE_ITHREADS:
- *	This symbol, if defined, indicates that Perl should be built to
- *	use the interpreter-based threading implementation.
- */
-/* USE_5005THREADS:
- *	This symbol, if defined, indicates that Perl should be built to
- *	use the 5.005-based threading implementation.
- */
-/* OLD_PTHREADS_API:
- *	This symbol, if defined, indicates that Perl should
- *	be built to use the old draft POSIX threads API.
- */
-/* USE_REENTRANT_API:
- *	This symbol, if defined, indicates that Perl should
- *	try to use the various _r versions of library functions.
- *	This is extremely experimental.
- */
-/*#define	USE_5005THREADS		/**/
-/*#define	USE_ITHREADS		/**/
-#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
-#define		USE_THREADS		/* until src is revised*/
-#endif
-/*#define	OLD_PTHREADS_API		/**/
-/*#define	USE_REENTRANT_API	/**/
-
-/* PERL_VENDORARCH:
- *	If defined, this symbol contains the name of a private library.
- *	The library is private in the sense that it needn't be in anyone's
- *	execution path, but it should be accessible by the world.
- *	It may have a ~ on the front.
- *	The standard distribution will put nothing in this directory.
- *	Vendors who distribute perl may wish to place their own
- *	architecture-dependent modules and extensions in this directory with
- *		MakeMaker Makefile.PL INSTALLDIRS=vendor
- *	or equivalent.  See INSTALL for details.
- */
-/* PERL_VENDORARCH_EXP:
- *	This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used
- *	in programs that are not prepared to deal with ~ expansion at run-time.
- */
-/*#define PERL_VENDORARCH ""		/**/
-/*#define PERL_VENDORARCH_EXP ""		/**/
-
-/* PERL_VENDORLIB_EXP:
- *	This symbol contains the ~name expanded version of VENDORLIB, to be used
- *	in programs that are not prepared to deal with ~ expansion at run-time.
- */
-/* PERL_VENDORLIB_STEM:
- *	This define is PERL_VENDORLIB_EXP with any trailing version-specific component
- *	removed.  The elements in inc_version_list (inc_version_list.U) can
- *	be tacked onto this variable to generate a list of directories to search.
- */
-/*#define PERL_VENDORLIB_EXP ""		/**/
-/*#define PERL_VENDORLIB_STEM ""		/**/
-
-/* VOIDFLAGS:
- *	This symbol indicates how much support of the void type is given by this
- *	compiler.  What various bits mean:
- *
- *	    1 = supports declaration of void
- *	    2 = supports arrays of pointers to functions returning void
- *	    4 = supports comparisons between pointers to void functions and
- *		    addresses of void functions
- *	    8 = suports declaration of generic void pointers
- *
- *	The package designer should define VOIDUSED to indicate the requirements
- *	of the package.  This can be done either by #defining VOIDUSED before
- *	including config.h, or by defining defvoidused in Myinit.U.  If the
- *	latter approach is taken, only those flags will be tested.  If the
- *	level of void support necessary is not present, defines void to int.
- */
-#ifndef VOIDUSED
-#define VOIDUSED 15
-#endif
-#define VOIDFLAGS 15
-#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
-#define void int		/* is void to be avoided? */
-#define M_VOID			/* Xenix strikes again */
-#endif
-
-/* HAS_POLL:
- *	This symbol, if defined, indicates that the poll routine is
- *	available to poll active file descriptors. You may safely
- *	include <poll.h> when both this symbol *and* I_POLL are defined.
- */
-/*#define HAS_POLL		/**/
-
 #endif
diff --git a/gnu/usr.bin/perl/win32/config_H.gc b/gnu/usr.bin/perl/win32/config_H.gc
index 40da26cf844..12c22151164 100644
--- a/gnu/usr.bin/perl/win32/config_H.gc
+++ b/gnu/usr.bin/perl/win32/config_H.gc
@@ -7,14 +7,14 @@
  * that running config_h.SH again will wipe out any changes you've made.
  * For a more permanent change edit undef and rerun config_h.SH.
  *
- * $Id: Config_h.U,v 3.0.1.5 1997/02/28 14:57:43 ram Exp $
+ * $Id: Config_h.U 1 2006-08-24 12:32:52Z rmanfredi $
  */
 
 /*
  * Package name      : perl5
  * Source directory  : 
- * Configuration time: Mon Mar 17 20:15:35 2003
- * Configured by     : gsar
+ * Configuration time: Fri Dec 12 15:41:26 2008
+ * Configured by     : shay
  * Target system     : 
  */
 
@@ -68,16 +68,11 @@
  */
 #define	HAS_CHSIZE		/**/
 
-/* HASCONST:
- *	This symbol, if defined, indicates that this C compiler knows about
- *	the const type. There is no need to actually test for that symbol
- *	within your programs. The mere use of the "const" keyword will
- *	trigger the necessary tests.
+/* HAS_CRYPT:
+ *	This symbol, if defined, indicates that the crypt routine is available
+ *	to encrypt passwords and the like.
  */
-#define HASCONST	/**/
-#ifndef HASCONST
-#define const
-#endif
+/*#define HAS_CRYPT		/**/
 
 /* HAS_CTERMID:
  *	This symbol, if defined, indicates that the ctermid routine is
@@ -112,6 +107,26 @@
  */
 #define HAS_DLERROR	/**/
 
+/* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ *	This symbol, if defined, indicates that the bug that prevents
+ *	setuid scripts from being secure is not present in this kernel.
+ */
+/* DOSUID:
+ *	This symbol, if defined, indicates that the C program should
+ *	check the script that it is executing for setuid/setgid bits, and
+ *	attempt to emulate setuid/setgid on systems that have disabled
+ *	setuid #! scripts because the kernel can't do it securely.
+ *	It is up to the package designer to make sure that this emulation
+ *	is done securely.  Among other things, it should do an fstat on
+ *	the script it just opened to make sure it really is a setuid/setgid
+ *	script, it should make sure the arguments passed correspond exactly
+ *	to the argument on the #! line, and it should not trust any
+ *	subprocesses to which it must pass the filename rather than the
+ *	file descriptor of the script to be executed.
+ */
+/*#define SETUID_SCRIPTS_ARE_SECURE_NOW	/**/
+/*#define DOSUID		/**/
+
 /* HAS_DUP2:
  *	This symbol, if defined, indicates that the dup2 routine is
  *	available to duplicate file descriptors.
@@ -355,6 +370,13 @@
  */
 #define HAS_PIPE		/**/
 
+/* HAS_POLL:
+ *	This symbol, if defined, indicates that the poll routine is
+ *	available to poll active file descriptors.  Please check I_POLL and
+ *	I_SYS_POLL to know which header should be included as well.
+ */
+/*#define HAS_POLL		/**/
+
 /* HAS_READDIR:
  *	This symbol, if defined, indicates that the readdir routine is
  *	available to read directory entries. You may have to include
@@ -419,6 +441,13 @@
  */
 /*#define HAS_SETEUID		/**/
 
+/* HAS_SETGROUPS:
+ *	This symbol, if defined, indicates that the setgroups() routine is
+ *	available to set the list of process groups.  If unavailable, multiple
+ *	groups are probably not supported.
+ */
+/*#define HAS_SETGROUPS		/**/
+
 /* HAS_SETLINEBUF:
  *	This symbol, if defined, indicates that the setlinebuf routine is
  *	available to change stderr or stdout from block-buffered or unbuffered
@@ -512,13 +541,6 @@
  */
 #define HAS_STRCOLL	/**/
 
-/* USE_STRUCT_COPY:
- *	This symbol, if defined, indicates that this C compiler knows how
- *	to copy structures.  If undefined, you'll need to use a block copy
- *	routine of some sort instead.
- */
-#define	USE_STRUCT_COPY	/**/
-
 /* HAS_STRTOD:
  *	This symbol, if defined, indicates that the strtod routine is
  *	available to provide better numeric string conversion than atof().
@@ -597,15 +619,6 @@
  */
 /*#define HAS_USLEEP		/**/
 
-/* HASVOLATILE:
- *	This symbol, if defined, indicates that this C compiler knows about
- *	the volatile declaration.
- */
-#define	HASVOLATILE	/**/
-#ifndef HASVOLATILE
-#define volatile
-#endif
-
 /* HAS_WAIT4:
  *	This symbol, if defined, indicates that wait4() exists.
  */
@@ -629,6 +642,19 @@
  */
 #define HAS_WCTOMB		/**/
 
+/* Groups_t:
+ *	This symbol holds the type used for the second argument to
+ *	getgroups() and setgroups().  Usually, this is the same as
+ *	gidtype (gid_t) , but sometimes it isn't.
+ *	It can be int, ushort, gid_t, etc... 
+ *	It may be necessary to include <sys/types.h> to get any 
+ *	typedef'ed information.  This is only required if you have
+ *	getgroups() or setgroups()..
+ */
+#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
+#define Groups_t gid_t	/* Type for 2nd arg to [sg]etgroups() */
+#endif
+
 /* I_ARPA_INET:
  *	This symbol, if defined, indicates to the C program that it should
  *	include <arpa/inet.h> to get inet_addr and friends declarations.
@@ -646,26 +672,6 @@
 /*#define I_DBM	/**/
 #define I_RPCSVC_DBM	/**/
 
-/* I_DIRENT:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <dirent.h>. Using this symbol also triggers the definition
- *	of the Direntry_t define which ends up being 'struct dirent' or
- *	'struct direct' depending on the availability of <dirent.h>.
- */
-/* DIRNAMLEN:
- *	This symbol, if defined, indicates to the C program that the length
- *	of directory entry names is provided by a d_namlen field.  Otherwise
- *	you need to do strlen() on the d_name field.
- */
-/* Direntry_t:
- *	This symbol is set to 'struct direct' or 'struct dirent' depending on
- *	whether dirent is available or not. You should use this pseudo type to
- *	portably declare your directory entries.
- */
-#define I_DIRENT		/**/
-#define DIRNAMLEN	/**/
-#define Direntry_t struct direct
-
 /* I_DLFCN:
  *	This symbol, if defined, indicates that <dlfcn.h> exists and should
  *	be included.
@@ -684,6 +690,12 @@
  */
 #define I_FLOAT		/**/
 
+/* I_GDBM:
+ *	This symbol, if defined, indicates that <gdbm.h> exists and should
+ *	be included.
+ */
+/*#define I_GDBM	/**/
+
 /* I_LIMITS:
  *	This symbol, if defined, indicates to the C program that it should
  *	include <limits.h> to get definition of symbols like WORD_BIT or
@@ -709,12 +721,6 @@
  */
 /*#define I_MEMORY		/**/
 
-/* I_NET_ERRNO:
- *	This symbol, if defined, indicates that <net/errno.h> exists and 
- *	should be included.
- */
-/*#define I_NET_ERRNO		/**/
-
 /* I_NETINET_IN:
  *	This symbol, if defined, indicates to the C program that it should
  *	include <netinet/in.h>. Otherwise, you may try <sys/in.h>.
@@ -780,6 +786,13 @@
  */
 /*#define I_SYS_PARAM		/**/
 
+/* I_SYS_POLL:
+ *	This symbol, if defined, indicates that the program may include
+ *	<sys/poll.h>.  When I_POLL is also defined, it's probably safest
+ *	to only include <poll.h>.
+ */
+/*#define I_SYS_POLL	/**/
+
 /* I_SYS_RESOURCE:
  *	This symbol, if defined, indicates to the C program that it should
  *	include <sys/resource.h>.
@@ -868,40 +881,53 @@
  */
 /*#define I_VFORK	/**/
 
-/* HAS_ACCESSX:
- *	This symbol, if defined, indicates that the accessx routine is
- *	available to do extended access checks.
+/* INTSIZE:
+ *	This symbol contains the value of sizeof(int) so that the C
+ *	preprocessor can make decisions based on it.
  */
-/*#define HAS_ACCESSX		/**/
-
-/* HAS_EACCESS:
- *	This symbol, if defined, indicates that the eaccess routine is
- *	available to do extended access checks.
+/* LONGSIZE:
+ *	This symbol contains the value of sizeof(long) so that the C
+ *	preprocessor can make decisions based on it.
  */
-/*#define HAS_EACCESS		/**/
-
-/* I_SYS_ACCESS:
- *     This symbol, if defined, indicates to the C program that it should
- *     include <sys/access.h>.
+/* SHORTSIZE:
+ *	This symbol contains the value of sizeof(short) so that the C
+ *	preprocessor can make decisions based on it.
  */
-/*#define   I_SYS_ACCESS                /**/
+#define INTSIZE 4		/**/
+#define LONGSIZE 4		/**/
+#define SHORTSIZE 2		/**/
 
-/* I_SYS_SECURITY:
- *     This symbol, if defined, indicates to the C program that it should
- *     include <sys/security.h>.
+/* MULTIARCH:
+ *	This symbol, if defined, signifies that the build
+ *	process will produce some binary files that are going to be
+ *	used in a cross-platform environment.  This is the case for
+ *	example with the NeXT "fat" binaries that contain executables
+ *	for several CPUs.
  */
-/*#define   I_SYS_SECURITY	/**/
+/*#define MULTIARCH		/**/
 
-/* USE_CROSS_COMPILE:
- *	This symbol, if defined, indicates that Perl is being cross-compiled.
- */
-/* PERL_TARGETARCH:
- *	This symbol, if defined, indicates the target architecture
- *	Perl has been cross-compiled to.  Undefined if not a cross-compile.
+/* HAS_QUAD:
+ *	This symbol, if defined, tells that there's a 64-bit integer type,
+ *	Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one
+ *	of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, QUAD_IS_INT64_T,
+ *	or QUAD_IS___INT64.
  */
-#ifndef USE_CROSS_COMPILE
-/*#define	USE_CROSS_COMPILE	/**/
-#define	PERL_TARGETARCH	""	/**/
+#define HAS_QUAD	/**/
+#ifdef HAS_QUAD
+#   ifndef _MSC_VER
+#	define Quad_t long long	/**/
+#	define Uquad_t unsigned long long	/**/
+#	define QUADKIND 3	/**/
+#   else
+#	define Quad_t __int64	/**/
+#	define Uquad_t unsigned __int64	/**/
+#	define QUADKIND 5	/**/
+#   endif
+#   define QUAD_IS_INT	1
+#   define QUAD_IS_LONG	2
+#   define QUAD_IS_LONG_LONG	3
+#   define QUAD_IS_INT64_T	4
+#   define QUAD_IS___INT64	5
 #endif
 
 /* OSNAME:
@@ -915,27 +941,7 @@
  *	feature tests from Configure are generally more reliable.
  */
 #define OSNAME "MSWin32"		/**/
-#define OSVERS "4.0"		/**/
-
-/* MULTIARCH:
- *	This symbol, if defined, signifies that the build
- *	process will produce some binary files that are going to be
- *	used in a cross-platform environment.  This is the case for
- *	example with the NeXT "fat" binaries that contain executables
- *	for several CPUs.
- */
-/*#define MULTIARCH		/**/
-
-/* MEM_ALIGNBYTES:
- *	This symbol contains the number of bytes required to align a
- *	double, or a long double when applicable. Usual values are 2,
- *	4 and 8. The default is eight, for safety.
- */
-#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH)
-#  define MEM_ALIGNBYTES 8
-#else
-#define MEM_ALIGNBYTES 8
-#endif
+#define OSVERS "5.1"		/**/
 
 /* ARCHLIB:
  *	This variable, if defined, holds the name of the directory in
@@ -950,7 +956,7 @@
  *	This symbol contains the ~name expanded version of ARCHLIB, to be used
  *	in programs that are not prepared to deal with ~ expansion at run-time.
  */
-#define ARCHLIB "c:\\perl\\5.10.0\\lib\\MSWin32-x86"		/**/
+#define ARCHLIB "c:\\perl\\lib"		/**/
 /*#define ARCHLIB_EXP ""	/**/
 
 /* ARCHNAME:
@@ -961,18 +967,6 @@
  */
 #define ARCHNAME "MSWin32-x86"		/**/
 
-/* HAS_ATOLF:
- *	This symbol, if defined, indicates that the atolf routine is
- *	available to convert strings into long doubles.
- */
-/*#define HAS_ATOLF		/**/
-
-/* HAS_ATOLL:
- *	This symbol, if defined, indicates that the atoll routine is
- *	available to convert strings into long longs.
- */
-/*#define HAS_ATOLL		/**/
-
 /* BIN:
  *	This symbol holds the path of the bin directory where the package will
  *	be installed. Program must be prepared to deal with ~name substitution.
@@ -985,68 +979,9 @@
  *	This symbol, if defined, indicates that we'd like to relocate entries
  *	in @INC at run time based on the location of the perl binary.
  */
-#define BIN "c:\\perl\\5.10.0\\bin\\MSWin32-x86"	/**/
-#define BIN_EXP "c:\\perl\\5.10.0\\bin\\MSWin32-x86"	/**/
-/*#define PERL_RELOCATABLE_INC "" 		/**/
-
-/* INTSIZE:
- *	This symbol contains the value of sizeof(int) so that the C
- *	preprocessor can make decisions based on it.
- */
-/* LONGSIZE:
- *	This symbol contains the value of sizeof(long) so that the C
- *	preprocessor can make decisions based on it.
- */
-/* SHORTSIZE:
- *	This symbol contains the value of sizeof(short) so that the C
- *	preprocessor can make decisions based on it.
- */
-#define INTSIZE 4		/**/
-#define LONGSIZE 4		/**/
-#define SHORTSIZE 2		/**/
-
-/* BYTEORDER:
- *	This symbol holds the hexadecimal constant defined in byteorder,
- *	in a UV, i.e. 0x1234 or 0x4321 or 0x12345678, etc...
- *	If the compiler supports cross-compiling or multiple-architecture
- *	binaries (eg. on NeXT systems), use compiler-defined macros to
- *	determine the byte order.
- *	On NeXT 3.2 (and greater), you can build "Fat" Multiple Architecture
- *	Binaries (MAB) on either big endian or little endian machines.
- *	The endian-ness is available at compile-time.  This only matters
- *	for perl, where the config.h can be generated and installed on 
- *	one system, and used by a different architecture to build an
- *	extension.  Older versions of NeXT that might not have
- *	defined either *_ENDIAN__ were all on Motorola 680x0 series,
- *	so the default case (for NeXT) is big endian to catch them. 
- *	This might matter for NeXT 3.0.
- */
-#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH)
-#  ifdef __LITTLE_ENDIAN__
-#    if LONGSIZE == 4
-#      define BYTEORDER 0x1234
-#    else
-#      if LONGSIZE == 8
-#        define BYTEORDER 0x12345678
-#      endif
-#    endif
-#  else
-#    ifdef __BIG_ENDIAN__
-#      if LONGSIZE == 4
-#        define BYTEORDER 0x4321
-#      else
-#        if LONGSIZE == 8
-#          define BYTEORDER 0x87654321
-#        endif
-#      endif
-#    endif
-#  endif
-#  if !defined(BYTEORDER) && (defined(NeXT) || defined(__NeXT__))
-#    define BYTEORDER 0x4321
-#  endif
-#else
-#define BYTEORDER 0x1234	/* large digits for MSB */
-#endif /* NeXT */
+#define BIN "c:\\perl\\bin"	/**/
+#define BIN_EXP "c:\\perl\\bin"	/**/
+#define PERL_RELOCATABLE_INC "undef" 		/**/
 
 /* CAT2:
  *	This macro concatenates 2 tokens together.
@@ -1057,19 +992,16 @@
 #if 42 == 1
 #define CAT2(a,b)	a/**/b
 #define STRINGIFY(a)	"a"
-		/* If you can get stringification with catify, tell me how! */
 #endif
 #if 42 == 42
-#define PeRl_CaTiFy(a, b)	a ## b	
+#define PeRl_CaTiFy(a, b)	a ## b
 #define PeRl_StGiFy(a)	#a
-/* the additional level of indirection enables these macros to be
- * used as arguments to other macros.  See K&R 2nd ed., page 231. */
 #define CAT2(a,b)	PeRl_CaTiFy(a,b)
 #define StGiFy(a)	PeRl_StGiFy(a)
 #define STRINGIFY(a)	PeRl_StGiFy(a)
 #endif
 #if 42 != 1 && 42 != 42
-#   include "Bletch: How does this C preprocessor concatenate tokens?"
+#include "Bletch: How does this C preprocessor concatenate tokens?"
 #endif
 
 /* CPPSTDIN:
@@ -1108,12 +1040,6 @@
 #endif
 #define CPPLAST ""
 
-/* HAS__FWALK:
- *	This symbol, if defined, indicates that the _fwalk system call is
- *	available to apply a function to all the file handles.
- */
-/*#define HAS__FWALK		/**/
-
 /* HAS_ACCESS:
  *	This manifest constant lets the C program know that the access()
  *	system call is available to check for accessibility using real UID/GID.
@@ -1121,11 +1047,11 @@
  */
 #define HAS_ACCESS		/**/
 
-/* HAS_AINTL:
- *	This symbol, if defined, indicates that the aintl routine is
- *	available.  If copysignl is also present we can emulate modfl.
+/* HAS_ACCESSX:
+ *	This symbol, if defined, indicates that the accessx routine is
+ *	available to do extended access checks.
  */
-/*#define HAS_AINTL		/ **/
+/*#define HAS_ACCESSX		/**/
 
 /* HAS_ASCTIME_R:
  *	This symbol, if defined, indicates that the asctime_r routine
@@ -1165,110 +1091,33 @@
 /* HASATTRIBUTE_UNUSED:
  *	Can we handle GCC attribute for unused variables and arguments
  */
+/* HASATTRIBUTE_DEPRECATED:
+ *	Can we handle GCC attribute for marking deprecated APIs
+ */
 /* HASATTRIBUTE_WARN_UNUSED_RESULT:
  *	Can we handle GCC attribute for warning on unused results
  */
+/*#define HASATTRIBUTE_DEPRECATED	/**/
 /*#define HASATTRIBUTE_FORMAT	/**/
 /*#define PRINTF_FORMAT_NULL_OK	/**/
+/*#define HASATTRIBUTE_NORETURN	/**/
 /*#define HASATTRIBUTE_MALLOC	/**/
 /*#define HASATTRIBUTE_NONNULL	/**/
-/*#define HASATTRIBUTE_NORETURN	/**/
 /*#define HASATTRIBUTE_PURE	/**/
 /*#define HASATTRIBUTE_UNUSED	/**/
 /*#define HASATTRIBUTE_WARN_UNUSED_RESULT	/**/
 
-/* HAS_BUILTIN_CHOOSE_EXPR:
- *	Can we handle GCC builtin for compile-time ternary-like expressions
- */
-/* HAS_BUILTIN_EXPECT:
- *	Can we handle GCC builtin for telling that certain values are more
- *	likely
- */
-/*#define HAS_BUILTIN_EXPECT    / **/
-/*#define HAS_BUILTIN_CHOOSE_EXPR /**/
-
-/* HAS_C99_VARIADIC_MACROS:
- *	If defined, the compiler supports C99 variadic macros.
- */
-/*#define HAS_C99_VARIADIC_MACROS	/**/
-
-/* CASTI32:
- *	This symbol is defined if the C compiler can cast negative
- *	or large floating point numbers to 32-bit ints.
+/* HASCONST:
+ *	This symbol, if defined, indicates that this C compiler knows about
+ *	the const type. There is no need to actually test for that symbol
+ *	within your programs. The mere use of the "const" keyword will
+ *	trigger the necessary tests.
  */
-#ifndef _MSC_VER
-#   define	CASTI32		/**/
+#define HASCONST	/**/
+#ifndef HASCONST
+#define const
 #endif
 
-/* CASTNEGFLOAT:
- *	This symbol is defined if the C compiler can cast negative
- *	numbers to unsigned longs, ints and shorts.
- */
-/* CASTFLAGS:
- *	This symbol contains flags that say what difficulties the compiler
- *	has casting odd floating values to unsigned long:
- *		0 = ok
- *		1 = couldn't cast < 0
- *		2 = couldn't cast >= 0x80000000
- *		4 = couldn't cast in argument expression list
- */
-#define	CASTNEGFLOAT		/**/
-#define CASTFLAGS 0		/**/
-
-/* HAS_CLASS:
- *	This symbol, if defined, indicates that the class routine is
- *	available to classify doubles.  Available for example in AIX.
- *	The returned values are defined in <float.h> and are:
- *
- *	FP_PLUS_NORM	Positive normalized, nonzero
- *	FP_MINUS_NORM	Negative normalized, nonzero
- *	FP_PLUS_DENORM	Positive denormalized, nonzero
- *	FP_MINUS_DENORM	Negative denormalized, nonzero
- *	FP_PLUS_ZERO	+0.0
- *	FP_MINUS_ZERO	-0.0
- *	FP_PLUS_INF	+INF
- *	FP_MINUS_INF	-INF
- *	FP_NANS		Signaling Not a Number (NaNS)
- *	FP_NANQ		Quiet Not a Number (NaNQ)
- */
-/*#define HAS_CLASS		/**/
-
-/* HAS_CLEARENV:
- *	This symbol, if defined, indicates that the clearenv () routine is
- *	available for use.
- */
-/*#define HAS_CLEARENV		/**/
-
-/* VOID_CLOSEDIR:
- *	This symbol, if defined, indicates that the closedir() routine
- *	does not return a value.
- */
-/*#define VOID_CLOSEDIR		/**/
-
-/* HAS_STRUCT_CMSGHDR:
- *	This symbol, if defined, indicates that the struct cmsghdr
- *	is supported.
- */
-/*#define HAS_STRUCT_CMSGHDR	/**/
-
-/* HAS_COPYSIGNL:
- *	This symbol, if defined, indicates that the copysignl routine is
- *	available.  If aintl is also present we can emulate modfl.
- */
-/*#define HAS_COPYSIGNL		/**/
-
-/* USE_CPLUSPLUS:
- *	This symbol, if defined, indicates that a C++ compiler was
- *	used to compiled Perl and will be used to compile extensions.
- */
-/*#define USE_CPLUSPLUS		/**/
-
-/* HAS_CRYPT:
- *	This symbol, if defined, indicates that the crypt routine is available
- *	to encrypt passwords and the like.
- */
-/*#define HAS_CRYPT		/**/
-
 /* HAS_CRYPT_R:
  *	This symbol, if defined, indicates that the crypt_r routine
  *	is available to crypt re-entrantly.
@@ -1319,48 +1168,6 @@
 /*#define HAS_CTIME_R	   /**/
 #define CTIME_R_PROTO 0	   /**/
 
-/* HAS_DBMINIT_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the dbminit() function.  Otherwise, it is up
- *	to the program to supply one.  A good guess is
- *		extern int dbminit(char *);
- */
-/*#define	HAS_DBMINIT_PROTO	/**/
-
-/* HAS_DIRFD:
- *	This manifest constant lets the C program know that dirfd
- *	is available.
- */
-/*#define HAS_DIRFD		/**/
-
-/* DLSYM_NEEDS_UNDERSCORE:
- *	This symbol, if defined, indicates that we need to prepend an
- *	underscore to the symbol name before calling dlsym().  This only
- *	makes sense if you *have* dlsym, which we will presume is the
- *	case if you're using dl_dlopen.xs.
- */
-/*#define 	DLSYM_NEEDS_UNDERSCORE 	/**/
-
-/* SETUID_SCRIPTS_ARE_SECURE_NOW:
- *	This symbol, if defined, indicates that the bug that prevents
- *	setuid scripts from being secure is not present in this kernel.
- */
-/* DOSUID:
- *	This symbol, if defined, indicates that the C program should
- *	check the script that it is executing for setuid/setgid bits, and
- *	attempt to emulate setuid/setgid on systems that have disabled
- *	setuid #! scripts because the kernel can't do it securely.
- *	It is up to the package designer to make sure that this emulation
- *	is done securely.  Among other things, it should do an fstat on
- *	the script it just opened to make sure it really is a setuid/setgid
- *	script, it should make sure the arguments passed correspond exactly
- *	to the argument on the #! line, and it should not trust any
- *	subprocesses to which it must pass the filename rather than the
- *	file descriptor of the script to be executed.
- */
-/*#define SETUID_SCRIPTS_ARE_SECURE_NOW	/**/
-/*#define DOSUID		/**/
-
 /* HAS_DRAND48_R:
  *	This symbol, if defined, indicates that the drand48_r routine
  *	is available to drand48 re-entrantly.
@@ -1382,6 +1189,12 @@
  */
 /*#define	HAS_DRAND48_PROTO	/**/
 
+/* HAS_EACCESS:
+ *	This symbol, if defined, indicates that the eaccess routine is
+ *	available to do extended access checks.
+ */
+/*#define HAS_EACCESS		/**/
+
 /* HAS_ENDGRENT:
  *	This symbol, if defined, indicates that the getgrent routine is
  *	available for finalizing sequential access of the group database.
@@ -1496,210 +1309,12 @@
 /*#define HAS_ENDSERVENT_R	   /**/
 #define ENDSERVENT_R_PROTO 0	   /**/
 
-/* HAS_FAST_STDIO:
- *	This symbol, if defined, indicates that the "fast stdio"
- *	is available to manipulate the stdio buffers directly.
- */
-#define HAS_FAST_STDIO		/**/
-
-/* HAS_FCHDIR:
- *	This symbol, if defined, indicates that the fchdir routine is
- *	available to change directory using a file descriptor.
- */
-/*#define HAS_FCHDIR		/**/
-
-/* FCNTL_CAN_LOCK:
- *	This symbol, if defined, indicates that fcntl() can be used
- *	for file locking.  Normally on Unix systems this is defined.
- *	It may be undefined on VMS.
- */
-/*#define FCNTL_CAN_LOCK		/**/
-
-/* HAS_FD_SET:
- *	This symbol, when defined, indicates presence of the fd_set typedef
- *	in <sys/types.h>
- */
-#define HAS_FD_SET	/**/
-
-/* HAS_FINITE:
- *	This symbol, if defined, indicates that the finite routine is
- *	available to check whether a double is finite (non-infinity non-NaN).
- */
-/*#define HAS_FINITE		/**/
-
-/* HAS_FINITEL:
- *	This symbol, if defined, indicates that the finitel routine is
- *	available to check whether a long double is finite
- *	(non-infinity non-NaN).
- */
-/*#define HAS_FINITEL		/**/
-
 /* FLEXFILENAMES:
  *	This symbol, if defined, indicates that the system supports filenames
  *	longer than 14 characters.
  */
 #define	FLEXFILENAMES		/**/
 
-/* HAS_FLOCK_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the flock() function.  Otherwise, it is up
- *	to the program to supply one.  A good guess is
- *		extern int flock(int, int);
- */
-#define	HAS_FLOCK_PROTO	/**/
-
-/* HAS_FP_CLASS:
- *	This symbol, if defined, indicates that the fp_class routine is
- *	available to classify doubles.  Available for example in Digital UNIX.
- *	The returned values are defined in <math.h> and are:
- *
- *	FP_SNAN           Signaling NaN (Not-a-Number)
- *	FP_QNAN           Quiet NaN (Not-a-Number)
- *	FP_POS_INF        +infinity
- *	FP_NEG_INF        -infinity
- *	FP_POS_NORM       Positive normalized
- *	FP_NEG_NORM       Negative normalized
- *	FP_POS_DENORM     Positive denormalized
- *	FP_NEG_DENORM     Negative denormalized
- *	FP_POS_ZERO       +0.0 (positive zero)
- *	FP_NEG_ZERO       -0.0 (negative zero)
- */
-/*#define HAS_FP_CLASS		/**/
-
-/* HAS_FPCLASS:
- *	This symbol, if defined, indicates that the fpclass routine is
- *	available to classify doubles.  Available for example in Solaris/SVR4.
- *	The returned values are defined in <ieeefp.h> and are:
- *
- *	FP_SNAN		signaling NaN
- *	FP_QNAN		quiet NaN
- *	FP_NINF		negative infinity
- *	FP_PINF		positive infinity
- *	FP_NDENORM	negative denormalized non-zero
- *	FP_PDENORM	positive denormalized non-zero
- *	FP_NZERO	negative zero
- *	FP_PZERO	positive zero
- *	FP_NNORM	negative normalized non-zero
- *	FP_PNORM	positive normalized non-zero
- */
-/*#define HAS_FPCLASS		/**/
-
-/* HAS_FPCLASSIFY:
- *	This symbol, if defined, indicates that the fpclassify routine is
- *	available to classify doubles.  Available for example in HP-UX.
- *	The returned values are defined in <math.h> and are
- *
- *           FP_NORMAL     Normalized
- *           FP_ZERO       Zero
- *           FP_INFINITE   Infinity
- *           FP_SUBNORMAL  Denormalized
- *           FP_NAN        NaN
- *
- */
-/*#define HAS_FPCLASSIFY		/**/
-
-/* HAS_FPCLASSL:
- *	This symbol, if defined, indicates that the fpclassl routine is
- *	available to classify long doubles.  Available for example in IRIX.
- *	The returned values are defined in <ieeefp.h> and are:
- *
- *	FP_SNAN		signaling NaN
- *	FP_QNAN		quiet NaN
- *	FP_NINF		negative infinity
- *	FP_PINF		positive infinity
- *	FP_NDENORM	negative denormalized non-zero
- *	FP_PDENORM	positive denormalized non-zero
- *	FP_NZERO	negative zero
- *	FP_PZERO	positive zero
- *	FP_NNORM	negative normalized non-zero
- *	FP_PNORM	positive normalized non-zero
- */
-/*#define HAS_FPCLASSL		/**/
-
-/* HAS_FPOS64_T:
- *	This symbol will be defined if the C compiler supports fpos64_t.
- */
-/*#define	HAS_FPOS64_T    	/**/
-
-/* HAS_FREXPL:
- *	This symbol, if defined, indicates that the frexpl routine is
- *	available to break a long double floating-point number into
- *	a normalized fraction and an integral power of 2.
- */
-/*#define HAS_FREXPL		/**/
-
-/* HAS_STRUCT_FS_DATA:
- *	This symbol, if defined, indicates that the struct fs_data
- *	to do statfs() is supported.
- */
-/*#define HAS_STRUCT_FS_DATA	/**/
-
-/* HAS_FSEEKO:
- *	This symbol, if defined, indicates that the fseeko routine is
- *	available to fseek beyond 32 bits (useful for ILP32 hosts).
- */
-/*#define HAS_FSEEKO		/**/
-
-/* HAS_FSTATFS:
- *	This symbol, if defined, indicates that the fstatfs routine is
- *	available to stat filesystems by file descriptors.
- */
-/*#define HAS_FSTATFS		/**/
-
-/* HAS_FSYNC:
- *	This symbol, if defined, indicates that the fsync routine is
- *	available to write a file's modified data and attributes to
- *	permanent storage.
- */
-/*#define HAS_FSYNC		/**/
-
-/* HAS_FTELLO:
- *	This symbol, if defined, indicates that the ftello routine is
- *	available to ftell beyond 32 bits (useful for ILP32 hosts).
- */
-/*#define HAS_FTELLO		/**/
-
-/* HAS_FUTIMES:
- *	This symbol, if defined, indicates that the futimes routine is
- *	available to change file descriptor time stamps with struct timevals.
- */
-/*#define HAS_FUTIMES		/**/
-
-/* Gconvert:
- *	This preprocessor macro is defined to convert a floating point
- *	number to a string without a trailing decimal point.  This
- *	emulates the behavior of sprintf("%g"), but is sometimes much more
- *	efficient.  If gconvert() is not available, but gcvt() drops the
- *	trailing decimal point, then gcvt() is used.  If all else fails,
- *	a macro using sprintf("%g") is used. Arguments for the Gconvert
- *	macro are: value, number of digits, whether trailing zeros should
- *	be retained, and the output buffer.
- *	The usual values are:
- *		d_Gconvert='gconvert((x),(n),(t),(b))'
- *		d_Gconvert='gcvt((x),(n),(b))'
- *		d_Gconvert='sprintf((b),"%.*g",(n),(x))'
- *	The last two assume trailing zeros should not be kept.
- */
-#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x))
-
-/* HAS_GETCWD:
- *	This symbol, if defined, indicates that the getcwd routine is
- *	available to get the current working directory.
- */
-#define HAS_GETCWD		/**/
-
-/* HAS_GETESPWNAM:
- *	This symbol, if defined, indicates that the getespwnam system call is
- *	available to retrieve enchanced (shadow) password entries by name.
- */
-/*#define HAS_GETESPWNAM		/**/
-
-/* HAS_GETFSSTAT:
- *	This symbol, if defined, indicates that the getfsstat routine is
- *	available to stat filesystems in bulk.
- */
-/*#define HAS_GETFSSTAT		/**/
-
 /* HAS_GETGRENT:
  *	This symbol, if defined, indicates that the getgrent routine is
  *	available for sequential access of the group database.
@@ -1839,12 +1454,6 @@
  */
 #define	HAS_GETHOST_PROTOS	/**/
 
-/* HAS_GETITIMER:
- *	This symbol, if defined, indicates that the getitimer routine is
- *	available to return interval timers.
- */
-/*#define HAS_GETITIMER		/**/
-
 /* HAS_GETLOGIN_R:
  *	This symbol, if defined, indicates that the getlogin_r routine
  *	is available to getlogin re-entrantly.
@@ -1858,18 +1467,6 @@
 /*#define HAS_GETLOGIN_R	   /**/
 #define GETLOGIN_R_PROTO 0	   /**/
 
-/* HAS_GETMNT:
- *	This symbol, if defined, indicates that the getmnt routine is
- *	available to get filesystem mount info by filename.
- */
-/*#define HAS_GETMNT		/**/
-
-/* HAS_GETMNTENT:
- *	This symbol, if defined, indicates that the getmntent routine is
- *	available to iterate through mounted file systems to get their info.
- */
-/*#define HAS_GETMNTENT		/**/
-
 /* HAS_GETNETBYADDR:
  *	This symbol, if defined, indicates that the getnetbyaddr() routine is
  *	available to look up networks by their IP addresses.
@@ -1935,13 +1532,6 @@
  */
 /*#define	HAS_GETNET_PROTOS	/**/
 
-/* HAS_GETPAGESIZE:
- *	This symbol, if defined, indicates that the getpagesize system call
- *	is available to get system page size, which is the granularity of
- *	many memory management calls.
- */
-/*#define HAS_GETPAGESIZE		/**/
-
 /* HAS_GETPROTOENT:
  *	This symbol, if defined, indicates that the getprotoent() routine is
  *	available to look up protocols in some data base or another.
@@ -2017,12 +1607,6 @@
  */
 #define	HAS_GETPROTO_PROTOS	/**/
 
-/* HAS_GETPRPWNAM:
- *	This symbol, if defined, indicates that the getprpwnam system call is
- *	available to retrieve protected (shadow) password entries by name.
- */
-/*#define HAS_GETPRPWNAM		/**/
-
 /* HAS_GETPWENT:
  *	This symbol, if defined, indicates that the getpwent routine is
  *	available for sequential access of the passwd database.
@@ -2122,12 +1706,6 @@
  */
 #define	HAS_GETSERV_PROTOS	/**/
 
-/* HAS_GETSPNAM:
- *	This symbol, if defined, indicates that the getspnam system call is
- *	available to retrieve SysV shadow password entries by name.
- */
-/*#define HAS_GETSPNAM		/**/
-
 /* HAS_GETSPNAM_R:
  *	This symbol, if defined, indicates that the getspnam_r routine
  *	is available to getspnam re-entrantly.
@@ -2165,21 +1743,6 @@
 /*#define HAS_GMTIME_R	   /**/
 #define GMTIME_R_PROTO 0	   /**/
 
-/* HAS_GNULIBC:
- *	This symbol, if defined, indicates to the C program that 
- *	the GNU C library is being used.  A better check is to use
- *	the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc.
- */
-/*#define HAS_GNULIBC  	/**/
-#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)
-#   define _GNU_SOURCE
-#endif
-/* HAS_HASMNTOPT:
- *	This symbol, if defined, indicates that the hasmntopt routine is
- *	available to query the mount options of file systems.
- */
-/*#define HAS_HASMNTOPT		/**/
-
 /* HAS_HTONL:
  *	This symbol, if defined, indicates that the htonl() routine (and
  *	friends htons() ntohl() ntohs()) are available to do network
@@ -2205,70 +1768,6 @@
 #define HAS_NTOHL		/**/
 #define HAS_NTOHS		/**/
 
-/* HAS_ILOGBL:
- *	This symbol, if defined, indicates that the ilogbl routine is
- *	available.  If scalbnl is also present we can emulate frexpl.
- */
-/*#define HAS_ILOGBL		/**/
-
-/* HAS_INT64_T:
- *     This symbol will defined if the C compiler supports int64_t.
- *     Usually the <inttypes.h> needs to be included, but sometimes
- *	<sys/types.h> is enough.
- */
-/*#define     HAS_INT64_T               /**/
-
-/* HAS_ISASCII:
- *	This manifest constant lets the C program know that isascii 
- *	is available.
- */
-#define HAS_ISASCII		/**/
-
-/* HAS_ISFINITE:
- *	This symbol, if defined, indicates that the isfinite routine is
- *	available to check whether a double is finite (non-infinity non-NaN).
- */
-/*#define HAS_ISFINITE		/**/
-
-/* HAS_ISINF:
- *	This symbol, if defined, indicates that the isinf routine is
- *	available to check whether a double is an infinity.
- */
-/*#define HAS_ISINF		/**/
-
-/* HAS_ISNAN:
- *	This symbol, if defined, indicates that the isnan routine is
- *	available to check whether a double is a NaN.
- */
-#define HAS_ISNAN		/**/
-
-/* HAS_ISNANL:
- *	This symbol, if defined, indicates that the isnanl routine is
- *	available to check whether a long double is a NaN.
- */
-/*#define HAS_ISNANL		/**/
-
-/* HAS_LCHOWN:
- *	This symbol, if defined, indicates that the lchown routine is
- *	available to operate on a symbolic link (instead of following the
- *	link).
- */
-/*#define HAS_LCHOWN		/**/
-
-/* HAS_LDBL_DIG:
- *	This symbol, if defined, indicates that this system's <float.h>
- *	or <limits.h> defines the symbol LDBL_DIG, which is the number
- *	of significant digits in a long double precision number. Unlike
- *	for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined.
- */
-#define HAS_LDBL_DIG 	/**/
-
-/* LIBM_LIB_VERSION:
- *	This symbol, if defined, indicates that libm exports _LIB_VERSION
- *	and that math.h defines the enum to manipulate it.
- */
-/*#define LIBM_LIB_VERSION         /**/
-
 /* HAS_LOCALTIME_R:
  *	This symbol, if defined, indicates that the localtime_r routine
  *	is available to localtime re-entrantly.
@@ -2276,9 +1775,16 @@
 /* LOCALTIME_R_NEEDS_TZSET:
  *	Many libc's localtime_r implementations do not call tzset,
  *	making them differ from localtime(), and making timezone
- *	changes using $ENV{TZ} without explicitly calling tzset
+ *	changes using \undef{TZ} without explicitly calling tzset
  *	impossible. This symbol makes us call tzset before localtime_r
  */
+/*#define LOCALTIME_R_NEEDS_TZSET /**/
+#ifdef LOCALTIME_R_NEEDS_TZSET
+#define L_R_TZSET tzset(),
+#else
+#define L_R_TZSET
+#endif
+
 /* LOCALTIME_R_PROTO:
  *	This symbol encodes the prototype of localtime_r.
  *	It is zero if d_localtime_r is undef, and one of the
@@ -2286,7 +1792,6 @@
  *	is defined.
  */
 /*#define HAS_LOCALTIME_R	   /**/
-/*#define LOCALTIME_R_NEEDS_TZSET	   /**/
 #define LOCALTIME_R_PROTO 0	   /**/
 
 /* HAS_LONG_DOUBLE:
@@ -2294,7 +1799,7 @@
  *	doubles.
  */
 /* LONG_DOUBLESIZE:
- *	This symbol contains the size of a long double, so that the 
+ *	This symbol contains the size of a long double, so that the
  *	C preprocessor can make decisions based on it.  It is only
  *	defined if the system supports long doubles.
  */
@@ -2303,7 +1808,7 @@
 #   ifndef _MSC_VER
 #	define LONG_DOUBLESIZE 12		/**/
 #   else
-#	define LONG_DOUBLESIZE 10		/**/
+#	define LONG_DOUBLESIZE 8		/**/
 #   endif
 #endif
 
@@ -2311,7 +1816,7 @@
  *	This symbol will be defined if the C compiler supports long long.
  */
 /* LONGLONGSIZE:
- *	This symbol contains the size of a long long, so that the 
+ *	This symbol contains the size of a long long, so that the
  *	C preprocessor can make decisions based on it.  It is only
  *	defined if the system supports long long.
  */
@@ -2328,36 +1833,12 @@
  */
 #define	HAS_LSEEK_PROTO	/**/
 
-/* HAS_MADVISE:
- *	This symbol, if defined, indicates that the madvise system call is
- *	available to map a file into memory.
- */
-/*#define HAS_MADVISE		/**/
-
-/* HAS_MALLOC_SIZE:
- *	This symbol, if defined, indicates that the malloc_size
- *	routine is available for use.
- */
-/*#define HAS_MALLOC_SIZE		/**/
-
-/* HAS_MALLOC_GOOD_SIZE:
- *	This symbol, if defined, indicates that the malloc_good_size
- *	routine is available for use.
- */
-/*#define HAS_MALLOC_GOOD_SIZE	/**/
-
 /* HAS_MEMCHR:
  *	This symbol, if defined, indicates that the memchr routine is available
  *	to locate characters within a C string.
  */
 #define HAS_MEMCHR	/**/
 
-/* HAS_MKDTEMP:
- *	This symbol, if defined, indicates that the mkdtemp routine is
- *	available to exclusively create a uniquely named temporary directory.
- */
-/*#define HAS_MKDTEMP		/**/
-
 /* HAS_MKSTEMP:
  *	This symbol, if defined, indicates that the mkstemp routine is
  *	available to exclusively create and open a uniquely named
@@ -2365,13 +1846,6 @@
  */
 /*#define HAS_MKSTEMP		/**/
 
-/* HAS_MKSTEMPS:
- *	This symbol, if defined, indicates that the mkstemps routine is
- *	available to excluslvely create and open a uniquely named
- *	(with a suffix) temporary file.
- */
-/*#define HAS_MKSTEMPS		/**/
-
 /* HAS_MMAP:
  *	This symbol, if defined, indicates that the mmap system call is
  *	available to map a file into memory.
@@ -2384,77 +1858,12 @@
 /*#define HAS_MMAP		/**/
 #define Mmap_t void *	/**/
 
-/* HAS_MODFL:
- *	This symbol, if defined, indicates that the modfl routine is
- *	available to split a long double x into a fractional part f and
- *	an integer part i such that |f| < 1.0 and (f + i) = x.
- */
-/* HAS_MODFL_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the modfl() function.  Otherwise, it is up
- *	to the program to supply one.
- */
-/* HAS_MODFL_POW32_BUG:
- *	This symbol, if defined, indicates that the modfl routine is
- *	broken for long doubles >= pow(2, 32).
- *	For example from 4294967303.150000 one would get 4294967302.000000
- *	and 1.150000.  The bug has been seen in certain versions of glibc,
- *	release 2.2.2 is known to be okay.
- */
-/*#define HAS_MODFL		/**/
-/*#define HAS_MODFL_PROTO		/**/
-/*#define HAS_MODFL_POW32_BUG		/**/
-
-/* HAS_MPROTECT:
- *	This symbol, if defined, indicates that the mprotect system call is
- *	available to modify the access protection of a memory mapped file.
- */
-/*#define HAS_MPROTECT		/**/
-
 /* HAS_MSG:
  *	This symbol, if defined, indicates that the entire msg*(2) library is
  *	supported (IPC mechanism based on message queues).
  */
 /*#define HAS_MSG		/**/
 
-/* HAS_STRUCT_MSGHDR:
- *	This symbol, if defined, indicates that the struct msghdr
- *	is supported.
- */
-/*#define HAS_STRUCT_MSGHDR	/**/
-
-/* HAS_NL_LANGINFO:
- *	This symbol, if defined, indicates that the nl_langinfo routine is
- *	available to return local data.  You will also need <langinfo.h>
- *	and therefore I_LANGINFO.
- */
-/*#define HAS_NL_LANGINFO		/**/
-
-/* HAS_OFF64_T:
- *	This symbol will be defined if the C compiler supports off64_t.
- */
-/*#define	HAS_OFF64_T    		/**/
-
-/* HAS_OPEN3:
- *	This manifest constant lets the C program know that the three
- *	argument form of open(2) is available.
- */
-/*#define HAS_OPEN3		/**/
-
-/* HAS_PROCSELFEXE:
- *	This symbol is defined if PROCSELFEXE_PATH is a symlink
- *	to the absolute pathname of the executing program.
- */
-/* PROCSELFEXE_PATH:
- *	If HAS_PROCSELFEXE is defined this symbol is the filename
- *	of the symbolic link pointing to the absolute pathname of
- *	the executing program.
- */
-/*#define HAS_PROCSELFEXE	/**/
-#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH)
-#define PROCSELFEXE_PATH		/**/
-#endif
-
 /* OLD_PTHREAD_CREATE_JOINABLE:
  *	This symbol, if defined, indicates how to create pthread
  *	in joinable (aka undetached) state.  NOTE: not defined
@@ -2471,15 +1880,8 @@
  */
 /*#define HAS_PTHREAD_ATFORK		/**/
 
-/* HAS_PTHREAD_ATTR_SETSCOPE:
- *	This symbol, if defined, indicates that the pthread_attr_setscope
- *	system call is available to set the contention scope attribute of
- *	a thread attribute object.
- */
-/*#define HAS_PTHREAD_ATTR_SETSCOPE		/ **/
-
 /* HAS_PTHREAD_YIELD:
- *	This symbol, if defined, indicates that the pthread_yield 
+ *	This symbol, if defined, indicates that the pthread_yield
  *	routine is available to yield the execution of the current
  *	thread.	 sched_yield is preferable to pthread_yield.
  */
@@ -2536,69 +1938,12 @@
 /*#define HAS_READDIR_R	   /**/
 #define READDIR_R_PROTO 0	   /**/
 
-/* HAS_READV:
- *	This symbol, if defined, indicates that the readv routine is
- *	available to do gather reads.  You will also need <sys/uio.h>
- *	and there I_SYSUIO.
- */
-/*#define HAS_READV		/**/
-
-/* HAS_RECVMSG:
- *	This symbol, if defined, indicates that the recvmsg routine is
- *	available to send structured socket messages.
- */
-/*#define HAS_RECVMSG		/**/
-
-/* HAS_SAFE_BCOPY:
- *	This symbol, if defined, indicates that the bcopy routine is available
- *	to copy potentially overlapping memory blocks. Normally, you should
- *	probably use memmove() or memcpy(). If neither is defined, roll your
- *	own version.
- */
-/*#define HAS_SAFE_BCOPY	/**/
-
-/* HAS_SAFE_MEMCPY:
- *	This symbol, if defined, indicates that the memcpy routine is available
- *	to copy potentially overlapping memory blocks.  If you need to
- *	copy overlapping memory blocks, you should check HAS_MEMMOVE and
- *	use memmove() instead, if available.
- */
-/*#define HAS_SAFE_MEMCPY	/**/
-
-/* HAS_SANE_MEMCMP:
- *	This symbol, if defined, indicates that the memcmp routine is available
- *	and can be used to compare relative magnitudes of chars with their high
- *	bits set.  If it is not defined, roll your own version.
- */
-#define HAS_SANE_MEMCMP	/**/
-
-/* HAS_SBRK_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the sbrk() function.  Otherwise, it is up
- *	to the program to supply one.  Good guesses are
- *		extern void* sbrk(int);
- *		extern void* sbrk(size_t);
- */
-/*#define	HAS_SBRK_PROTO	/**/
-
-/* HAS_SCALBNL:
- *	This symbol, if defined, indicates that the scalbnl routine is
- *	available.  If ilogbl is also present we can emulate frexpl.
- */
-/*#define HAS_SCALBNL		/**/
-
 /* HAS_SEM:
  *	This symbol, if defined, indicates that the entire sem*(2) library is
  *	supported.
  */
 /*#define HAS_SEM		/**/
 
-/* HAS_SENDMSG:
- *	This symbol, if defined, indicates that the sendmsg routine is
- *	available to send structured socket messages.
- */
-/*#define HAS_SENDMSG		/**/
-
 /* HAS_SETGRENT:
  *	This symbol, if defined, indicates that the setgrent routine is
  *	available for initializing sequential access of the group database.
@@ -2618,13 +1963,6 @@
 /*#define HAS_SETGRENT_R	   /**/
 #define SETGRENT_R_PROTO 0	   /**/
 
-/* HAS_SETGROUPS:
- *	This symbol, if defined, indicates that the setgroups() routine is
- *	available to set the list of process groups.  If unavailable, multiple
- *	groups are probably not supported.
- */
-/*#define HAS_SETGROUPS		/**/
-
 /* HAS_SETHOSTENT:
  *	This symbol, if defined, indicates that the sethostent() routine is
  *	available.
@@ -2644,12 +1982,6 @@
 /*#define HAS_SETHOSTENT_R	   /**/
 #define SETHOSTENT_R_PROTO 0	   /**/
 
-/* HAS_SETITIMER:
- *	This symbol, if defined, indicates that the setitimer routine is
- *	available to set interval timers.
- */
-/*#define HAS_SETITIMER		/**/
-
 /* HAS_SETLOCALE_R:
  *	This symbol, if defined, indicates that the setlocale_r routine
  *	is available to setlocale re-entrantly.
@@ -2700,12 +2032,6 @@
 /*#define HAS_SETPGRP		/**/
 /*#define USE_BSD_SETPGRP	/**/
 
-/* HAS_SETPROCTITLE:
- *	This symbol, if defined, indicates that the setproctitle routine is
- *	available to set process title.
- */
-/*#define HAS_SETPROCTITLE		/**/
-
 /* HAS_SETPROTOENT_R:
  *	This symbol, if defined, indicates that the setprotoent_r routine
  *	is available to setprotoent re-entrantly.
@@ -2764,12 +2090,6 @@
  */
 #define HAS_SETVBUF		/**/
 
-/* USE_SFIO:
- *	This symbol, if defined, indicates that sfio should
- *	be used.
- */
-/*#define	USE_SFIO		/**/
-
 /* HAS_SHM:
  *	This symbol, if defined, indicates that the entire shm*(2) library is
  *	supported.
@@ -2790,81 +2110,6 @@
 #define Shmat_t void *	/**/
 /*#define HAS_SHMAT_PROTOTYPE	/**/
 
-/* HAS_SIGACTION:
- *	This symbol, if defined, indicates that Vr4's sigaction() routine
- *	is available.
- */
-/*#define HAS_SIGACTION	/**/
-
-/* HAS_SIGPROCMASK:
- *	This symbol, if defined, indicates that the sigprocmask
- *	system call is available to examine or change the signal mask
- *	of the calling process.
- */
-/*#define HAS_SIGPROCMASK		/**/
-
-/* HAS_SIGSETJMP:
- *	This variable indicates to the C program that the sigsetjmp()
- *	routine is available to save the calling process's registers
- *	and stack environment for later use by siglongjmp(), and
- *	to optionally save the process's signal mask.  See
- *	Sigjmp_buf, Sigsetjmp, and Siglongjmp.
- */
-/* Sigjmp_buf:
- *	This is the buffer type to be used with Sigsetjmp and Siglongjmp.
- */
-/* Sigsetjmp:
- *	This macro is used in the same way as sigsetjmp(), but will invoke
- *	traditional setjmp() if sigsetjmp isn't available.
- *	See HAS_SIGSETJMP.
- */
-/* Siglongjmp:
- *	This macro is used in the same way as siglongjmp(), but will invoke
- *	traditional longjmp() if siglongjmp isn't available.
- *	See HAS_SIGSETJMP.
- */
-/*#define HAS_SIGSETJMP	/**/
-#ifdef HAS_SIGSETJMP
-#define Sigjmp_buf sigjmp_buf
-#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask))
-#define Siglongjmp(buf,retval) siglongjmp((buf),(retval))
-#else
-#define Sigjmp_buf jmp_buf
-#define Sigsetjmp(buf,save_mask) setjmp((buf))
-#define Siglongjmp(buf,retval) longjmp((buf),(retval))
-#endif
-
-/* USE_SITECUSTOMIZE:
- *	This symbol, if defined, indicates that sitecustomize should
- *	be used.
- */
-/*#define	USE_SITECUSTOMIZE		/**/
-
-/* HAS_SNPRINTF:
- *	This symbol, if defined, indicates that the snprintf () library
- *	function is available for use.
- */
-/* HAS_VSNPRINTF:
- *	This symbol, if defined, indicates that the vsnprintf () library
- *	function is available for use.
- */
-#define HAS_SNPRINTF	/**/
-#define HAS_VSNPRINTF	/**/
-
-/* HAS_SOCKATMARK:
- *	This symbol, if defined, indicates that the sockatmark routine is
- *	available to test whether a socket is at the out-of-band mark.
- */
-/*#define HAS_SOCKATMARK		/**/
-
-/* HAS_SOCKATMARK_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the sockatmark() function.  Otherwise, it is up
- *	to the program to supply one.  A good guess is
- *		extern int sockatmark(int);
- */
-/*#define	HAS_SOCKATMARK_PROTO	/**/
-
 /* HAS_SOCKET:
  *	This symbol, if defined, indicates that the BSD socket interface is
  *	supported.
@@ -2912,26 +2157,6 @@
 /*#define	HAS_MSG_PROXY	/**/
 /*#define	HAS_SCM_RIGHTS	/**/
 
-/* HAS_SOCKS5_INIT:
- *	This symbol, if defined, indicates that the socks5_init routine is
- *	available to initialize SOCKS 5.
- */
-/*#define HAS_SOCKS5_INIT		/**/
-
-/* SPRINTF_RETURNS_STRLEN:
- *	This variable defines whether sprintf returns the length of the string
- *	(as per the ANSI spec). Some C libraries retain compatibility with
- *	pre-ANSI C and return a pointer to the passed in buffer; for these
- *	this variable will be undef.
- */
-#define SPRINTF_RETURNS_STRLEN       /**/
-
-/* HAS_SQRTL:
- *	This symbol, if defined, indicates that the sqrtl routine is
- *	available to do long double square roots.
- */
-/*#define HAS_SQRTL		/**/
-
 /* HAS_SRAND48_R:
  *	This symbol, if defined, indicates that the srand48_r routine
  *	is available to srand48 re-entrantly.
@@ -2958,22 +2183,6 @@
 /*#define HAS_SRANDOM_R	   /**/
 #define SRANDOM_R_PROTO 0	   /**/
 
-/* HAS_SETRESGID_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the setresgid() function.  Otherwise, it is up
- *	to the program to supply one.  Good guesses are
- *		extern int setresgid(uid_t ruid, uid_t euid, uid_t suid);
- */
-/*#define	HAS_SETRESGID_PROTO	/**/
-
-/* HAS_SETRESUID_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the setresuid() function.  Otherwise, it is up
- *	to the program to supply one.  Good guesses are
- *		extern int setresuid(uid_t ruid, uid_t euid, uid_t suid);
- */
-/*#define	HAS_SETRESUID_PROTO	/**/
-
 /* USE_STAT_BLOCKS:
  *	This symbol is defined if this system has a stat structure declaring
  *	st_blksize and st_blocks.
@@ -2982,28 +2191,914 @@
 /*#define USE_STAT_BLOCKS 	/**/
 #endif
 
-/* HAS_STRUCT_STATFS_F_FLAGS:
- *	This symbol, if defined, indicates that the struct statfs
- *	does have the f_flags member containing the mount flags of
- *	the filesystem containing the file.
- *	This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3),
- *	not from <sys/statfs.h> (SYSV).  Older BSDs (like Ultrix) do not
- *	have statfs() and struct statfs, they have ustat() and getmnt()
- *	with struct ustat and struct fs_data.
+/* USE_STRUCT_COPY:
+ *	This symbol, if defined, indicates that this C compiler knows how
+ *	to copy structures.  If undefined, you'll need to use a block copy
+ *	routine of some sort instead.
  */
-/*#define HAS_STRUCT_STATFS_F_FLAGS		/**/
+#define	USE_STRUCT_COPY	/**/
 
-/* HAS_STRUCT_STATFS:
- *	This symbol, if defined, indicates that the struct statfs
- *	to do statfs() is supported.
+/* HAS_STRERROR:
+ *	This symbol, if defined, indicates that the strerror routine is
+ *	available to translate error numbers to strings. See the writeup
+ *	of Strerror() in this file before you try to define your own.
  */
-/*#define HAS_STRUCT_STATFS	/**/
+/* HAS_SYS_ERRLIST:
+ *	This symbol, if defined, indicates that the sys_errlist array is
+ *	available to translate error numbers to strings. The extern int
+ *	sys_nerr gives the size of that table.
+ */
+/* Strerror:
+ *	This preprocessor symbol is defined as a macro if strerror() is
+ *	not available to translate error numbers to strings but sys_errlist[]
+ *	array is there.
+ */
+#define HAS_STRERROR		/**/
+#define HAS_SYS_ERRLIST	/**/
+#define Strerror(e) strerror(e)
 
-/* HAS_FSTATVFS:
- *	This symbol, if defined, indicates that the fstatvfs routine is
- *	available to stat filesystems by file descriptors.
+/* HAS_STRERROR_R:
+ *	This symbol, if defined, indicates that the strerror_r routine
+ *	is available to strerror re-entrantly.
  */
-/*#define HAS_FSTATVFS		/**/
+/* STRERROR_R_PROTO:
+ *	This symbol encodes the prototype of strerror_r.
+ *	It is zero if d_strerror_r is undef, and one of the
+ *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r
+ *	is defined.
+ */
+/*#define HAS_STRERROR_R	   /**/
+#define STRERROR_R_PROTO 0	   /**/
+
+/* HAS_STRTOUL:
+ *	This symbol, if defined, indicates that the strtoul routine is
+ *	available to provide conversion of strings to unsigned long.
+ */
+#define HAS_STRTOUL	/**/
+
+/* HAS_TIME:
+ *	This symbol, if defined, indicates that the time() routine exists.
+ */
+/* Time_t:
+ *	This symbol holds the type returned by time(). It can be long,
+ *	or time_t on BSD sites (in which case <sys/types.h> should be
+ *	included).
+ */
+#define HAS_TIME		/**/
+#define Time_t time_t		/* Time type */
+
+/* HAS_TIMES:
+ *	This symbol, if defined, indicates that the times() routine exists.
+ *	Note that this became obsolete on some systems (SUNOS), which now
+ * use getrusage(). It may be necessary to include <sys/times.h>.
+ */
+#define HAS_TIMES		/**/
+
+/* HAS_TMPNAM_R:
+ *	This symbol, if defined, indicates that the tmpnam_r routine
+ *	is available to tmpnam re-entrantly.
+ */
+/* TMPNAM_R_PROTO:
+ *	This symbol encodes the prototype of tmpnam_r.
+ *	It is zero if d_tmpnam_r is undef, and one of the
+ *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r
+ *	is defined.
+ */
+/*#define HAS_TMPNAM_R	   /**/
+#define TMPNAM_R_PROTO 0	   /**/
+
+/* HAS_TTYNAME_R:
+ *	This symbol, if defined, indicates that the ttyname_r routine
+ *	is available to ttyname re-entrantly.
+ */
+/* TTYNAME_R_PROTO:
+ *	This symbol encodes the prototype of ttyname_r.
+ *	It is zero if d_ttyname_r is undef, and one of the
+ *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
+ *	is defined.
+ */
+/*#define HAS_TTYNAME_R	   /**/
+#define TTYNAME_R_PROTO 0	   /**/
+
+/* HAS_UNION_SEMUN:
+ *	This symbol, if defined, indicates that the union semun is
+ *	defined by including <sys/sem.h>.  If not, the user code
+ *	probably needs to define it as:
+ *	union semun {
+ *	    int val;
+ *	    struct semid_ds *buf;
+ *	    unsigned short *array;
+ *	}
+ */
+/* USE_SEMCTL_SEMUN:
+ *	This symbol, if defined, indicates that union semun is
+ *	used for semctl IPC_STAT.
+ */
+/* USE_SEMCTL_SEMID_DS:
+ *	This symbol, if defined, indicates that struct semid_ds * is
+ *	used for semctl IPC_STAT.
+ */
+#define HAS_UNION_SEMUN	/**/
+/*#define USE_SEMCTL_SEMUN	/**/
+/*#define USE_SEMCTL_SEMID_DS	/**/
+
+/* HAS_VFORK:
+ *	This symbol, if defined, indicates that vfork() exists.
+ */
+/*#define HAS_VFORK	/**/
+
+/* HAS_PSEUDOFORK:
+ *	This symbol, if defined, indicates that an emulation of the
+ *	fork routine is available.
+ */
+/*#define HAS_PSEUDOFORK	/**/
+
+/* Signal_t:
+ *	This symbol's value is either "void" or "int", corresponding to the
+ *	appropriate return type of a signal handler.  Thus, you can declare
+ *	a signal handler using "Signal_t (*handler)()", and define the
+ *	handler using "Signal_t handler(sig)".
+ */
+#define Signal_t void	/* Signal handler's return type */
+
+/* HASVOLATILE:
+ *	This symbol, if defined, indicates that this C compiler knows about
+ *	the volatile declaration.
+ */
+#define	HASVOLATILE	/**/
+#ifndef HASVOLATILE
+#define volatile
+#endif
+
+/* Fpos_t:
+ *	This symbol holds the type used to declare file positions in libc.
+ *	It can be fpos_t, long, uint, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Fpos_t fpos_t		/* File position type */
+
+/* Gid_t_f:
+ *	This symbol defines the format string used for printing a Gid_t.
+ */
+#define	Gid_t_f		"ld"		/**/
+
+/* Gid_t_sign:
+ *	This symbol holds the signedess of a Gid_t.
+ *	1 for unsigned, -1 for signed.
+ */
+#define Gid_t_sign	-1		/* GID sign */
+
+/* Gid_t_size:
+ *	This symbol holds the size of a Gid_t in bytes.
+ */
+#define Gid_t_size 4		/* GID size */
+
+/* Gid_t:
+ *	This symbol holds the return type of getgid() and the type of
+ *	argument to setrgid() and related functions.  Typically,
+ *	it is the type of group ids in the kernel. It can be int, ushort,
+ *	gid_t, etc... It may be necessary to include <sys/types.h> to get
+ *	any typedef'ed information.
+ */
+#define Gid_t gid_t		/* Type for getgid(), etc... */
+
+/* I_DIRENT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <dirent.h>. Using this symbol also triggers the definition
+ *	of the Direntry_t define which ends up being 'struct dirent' or
+ *	'struct direct' depending on the availability of <dirent.h>.
+ */
+/* DIRNAMLEN:
+ *	This symbol, if defined, indicates to the C program that the length
+ *	of directory entry names is provided by a d_namlen field.  Otherwise
+ *	you need to do strlen() on the d_name field.
+ */
+/* Direntry_t:
+ *	This symbol is set to 'struct direct' or 'struct dirent' depending on
+ *	whether dirent is available or not. You should use this pseudo type to
+ *	portably declare your directory entries.
+ */
+#define I_DIRENT		/**/
+#define DIRNAMLEN	/**/
+#define Direntry_t struct direct
+
+/* I_GRP:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <grp.h>.
+ */
+/* GRPASSWD:
+ *	This symbol, if defined, indicates to the C program that struct group
+ *	in <grp.h> contains gr_passwd.
+ */
+/*#define I_GRP		/**/
+/*#define GRPASSWD	/**/
+
+/* I_MACH_CTHREADS:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <mach/cthreads.h>.
+ */
+/*#define   I_MACH_CTHREADS	/**/
+
+/* I_NDBM:
+ *	This symbol, if defined, indicates that <ndbm.h> exists and should
+ *	be included.
+ */
+/* I_GDBMNDBM:
+ *	This symbol, if defined, indicates that <gdbm/ndbm.h> exists and should
+ *	be included.  This was the location of the ndbm.h compatibility file
+ *	in RedHat 7.1.
+ */
+/* I_GDBM_NDBM:
+ *	This symbol, if defined, indicates that <gdbm-ndbm.h> exists and should
+ *	be included.  This is the location of the ndbm.h compatibility file
+ *	in Debian 4.0.
+ */
+/* NDBM_H_USES_PROTOTYPES:
+ *	This symbol, if defined, indicates that <ndbm.h> uses real ANSI C
+ *	prototypes instead of K&R style function declarations without any
+ *	parameter information. While ANSI C prototypes are supported in C++,
+ *	K&R style function declarations will yield errors.
+ */
+/* GDBMNDBM_H_USES_PROTOTYPES:
+ *	This symbol, if defined, indicates that <gdbm/ndbm.h> uses real ANSI C
+ *	prototypes instead of K&R style function declarations without any
+ *	parameter information. While ANSI C prototypes are supported in C++,
+ *	K&R style function declarations will yield errors.
+ */
+/* GDBM_NDBM_H_USES_PROTOTYPES:
+ *	This symbol, if defined, indicates that <gdbm-ndbm.h> uses real ANSI C
+ *	prototypes instead of K&R style function declarations without any
+ *	parameter information. While ANSI C prototypes are supported in C++,
+ *	K&R style function declarations will yield errors.
+ */
+/*#define I_NDBM	/**/
+/*#define I_GDBMNDBM	/**/
+/*#define I_GDBM_NDBM	/**/
+/*#define NDBM_H_USES_PROTOTYPES	/**/
+/*#define GDBMNDBM_H_USES_PROTOTYPES	/**/
+/*#define GDBM_NDBM_H_USES_PROTOTYPES	/**/
+
+/* I_NETDB:
+ *	This symbol, if defined, indicates that <netdb.h> exists and
+ *	should be included.
+ */
+/*#define I_NETDB		/**/
+
+/* I_NET_ERRNO:
+ *	This symbol, if defined, indicates that <net/errno.h> exists and
+ *	should be included.
+ */
+/*#define I_NET_ERRNO		/**/
+
+/* I_PTHREAD:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <pthread.h>.
+ */
+/*#define   I_PTHREAD	/**/
+
+/* I_PWD:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <pwd.h>.
+ */
+/* PWQUOTA:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_quota.
+ */
+/* PWAGE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_age.
+ */
+/* PWCHANGE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_change.
+ */
+/* PWCLASS:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_class.
+ */
+/* PWEXPIRE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_expire.
+ */
+/* PWCOMMENT:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_comment.
+ */
+/* PWGECOS:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_gecos.
+ */
+/* PWPASSWD:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_passwd.
+ */
+/*#define I_PWD		/**/
+/*#define PWQUOTA	/**/
+/*#define PWAGE	/**/
+/*#define PWCHANGE	/**/
+/*#define PWCLASS	/**/
+/*#define PWEXPIRE	/**/
+/*#define PWCOMMENT	/**/
+/*#define PWGECOS	/**/
+/*#define PWPASSWD	/**/
+
+/* I_SYS_ACCESS:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <sys/access.h>.
+ */
+/*#define   I_SYS_ACCESS                /**/
+
+/* I_SYS_SECURITY:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <sys/security.h>.
+ */
+/*#define   I_SYS_SECURITY	/**/
+
+/* I_SYSUIO:
+ *	This symbol, if defined, indicates that <sys/uio.h> exists and
+ *	should be included.
+ */
+/*#define	I_SYSUIO		/**/
+
+/* I_STDARG:
+ *	This symbol, if defined, indicates that <stdarg.h> exists and should
+ *	be included.
+ */
+/* I_VARARGS:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <varargs.h>.
+ */
+#define I_STDARG		/**/
+/*#define I_VARARGS	/**/
+
+/* PERL_INC_VERSION_LIST:
+ *	This variable specifies the list of subdirectories in over
+ *	which perl.c:incpush() and lib/lib.pm will automatically
+ *	search when adding directories to @INC, in a format suitable
+ *	for a C initialization string.  See the inc_version_list entry
+ *	in Porting/Glossary for more details.
+ */
+/*#define PERL_INC_VERSION_LIST 0		/**/
+
+/* INSTALL_USR_BIN_PERL:
+ *	This symbol, if defined, indicates that Perl is to be installed
+ * 	also as /usr/bin/perl.
+ */
+/*#define INSTALL_USR_BIN_PERL	/**/
+
+/* Off_t:
+ *	This symbol holds the type used to declare offsets in the kernel.
+ *	It can be int, long, off_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+/* LSEEKSIZE:
+ *	This symbol holds the number of bytes used by the Off_t.
+ */
+/* Off_t_size:
+ *	This symbol holds the number of bytes used by the Off_t.
+ */
+#define Off_t long		/* <offset> type */
+#define LSEEKSIZE 4		/* <offset> size */
+#define Off_t_size 4	/* <offset> size */
+
+/* Free_t:
+ *	This variable contains the return type of free().  It is usually
+ * void, but occasionally int.
+ */
+/* Malloc_t:
+ *	This symbol is the type of pointer returned by malloc and realloc.
+ */
+#define Malloc_t void *			/**/
+#define Free_t void			/**/
+
+/* PERL_MALLOC_WRAP:
+ *	This symbol, if defined, indicates that we'd like malloc wrap checks.
+ */
+#define PERL_MALLOC_WRAP		/**/
+
+/* MYMALLOC:
+ *	This symbol, if defined, indicates that we're using our own malloc.
+ */
+/*#define MYMALLOC			/**/
+
+/* Mode_t:
+ *	This symbol holds the type used to declare file modes
+ *	for systems calls.  It is usually mode_t, but may be
+ *	int or unsigned short.  It may be necessary to include <sys/types.h>
+ *	to get any typedef'ed information.
+ */
+#define Mode_t mode_t	 /* file mode parameter for system calls */
+
+/* Netdb_host_t:
+ *	This symbol holds the type used for the 1st argument
+ *	to gethostbyaddr().
+ */
+/* Netdb_hlen_t:
+ *	This symbol holds the type used for the 2nd argument
+ *	to gethostbyaddr().
+ */
+/* Netdb_name_t:
+ *	This symbol holds the type used for the argument to
+ *	gethostbyname().
+ */
+/* Netdb_net_t:
+ *	This symbol holds the type used for the 1st argument to
+ *	getnetbyaddr().
+ */
+#define Netdb_host_t		char * /**/
+#define Netdb_hlen_t		int /**/
+#define Netdb_name_t		char * /**/
+#define Netdb_net_t		long /**/
+
+/* PERL_OTHERLIBDIRS:
+ *	This variable contains a colon-separated set of paths for the perl
+ *	binary to search for additional library files or modules.
+ *	These directories will be tacked to the end of @INC.
+ *	Perl will automatically search below each path for version-
+ *	and architecture-specific directories.  See PERL_INC_VERSION_LIST
+ *	for more details.
+ */
+/*#define PERL_OTHERLIBDIRS ""		/**/
+
+/* Pid_t:
+ *	This symbol holds the type used to declare process ids in the kernel.
+ *	It can be int, uint, pid_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Pid_t int		/* PID type */
+
+/* PRIVLIB:
+ *	This symbol contains the name of the private library for this package.
+ *	The library is private in the sense that it needn't be in anyone's
+ *	execution path, but it should be accessible by the world.  The program
+ *	should be prepared to do ~ expansion.
+ */
+/* PRIVLIB_EXP:
+ *	This symbol contains the ~name expanded version of PRIVLIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define PRIVLIB "c:\\perl\\lib"		/**/
+#define PRIVLIB_EXP (win32_get_privlib("5.11.0"))	/**/
+
+/* CAN_PROTOTYPE:
+ *	If defined, this macro indicates that the C compiler can handle
+ *	function prototypes.
+ */
+/* _:
+ *	This macro is used to declare function parameters for folks who want
+ *	to make declarations with prototypes using a different style than
+ *	the above macros.  Use double parentheses.  For example:
+ *
+ *		int main _((int argc, char *argv[]));
+ */
+#define	CAN_PROTOTYPE	/**/
+#ifdef CAN_PROTOTYPE
+#define	_(args) args
+#else
+#define	_(args) ()
+#endif
+
+/* Select_fd_set_t:
+ *	This symbol holds the type used for the 2nd, 3rd, and 4th
+ *	arguments to select.  Usually, this is 'fd_set *', if HAS_FD_SET
+ *	is defined, and 'int *' otherwise.  This is only useful if you
+ *	have select(), of course.
+ */
+#define Select_fd_set_t 	Perl_fd_set *	/**/
+
+/* SH_PATH:
+ *	This symbol contains the full pathname to the shell used on this
+ *	on this system to execute Bourne shell scripts.  Usually, this will be
+ *	/bin/sh, though it's possible that some systems will have /bin/ksh,
+ *	/bin/pdksh, /bin/ash, /bin/bash, or even something such as
+ *	D:/bin/sh.exe.
+ */
+#define SH_PATH "cmd /x /c"  /**/
+
+/* SIG_NAME:
+ *	This symbol contains a list of signal names in order of
+ *	signal number. This is intended
+ *	to be used as a static array initialization, like this:
+ *		char *sig_name[] = { SIG_NAME };
+ *	The signals in the list are separated with commas, and each signal
+ *	is surrounded by double quotes. There is no leading SIG in the signal
+ *	name, i.e. SIGQUIT is known as "QUIT".
+ *	Gaps in the signal numbers (up to NSIG) are filled in with NUMnn,
+ *	etc., where nn is the actual signal number (e.g. NUM37).
+ *	The signal number for sig_name[i] is stored in sig_num[i].
+ *	The last element is 0 to terminate the list with a NULL.  This
+ *	corresponds to the 0 at the end of the sig_name_init list.
+ *	Note that this variable is initialized from the sig_name_init,
+ *	not from sig_name (which is unused).
+ */
+/* SIG_NUM:
+ *	This symbol contains a list of signal numbers, in the same order as the
+ *	SIG_NAME list. It is suitable for static array initialization, as in:
+ *		int sig_num[] = { SIG_NUM };
+ *	The signals in the list are separated with commas, and the indices
+ *	within that list and the SIG_NAME list match, so it's easy to compute
+ *	the signal name from a number or vice versa at the price of a small
+ *	dynamic linear lookup.
+ *	Duplicates are allowed, but are moved to the end of the list.
+ *	The signal number corresponding to sig_name[i] is sig_number[i].
+ *	if (i < NSIG) then sig_number[i] == i.
+ *	The last element is 0, corresponding to the 0 at the end of
+ *	the sig_name_init list.
+ *	Note that this variable is initialized from the sig_num_init,
+ *	not from sig_num (which is unused).
+ */
+/* SIG_SIZE:
+ *	This variable contains the number of elements of the SIG_NAME
+ *	and SIG_NUM arrays, excluding the final NULL entry.
+ */
+#define SIG_NAME "ZERO", "HUP", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "NUM16", "NUM17", "NUM18", "NUM19", "CHLD", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0		/**/
+#define SIG_NUM  0, 1, 2, 21, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 20, 0		/**/
+#define SIG_SIZE 27			/**/
+
+/* SITEARCH:
+ *	This symbol contains the name of the private library for this package.
+ *	The library is private in the sense that it needn't be in anyone's
+ *	execution path, but it should be accessible by the world.  The program
+ *	should be prepared to do ~ expansion.
+ *	The standard distribution will put nothing in this directory.
+ *	After perl has been installed, users may install their own local
+ *	architecture-dependent modules in this directory with
+ *		MakeMaker Makefile.PL
+ *	or equivalent.  See INSTALL for details.
+ */
+/* SITEARCH_EXP:
+ *	This symbol contains the ~name expanded version of SITEARCH, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define SITEARCH "c:\\perl\\site\\lib"		/**/
+/*#define SITEARCH_EXP ""	/**/
+
+/* SITELIB:
+ *	This symbol contains the name of the private library for this package.
+ *	The library is private in the sense that it needn't be in anyone's
+ *	execution path, but it should be accessible by the world.  The program
+ *	should be prepared to do ~ expansion.
+ *	The standard distribution will put nothing in this directory.
+ *	After perl has been installed, users may install their own local
+ *	architecture-independent modules in this directory with
+ *		MakeMaker Makefile.PL
+ *	or equivalent.  See INSTALL for details.
+ */
+/* SITELIB_EXP:
+ *	This symbol contains the ~name expanded version of SITELIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+/* SITELIB_STEM:
+ *	This define is SITELIB_EXP with any trailing version-specific component
+ *	removed.  The elements in inc_version_list (inc_version_list.U) can
+ *	be tacked onto this variable to generate a list of directories to search.
+ */
+#define SITELIB "c:\\perl\\site\\lib"		/**/
+#define SITELIB_EXP (win32_get_sitelib("5.11.0"))	/**/
+#define SITELIB_STEM ""		/**/
+
+/* Size_t_size:
+ *	This symbol holds the size of a Size_t in bytes.
+ */
+#define Size_t_size 4		/**/
+
+/* Size_t:
+ *	This symbol holds the type used to declare length parameters
+ *	for string functions.  It is usually size_t, but may be
+ *	unsigned long, int, etc.  It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Size_t size_t	 /* length paramater for string functions */
+
+/* Sock_size_t:
+ *	This symbol holds the type used for the size argument of
+ *	various socket calls (just the base type, not the pointer-to).
+ */
+#define Sock_size_t		int /**/
+
+/* STDCHAR:
+ *	This symbol is defined to be the type of char used in stdio.h.
+ *	It has the values "unsigned char" or "char".
+ */
+#define STDCHAR char	/**/
+
+/* Uid_t_f:
+ *	This symbol defines the format string used for printing a Uid_t.
+ */
+#define	Uid_t_f		"ld"		/**/
+
+/* Uid_t_sign:
+ *	This symbol holds the signedess of a Uid_t.
+ *	1 for unsigned, -1 for signed.
+ */
+#define Uid_t_sign	-1		/* UID sign */
+
+/* Uid_t_size:
+ *	This symbol holds the size of a Uid_t in bytes.
+ */
+#define Uid_t_size 4		/* UID size */
+
+/* Uid_t:
+ *	This symbol holds the type used to declare user ids in the kernel.
+ *	It can be int, ushort, uid_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Uid_t uid_t		/* UID type */
+
+/* USE_ITHREADS:
+ *	This symbol, if defined, indicates that Perl should be built to
+ *	use the interpreter-based threading implementation.
+ */
+/* USE_5005THREADS:
+ *	This symbol, if defined, indicates that Perl should be built to
+ *	use the 5.005-based threading implementation.
+ *	Only valid up to 5.8.x.
+ */
+/* OLD_PTHREADS_API:
+ *	This symbol, if defined, indicates that Perl should
+ *	be built to use the old draft POSIX threads API.
+ */
+/* USE_REENTRANT_API:
+ *	This symbol, if defined, indicates that Perl should
+ *	try to use the various _r versions of library functions.
+ *	This is extremely experimental.
+ */
+/*#define	USE_5005THREADS		/**/
+/*#define	USE_ITHREADS		/**/
+#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
+#define		USE_THREADS		/* until src is revised*/
+#endif
+/*#define	OLD_PTHREADS_API		/**/
+/*#define	USE_REENTRANT_API	/**/
+
+/* PERL_VENDORARCH:
+ *	If defined, this symbol contains the name of a private library.
+ *	The library is private in the sense that it needn't be in anyone's
+ *	execution path, but it should be accessible by the world.
+ *	It may have a ~ on the front.
+ *	The standard distribution will put nothing in this directory.
+ *	Vendors who distribute perl may wish to place their own
+ *	architecture-dependent modules and extensions in this directory with
+ *		MakeMaker Makefile.PL INSTALLDIRS=vendor
+ *	or equivalent.  See INSTALL for details.
+ */
+/* PERL_VENDORARCH_EXP:
+ *	This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+/*#define PERL_VENDORARCH ""		/**/
+/*#define PERL_VENDORARCH_EXP ""		/**/
+
+/* PERL_VENDORLIB_EXP:
+ *	This symbol contains the ~name expanded version of VENDORLIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+/* PERL_VENDORLIB_STEM:
+ *	This define is PERL_VENDORLIB_EXP with any trailing version-specific component
+ *	removed.  The elements in inc_version_list (inc_version_list.U) can
+ *	be tacked onto this variable to generate a list of directories to search.
+ */
+/*#define PERL_VENDORLIB_EXP ""		/**/
+/*#define PERL_VENDORLIB_STEM ""		/**/
+
+/* VOIDFLAGS:
+ *	This symbol indicates how much support of the void type is given by this
+ *	compiler.  What various bits mean:
+ *
+ *	    1 = supports declaration of void
+ *	    2 = supports arrays of pointers to functions returning void
+ *	    4 = supports comparisons between pointers to void functions and
+ *		    addresses of void functions
+ *	    8 = suports declaration of generic void pointers
+ *
+ *	The package designer should define VOIDUSED to indicate the requirements
+ *	of the package.  This can be done either by #defining VOIDUSED before
+ *	including config.h, or by defining defvoidused in Myinit.U.  If the
+ *	latter approach is taken, only those flags will be tested.  If the
+ *	level of void support necessary is not present, defines void to int.
+ */
+#ifndef VOIDUSED
+#define VOIDUSED 15
+#endif
+#define VOIDFLAGS 15
+#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
+#define void int		/* is void to be avoided? */
+#define M_VOID			/* Xenix strikes again */
+#endif
+
+/* USE_CROSS_COMPILE:
+ *	This symbol, if defined, indicates that Perl is being cross-compiled.
+ */
+/* PERL_TARGETARCH:
+ *	This symbol, if defined, indicates the target architecture
+ *	Perl has been cross-compiled to.  Undefined if not a cross-compile.
+ */
+#ifndef USE_CROSS_COMPILE
+/*#define	USE_CROSS_COMPILE	/**/
+#define	PERL_TARGETARCH	""	/**/
+#endif
+
+/* MEM_ALIGNBYTES:
+ *	This symbol contains the number of bytes required to align a
+ *	double, or a long double when applicable. Usual values are 2,
+ *	4 and 8. The default is eight, for safety.
+ */
+#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH)
+#  define MEM_ALIGNBYTES 8
+#else
+#define MEM_ALIGNBYTES 8
+#endif
+
+/* BYTEORDER:
+ *	This symbol holds the hexadecimal constant defined in byteorder,
+ *	in a UV, i.e. 0x1234 or 0x4321 or 0x12345678, etc...
+ *	If the compiler supports cross-compiling or multiple-architecture
+ *	binaries (eg. on NeXT systems), use compiler-defined macros to
+ *	determine the byte order.
+ *	On NeXT 3.2 (and greater), you can build "Fat" Multiple Architecture
+ *	Binaries (MAB) on either big endian or little endian machines.
+ *	The endian-ness is available at compile-time.  This only matters
+ *	for perl, where the config.h can be generated and installed on
+ *	one system, and used by a different architecture to build an
+ *	extension.  Older versions of NeXT that might not have
+ *	defined either *_ENDIAN__ were all on Motorola 680x0 series,
+ *	so the default case (for NeXT) is big endian to catch them.
+ *	This might matter for NeXT 3.0.
+ */
+#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH)
+#  ifdef __LITTLE_ENDIAN__
+#    if LONGSIZE == 4
+#      define BYTEORDER 0x1234
+#    else
+#      if LONGSIZE == 8
+#        define BYTEORDER 0x12345678
+#      endif
+#    endif
+#  else
+#    ifdef __BIG_ENDIAN__
+#      if LONGSIZE == 4
+#        define BYTEORDER 0x4321
+#      else
+#        if LONGSIZE == 8
+#          define BYTEORDER 0x87654321
+#        endif
+#      endif
+#    endif
+#  endif
+#  if !defined(BYTEORDER) && (defined(NeXT) || defined(__NeXT__))
+#    define BYTEORDER 0x4321
+#  endif
+#else
+#define BYTEORDER 0x1234	/* large digits for MSB */
+#endif /* NeXT */
+
+/* CASTI32:
+ *	This symbol is defined if the C compiler can cast negative
+ *	or large floating point numbers to 32-bit ints.
+ */
+#ifndef _MSC_VER
+#   define	CASTI32		/**/
+#endif
+
+/* CASTNEGFLOAT:
+ *	This symbol is defined if the C compiler can cast negative
+ *	numbers to unsigned longs, ints and shorts.
+ */
+/* CASTFLAGS:
+ *	This symbol contains flags that say what difficulties the compiler
+ *	has casting odd floating values to unsigned long:
+ *		0 = ok
+ *		1 = couldn't cast < 0
+ *		2 = couldn't cast >= 0x80000000
+ *		4 = couldn't cast in argument expression list
+ */
+#define	CASTNEGFLOAT		/**/
+#define CASTFLAGS 0		/**/
+
+/* VOID_CLOSEDIR:
+ *	This symbol, if defined, indicates that the closedir() routine
+ *	does not return a value.
+ */
+/*#define VOID_CLOSEDIR		/**/
+
+/* HAS_FD_SET:
+ *	This symbol, when defined, indicates presence of the fd_set typedef
+ *	in <sys/types.h>
+ */
+#define HAS_FD_SET	/**/
+
+/* Gconvert:
+ *	This preprocessor macro is defined to convert a floating point
+ *	number to a string without a trailing decimal point.  This
+ *	emulates the behavior of sprintf("%g"), but is sometimes much more
+ *	efficient.  If gconvert() is not available, but gcvt() drops the
+ *	trailing decimal point, then gcvt() is used.  If all else fails,
+ *	a macro using sprintf("%g") is used. Arguments for the Gconvert
+ *	macro are: value, number of digits, whether trailing zeros should
+ *	be retained, and the output buffer.
+ *	The usual values are:
+ *		d_Gconvert='gconvert((x),(n),(t),(b))'
+ *		d_Gconvert='gcvt((x),(n),(b))'
+ *		d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+ *	The last two assume trailing zeros should not be kept.
+ */
+#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x))
+
+/* HAS_GETPAGESIZE:
+ *	This symbol, if defined, indicates that the getpagesize system call
+ *	is available to get system page size, which is the granularity of
+ *	many memory management calls.
+ */
+/*#define HAS_GETPAGESIZE		/**/
+
+/* HAS_GNULIBC:
+ *	This symbol, if defined, indicates to the C program that
+ *	the GNU C library is being used.  A better check is to use
+ *	the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc.
+ */
+/*#define HAS_GNULIBC  	/**/
+#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)
+#   define _GNU_SOURCE
+#endif
+
+/* HAS_ISASCII:
+ *	This manifest constant lets the C program know that isascii
+ *	is available.
+ */
+#define HAS_ISASCII		/**/
+
+/* HAS_LCHOWN:
+ *	This symbol, if defined, indicates that the lchown routine is
+ *	available to operate on a symbolic link (instead of following the
+ *	link).
+ */
+/*#define HAS_LCHOWN		/**/
+
+/* HAS_OPEN3:
+ *	This manifest constant lets the C program know that the three
+ *	argument form of open(2) is available.
+ */
+/*#define HAS_OPEN3		/**/
+
+/* HAS_SAFE_BCOPY:
+ *	This symbol, if defined, indicates that the bcopy routine is available
+ *	to copy potentially overlapping memory blocks. Normally, you should
+ *	probably use memmove() or memcpy(). If neither is defined, roll your
+ *	own version.
+ */
+/*#define HAS_SAFE_BCOPY	/**/
+
+/* HAS_SAFE_MEMCPY:
+ *	This symbol, if defined, indicates that the memcpy routine is available
+ *	to copy potentially overlapping memory blocks.  If you need to
+ *	copy overlapping memory blocks, you should check HAS_MEMMOVE and
+ *	use memmove() instead, if available.
+ */
+/*#define HAS_SAFE_MEMCPY	/**/
+
+/* HAS_SANE_MEMCMP:
+ *	This symbol, if defined, indicates that the memcmp routine is available
+ *	and can be used to compare relative magnitudes of chars with their high
+ *	bits set.  If it is not defined, roll your own version.
+ */
+#define HAS_SANE_MEMCMP	/**/
+
+/* HAS_SIGACTION:
+ *	This symbol, if defined, indicates that Vr4's sigaction() routine
+ *	is available.
+ */
+/*#define HAS_SIGACTION	/**/
+
+/* HAS_SIGSETJMP:
+ *	This variable indicates to the C program that the sigsetjmp()
+ *	routine is available to save the calling process's registers
+ *	and stack environment for later use by siglongjmp(), and
+ *	to optionally save the process's signal mask.  See
+ *	Sigjmp_buf, Sigsetjmp, and Siglongjmp.
+ */
+/* Sigjmp_buf:
+ *	This is the buffer type to be used with Sigsetjmp and Siglongjmp.
+ */
+/* Sigsetjmp:
+ *	This macro is used in the same way as sigsetjmp(), but will invoke
+ *	traditional setjmp() if sigsetjmp isn't available.
+ *	See HAS_SIGSETJMP.
+ */
+/* Siglongjmp:
+ *	This macro is used in the same way as siglongjmp(), but will invoke
+ *	traditional longjmp() if siglongjmp isn't available.
+ *	See HAS_SIGSETJMP.
+ */
+/*#define HAS_SIGSETJMP	/**/
+#ifdef HAS_SIGSETJMP
+#define Sigjmp_buf sigjmp_buf
+#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask))
+#define Siglongjmp(buf,retval) siglongjmp((buf),(retval))
+#else
+#define Sigjmp_buf jmp_buf
+#define Sigsetjmp(buf,save_mask) setjmp((buf))
+#define Siglongjmp(buf,retval) longjmp((buf),(retval))
+#endif
 
 /* USE_STDIO_PTR:
  *	This symbol is defined if the _ptr and _cnt fields (or similar)
@@ -3075,37 +3170,763 @@
 #define FILE_bufsiz(fp)	((fp)->_cnt + (fp)->_ptr - (fp)->_base)
 #endif
 
-/* HAS_STRERROR:
- *	This symbol, if defined, indicates that the strerror routine is
- *	available to translate error numbers to strings. See the writeup
- *	of Strerror() in this file before you try to define your own.
+/* HAS_VPRINTF:
+ *	This symbol, if defined, indicates that the vprintf routine is available
+ *	to printf with a pointer to an argument list.  If unavailable, you
+ *	may need to write your own, probably in terms of _doprnt().
  */
-/* HAS_SYS_ERRLIST:
- *	This symbol, if defined, indicates that the sys_errlist array is
- *	available to translate error numbers to strings. The extern int
- *	sys_nerr gives the size of that table.
+/* USE_CHAR_VSPRINTF:
+ *	This symbol is defined if this system has vsprintf() returning type
+ *	(char*).  The trend seems to be to declare it as "int vsprintf()".  It
+ *	is up to the package author to declare vsprintf correctly based on the
+ *	symbol.
  */
-/* Strerror:
- *	This preprocessor symbol is defined as a macro if strerror() is
- *	not available to translate error numbers to strings but sys_errlist[]
- *	array is there.
+#define HAS_VPRINTF	/**/
+/*#define USE_CHAR_VSPRINTF 	/**/
+
+/* DOUBLESIZE:
+ *	This symbol contains the size of a double, so that the C preprocessor
+ *	can make decisions based on it.
  */
-#define HAS_STRERROR		/**/
-#define HAS_SYS_ERRLIST	/**/
-#define Strerror(e) strerror(e)
+#define DOUBLESIZE 8		/**/
 
-/* HAS_STRERROR_R:
- *	This symbol, if defined, indicates that the strerror_r routine
- *	is available to strerror re-entrantly.
+/* I_TIME:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <time.h>.
  */
-/* STRERROR_R_PROTO:
- *	This symbol encodes the prototype of strerror_r.
- *	It is zero if d_strerror_r is undef, and one of the
- *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r
- *	is defined.
+/* I_SYS_TIME:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/time.h>.
  */
-/*#define HAS_STRERROR_R	   /**/
-#define STRERROR_R_PROTO 0	   /**/
+/* I_SYS_TIME_KERNEL:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/time.h> with KERNEL defined.
+ */
+/* HAS_TM_TM_ZONE:
+ *	This symbol, if defined, indicates to the C program that
+ *	the struct tm has a tm_zone field.
+ */
+/* HAS_TM_TM_GMTOFF:
+ *	This symbol, if defined, indicates to the C program that
+ *	the struct tm has a tm_gmtoff field.
+ */
+#define I_TIME		/**/
+/*#define I_SYS_TIME		/**/
+/*#define I_SYS_TIME_KERNEL		/**/
+/*#define HAS_TM_TM_ZONE		/**/
+/*#define HAS_TM_TM_GMTOFF		/**/
+
+/* VAL_O_NONBLOCK:
+ *	This symbol is to be used during open() or fcntl(F_SETFL) to turn on
+ *	non-blocking I/O for the file descriptor. Note that there is no way
+ *	back, i.e. you cannot turn it blocking again this way. If you wish to
+ *	alternatively switch between blocking and non-blocking, use the
+ *	ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
+ */
+/* VAL_EAGAIN:
+ *	This symbol holds the errno error code set by read() when no data was
+ *	present on the non-blocking file descriptor.
+ */
+/* RD_NODATA:
+ *	This symbol holds the return code from read() when no data is present
+ *	on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
+ *	not defined, then you can't distinguish between no data and EOF by
+ *	issuing a read(). You'll have to find another way to tell for sure!
+ */
+/* EOF_NONBLOCK:
+ *	This symbol, if defined, indicates to the C program that a read() on
+ *	a non-blocking file descriptor will return 0 on EOF, and not the value
+ *	held in RD_NODATA (-1 usually, in that case!).
+ */
+#define VAL_O_NONBLOCK O_NONBLOCK
+#define VAL_EAGAIN EAGAIN
+#define RD_NODATA -1
+#define EOF_NONBLOCK
+
+/* PTRSIZE:
+ *	This symbol contains the size of a pointer, so that the C preprocessor
+ *	can make decisions based on it.  It will be sizeof(void *) if
+ *	the compiler supports (void *); otherwise it will be
+ *	sizeof(char *).
+ */
+#define PTRSIZE 4		/**/
+
+/* Drand01:
+ *	This macro is to be used to generate uniformly distributed
+ *	random numbers over the range [0., 1.[.  You may have to supply
+ *	an 'extern double drand48();' in your program since SunOS 4.1.3
+ *	doesn't provide you with anything relevant in its headers.
+ *	See HAS_DRAND48_PROTO.
+ */
+/* Rand_seed_t:
+ *	This symbol defines the type of the argument of the
+ *	random seed function.
+ */
+/* seedDrand01:
+ *	This symbol defines the macro to be used in seeding the
+ *	random number generator (see Drand01).
+ */
+/* RANDBITS:
+ *	This symbol indicates how many bits are produced by the
+ *	function used to generate normalized random numbers.
+ *	Values include 15, 16, 31, and 48.
+ */
+#define Drand01()		(rand()/(double)((unsigned)1<<RANDBITS))		/**/
+#define Rand_seed_t		unsigned		/**/
+#define seedDrand01(x)	srand((Rand_seed_t)x)	/**/
+#define RANDBITS		15		/**/
+
+/* SSize_t:
+ *	This symbol holds the type used by functions that return
+ *	a count of bytes or an error condition.  It must be a signed type.
+ *	It is usually ssize_t, but may be long or int, etc.
+ *	It may be necessary to include <sys/types.h> or <unistd.h>
+ *	to get any typedef'ed information.
+ *	We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
+ */
+#define SSize_t int	 /* signed count of bytes */
+
+/* EBCDIC:
+ *     This symbol, if defined, indicates that this system uses
+ *	EBCDIC encoding.
+ */
+/*#define	EBCDIC 		/**/
+
+/* PERL_USE_DEVEL:
+ *	This symbol, if defined, indicates that Perl was configured with
+ *	-Dusedevel, to enable development features.  This should not be
+ *	done for production builds.
+ */
+/*#define	PERL_USE_DEVEL		/**/
+
+/* HAS_ATOLF:
+ *	This symbol, if defined, indicates that the atolf routine is
+ *	available to convert strings into long doubles.
+ */
+/*#define HAS_ATOLF		/**/
+
+/* HAS_ATOLL:
+ *	This symbol, if defined, indicates that the atoll routine is
+ *	available to convert strings into long longs.
+ */
+/*#define HAS_ATOLL		/**/
+
+/* HAS__FWALK:
+ *	This symbol, if defined, indicates that the _fwalk system call is
+ *	available to apply a function to all the file handles.
+ */
+/*#define HAS__FWALK		/**/
+
+/* HAS_AINTL:
+ *	This symbol, if defined, indicates that the aintl routine is
+ *	available.  If copysignl is also present we can emulate modfl.
+ */
+/*#define HAS_AINTL		/**/
+
+/* HAS_BUILTIN_CHOOSE_EXPR:
+ *	Can we handle GCC builtin for compile-time ternary-like expressions
+ */
+/* HAS_BUILTIN_EXPECT:
+ *	Can we handle GCC builtin for telling that certain values are more
+ *	likely
+ */
+/*#define HAS_BUILTIN_EXPECT	/**/
+/*#define HAS_BUILTIN_CHOOSE_EXPR	/**/
+
+/* HAS_C99_VARIADIC_MACROS:
+ *	If defined, the compiler supports C99 variadic macros.
+ */
+/*#define	HAS_C99_VARIADIC_MACROS	/**/
+
+/* HAS_CLASS:
+ *	This symbol, if defined, indicates that the class routine is
+ *	available to classify doubles.  Available for example in AIX.
+ *	The returned values are defined in <float.h> and are:
+ *
+ *	FP_PLUS_NORM	Positive normalized, nonzero
+ *	FP_MINUS_NORM	Negative normalized, nonzero
+ *	FP_PLUS_DENORM	Positive denormalized, nonzero
+ *	FP_MINUS_DENORM	Negative denormalized, nonzero
+ *	FP_PLUS_ZERO	+0.0
+ *	FP_MINUS_ZERO	-0.0
+ *	FP_PLUS_INF	+INF
+ *	FP_MINUS_INF	-INF
+ *	FP_NANS		Signaling Not a Number (NaNS)
+ *	FP_NANQ		Quiet Not a Number (NaNQ)
+ */
+/*#define HAS_CLASS		/**/
+
+/* HAS_CLEARENV:
+ *	This symbol, if defined, indicates that the clearenv () routine is
+ *	available for use.
+ */
+/*#define HAS_CLEARENV		/**/
+
+/* HAS_STRUCT_CMSGHDR:
+ *	This symbol, if defined, indicates that the struct cmsghdr
+ *	is supported.
+ */
+/*#define HAS_STRUCT_CMSGHDR	/**/
+
+/* HAS_COPYSIGNL:
+ *	This symbol, if defined, indicates that the copysignl routine is
+ *	available.  If aintl is also present we can emulate modfl.
+ */
+/*#define HAS_COPYSIGNL		/**/
+
+/* USE_CPLUSPLUS:
+ *	This symbol, if defined, indicates that a C++ compiler was
+ *	used to compiled Perl and will be used to compile extensions.
+ */
+/*#define USE_CPLUSPLUS		/**/
+
+/* HAS_DBMINIT_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the dbminit() function.  Otherwise, it is up
+ *	to the program to supply one.  A good guess is
+ *		extern int dbminit(char *);
+ */
+/*#define	HAS_DBMINIT_PROTO	/**/
+
+/* HAS_DIR_DD_FD:
+ *	This symbol, if defined, indicates that the the DIR* dirstream
+ *	structure contains a member variable named dd_fd.
+ */
+/*#define HAS_DIR_DD_FD		/**/
+
+/* HAS_DIRFD:
+ *	This manifest constant lets the C program know that dirfd
+ *	is available.
+ */
+/*#define HAS_DIRFD		/**/
+
+/* DLSYM_NEEDS_UNDERSCORE:
+ *	This symbol, if defined, indicates that we need to prepend an
+ *	underscore to the symbol name before calling dlsym().  This only
+ *	makes sense if you *have* dlsym, which we will presume is the
+ *	case if you're using dl_dlopen.xs.
+ */
+/*#define 	DLSYM_NEEDS_UNDERSCORE 	/**/
+
+/* HAS_FAST_STDIO:
+ *	This symbol, if defined, indicates that the "fast stdio"
+ *	is available to manipulate the stdio buffers directly.
+ */
+#define HAS_FAST_STDIO		/**/
+
+/* HAS_FCHDIR:
+ *	This symbol, if defined, indicates that the fchdir routine is
+ *	available to change directory using a file descriptor.
+ */
+/*#define HAS_FCHDIR		/**/
+
+/* FCNTL_CAN_LOCK:
+ *	This symbol, if defined, indicates that fcntl() can be used
+ *	for file locking.  Normally on Unix systems this is defined.
+ *	It may be undefined on VMS.
+ */
+/*#define FCNTL_CAN_LOCK		/**/
+
+/* HAS_FINITE:
+ *	This symbol, if defined, indicates that the finite routine is
+ *	available to check whether a double is finite (non-infinity non-NaN).
+ */
+/*#define HAS_FINITE		/**/
+
+/* HAS_FINITEL:
+ *	This symbol, if defined, indicates that the finitel routine is
+ *	available to check whether a long double is finite
+ *	(non-infinity non-NaN).
+ */
+/*#define HAS_FINITEL		/**/
+
+/* HAS_FLOCK_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the flock() function.  Otherwise, it is up
+ *	to the program to supply one.  A good guess is
+ *		extern int flock(int, int);
+ */
+#define	HAS_FLOCK_PROTO	/**/
+
+/* HAS_FP_CLASS:
+ *	This symbol, if defined, indicates that the fp_class routine is
+ *	available to classify doubles.  Available for example in Digital UNIX.
+ *	The returned values are defined in <math.h> and are:
+ *
+ *	FP_SNAN           Signaling NaN (Not-a-Number)
+ *	FP_QNAN           Quiet NaN (Not-a-Number)
+ *	FP_POS_INF        +infinity
+ *	FP_NEG_INF        -infinity
+ *	FP_POS_NORM       Positive normalized
+ *	FP_NEG_NORM       Negative normalized
+ *	FP_POS_DENORM     Positive denormalized
+ *	FP_NEG_DENORM     Negative denormalized
+ *	FP_POS_ZERO       +0.0 (positive zero)
+ *	FP_NEG_ZERO       -0.0 (negative zero)
+ */
+/*#define HAS_FP_CLASS		/**/
+
+/* HAS_FPCLASS:
+ *	This symbol, if defined, indicates that the fpclass routine is
+ *	available to classify doubles.  Available for example in Solaris/SVR4.
+ *	The returned values are defined in <ieeefp.h> and are:
+ *
+ *	FP_SNAN		signaling NaN
+ *	FP_QNAN		quiet NaN
+ *	FP_NINF		negative infinity
+ *	FP_PINF		positive infinity
+ *	FP_NDENORM	negative denormalized non-zero
+ *	FP_PDENORM	positive denormalized non-zero
+ *	FP_NZERO	negative zero
+ *	FP_PZERO	positive zero
+ *	FP_NNORM	negative normalized non-zero
+ *	FP_PNORM	positive normalized non-zero
+ */
+/*#define HAS_FPCLASS		/**/
+
+/* HAS_FPCLASSIFY:
+ *	This symbol, if defined, indicates that the fpclassify routine is
+ *	available to classify doubles.  Available for example in HP-UX.
+ *	The returned values are defined in <math.h> and are
+ *
+ *           FP_NORMAL     Normalized
+ *           FP_ZERO       Zero
+ *           FP_INFINITE   Infinity
+ *           FP_SUBNORMAL  Denormalized
+ *           FP_NAN        NaN
+ *
+ */
+/*#define HAS_FPCLASSIFY		/**/
+
+/* HAS_FPCLASSL:
+ *	This symbol, if defined, indicates that the fpclassl routine is
+ *	available to classify long doubles.  Available for example in IRIX.
+ *	The returned values are defined in <ieeefp.h> and are:
+ *
+ *	FP_SNAN		signaling NaN
+ *	FP_QNAN		quiet NaN
+ *	FP_NINF		negative infinity
+ *	FP_PINF		positive infinity
+ *	FP_NDENORM	negative denormalized non-zero
+ *	FP_PDENORM	positive denormalized non-zero
+ *	FP_NZERO	negative zero
+ *	FP_PZERO	positive zero
+ *	FP_NNORM	negative normalized non-zero
+ *	FP_PNORM	positive normalized non-zero
+ */
+/*#define HAS_FPCLASSL		/**/
+
+/* HAS_FPOS64_T:
+ *	This symbol will be defined if the C compiler supports fpos64_t.
+ */
+/*#define	HAS_FPOS64_T    	/**/
+
+/* HAS_FREXPL:
+ *	This symbol, if defined, indicates that the frexpl routine is
+ *	available to break a long double floating-point number into
+ *	a normalized fraction and an integral power of 2.
+ */
+/*#define HAS_FREXPL		/**/
+
+/* HAS_STRUCT_FS_DATA:
+ *	This symbol, if defined, indicates that the struct fs_data
+ *	to do statfs() is supported.
+ */
+/*#define HAS_STRUCT_FS_DATA	/**/
+
+/* HAS_FSEEKO:
+ *	This symbol, if defined, indicates that the fseeko routine is
+ *	available to fseek beyond 32 bits (useful for ILP32 hosts).
+ */
+/*#define HAS_FSEEKO		/**/
+
+/* HAS_FSTATFS:
+ *	This symbol, if defined, indicates that the fstatfs routine is
+ *	available to stat filesystems by file descriptors.
+ */
+/*#define HAS_FSTATFS		/**/
+
+/* HAS_FSYNC:
+ *	This symbol, if defined, indicates that the fsync routine is
+ *	available to write a file's modified data and attributes to
+ *	permanent storage.
+ */
+/*#define HAS_FSYNC		/**/
+
+/* HAS_FTELLO:
+ *	This symbol, if defined, indicates that the ftello routine is
+ *	available to ftell beyond 32 bits (useful for ILP32 hosts).
+ */
+/*#define HAS_FTELLO		/**/
+
+/* HAS_FUTIMES:
+ *	This symbol, if defined, indicates that the futimes routine is
+ *	available to change file descriptor time stamps with struct timevals.
+ */
+/*#define HAS_FUTIMES		/**/
+
+/* HAS_GETCWD:
+ *	This symbol, if defined, indicates that the getcwd routine is
+ *	available to get the current working directory.
+ */
+#define HAS_GETCWD		/**/
+
+/* HAS_GETESPWNAM:
+ *	This symbol, if defined, indicates that the getespwnam system call is
+ *	available to retrieve enchanced (shadow) password entries by name.
+ */
+/*#define HAS_GETESPWNAM		/**/
+
+/* HAS_GETFSSTAT:
+ *	This symbol, if defined, indicates that the getfsstat routine is
+ *	available to stat filesystems in bulk.
+ */
+/*#define HAS_GETFSSTAT		/**/
+
+/* HAS_GETITIMER:
+ *	This symbol, if defined, indicates that the getitimer routine is
+ *	available to return interval timers.
+ */
+/*#define HAS_GETITIMER		/**/
+
+/* HAS_GETMNT:
+ *	This symbol, if defined, indicates that the getmnt routine is
+ *	available to get filesystem mount info by filename.
+ */
+/*#define HAS_GETMNT		/**/
+
+/* HAS_GETMNTENT:
+ *	This symbol, if defined, indicates that the getmntent routine is
+ *	available to iterate through mounted file systems to get their info.
+ */
+/*#define HAS_GETMNTENT		/**/
+
+/* HAS_GETPRPWNAM:
+ *	This symbol, if defined, indicates that the getprpwnam system call is
+ *	available to retrieve protected (shadow) password entries by name.
+ */
+/*#define HAS_GETPRPWNAM		/**/
+
+/* HAS_GETSPNAM:
+ *	This symbol, if defined, indicates that the getspnam system call is
+ *	available to retrieve SysV shadow password entries by name.
+ */
+/*#define HAS_GETSPNAM		/**/
+
+/* HAS_HASMNTOPT:
+ *	This symbol, if defined, indicates that the hasmntopt routine is
+ *	available to query the mount options of file systems.
+ */
+/*#define HAS_HASMNTOPT		/**/
+
+/* HAS_ILOGBL:
+ *	This symbol, if defined, indicates that the ilogbl routine is
+ *	available.  If scalbnl is also present we can emulate frexpl.
+ */
+/*#define HAS_ILOGBL		/**/
+
+/* HAS_INT64_T:
+ *     This symbol will defined if the C compiler supports int64_t.
+ *     Usually the <inttypes.h> needs to be included, but sometimes
+ *	<sys/types.h> is enough.
+ */
+/*#define     HAS_INT64_T               /**/
+
+/* HAS_ISFINITE:
+ *	This symbol, if defined, indicates that the isfinite routine is
+ *	available to check whether a double is finite (non-infinity non-NaN).
+ */
+/*#define HAS_ISFINITE		/**/
+
+/* HAS_ISINF:
+ *	This symbol, if defined, indicates that the isinf routine is
+ *	available to check whether a double is an infinity.
+ */
+/*#define HAS_ISINF		/**/
+
+/* HAS_ISNAN:
+ *	This symbol, if defined, indicates that the isnan routine is
+ *	available to check whether a double is a NaN.
+ */
+#define HAS_ISNAN		/**/
+
+/* HAS_ISNANL:
+ *	This symbol, if defined, indicates that the isnanl routine is
+ *	available to check whether a long double is a NaN.
+ */
+/*#define HAS_ISNANL		/**/
+
+/* HAS_LDBL_DIG:
+ *	This symbol, if defined, indicates that this system's <float.h>
+ *	or <limits.h> defines the symbol LDBL_DIG, which is the number
+ *	of significant digits in a long double precision number. Unlike
+ *	for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined.
+ */
+#define HAS_LDBL_DIG 	/**/
+
+/* LIBM_LIB_VERSION:
+ *	This symbol, if defined, indicates that libm exports _LIB_VERSION
+ *	and that math.h defines the enum to manipulate it.
+ */
+/*#define LIBM_LIB_VERSION		/**/
+
+/* HAS_MADVISE:
+ *	This symbol, if defined, indicates that the madvise system call is
+ *	available to map a file into memory.
+ */
+/*#define HAS_MADVISE		/**/
+
+/* HAS_MALLOC_SIZE:
+ *	This symbol, if defined, indicates that the malloc_size
+ *	routine is available for use.
+ */
+/*#define HAS_MALLOC_SIZE		/**/
+
+/* HAS_MALLOC_GOOD_SIZE:
+ *	This symbol, if defined, indicates that the malloc_good_size
+ *	routine is available for use.
+ */
+/*#define HAS_MALLOC_GOOD_SIZE	/**/
+
+/* HAS_MKDTEMP:
+ *	This symbol, if defined, indicates that the mkdtemp routine is
+ *	available to exclusively create a uniquely named temporary directory.
+ */
+/*#define HAS_MKDTEMP		/**/
+
+/* HAS_MKSTEMPS:
+ *	This symbol, if defined, indicates that the mkstemps routine is
+ *	available to excluslvely create and open a uniquely named
+ *	(with a suffix) temporary file.
+ */
+/*#define HAS_MKSTEMPS		/**/
+
+/* HAS_MODFL:
+ *	This symbol, if defined, indicates that the modfl routine is
+ *	available to split a long double x into a fractional part f and
+ *	an integer part i such that |f| < 1.0 and (f + i) = x.
+ */
+/* HAS_MODFL_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the modfl() function.  Otherwise, it is up
+ *	to the program to supply one.
+ */
+/* HAS_MODFL_POW32_BUG:
+ *	This symbol, if defined, indicates that the modfl routine is
+ *	broken for long doubles >= pow(2, 32).
+ *	For example from 4294967303.150000 one would get 4294967302.000000
+ *	and 1.150000.  The bug has been seen in certain versions of glibc,
+ *	release 2.2.2 is known to be okay.
+ */
+/*#define HAS_MODFL		/**/
+/*#define HAS_MODFL_PROTO		/**/
+/*#define HAS_MODFL_POW32_BUG		/**/
+
+/* HAS_MPROTECT:
+ *	This symbol, if defined, indicates that the mprotect system call is
+ *	available to modify the access protection of a memory mapped file.
+ */
+/*#define HAS_MPROTECT		/**/
+
+/* HAS_STRUCT_MSGHDR:
+ *	This symbol, if defined, indicates that the struct msghdr
+ *	is supported.
+ */
+/*#define HAS_STRUCT_MSGHDR	/**/
+
+/* HAS_NL_LANGINFO:
+ *	This symbol, if defined, indicates that the nl_langinfo routine is
+ *	available to return local data.  You will also need <langinfo.h>
+ *	and therefore I_LANGINFO.
+ */
+/*#define HAS_NL_LANGINFO		/**/
+
+/* HAS_OFF64_T:
+ *	This symbol will be defined if the C compiler supports off64_t.
+ */
+/*#define	HAS_OFF64_T    		/**/
+
+/* HAS_PROCSELFEXE:
+ *	This symbol is defined if PROCSELFEXE_PATH is a symlink
+ *	to the absolute pathname of the executing program.
+ */
+/* PROCSELFEXE_PATH:
+ *	If HAS_PROCSELFEXE is defined this symbol is the filename
+ *	of the symbolic link pointing to the absolute pathname of
+ *	the executing program.
+ */
+/*#define HAS_PROCSELFEXE	/**/
+#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH)
+#define PROCSELFEXE_PATH		/**/
+#endif
+
+/* HAS_PTHREAD_ATTR_SETSCOPE:
+ *	This symbol, if defined, indicates that the pthread_attr_setscope
+ *	system call is available to set the contention scope attribute of
+ *	a thread attribute object.
+ */
+/*#define HAS_PTHREAD_ATTR_SETSCOPE		/**/
+
+/* HAS_READV:
+ *	This symbol, if defined, indicates that the readv routine is
+ *	available to do gather reads.  You will also need <sys/uio.h>
+ *	and there I_SYSUIO.
+ */
+/*#define HAS_READV		/**/
+
+/* HAS_RECVMSG:
+ *	This symbol, if defined, indicates that the recvmsg routine is
+ *	available to send structured socket messages.
+ */
+/*#define HAS_RECVMSG		/**/
+
+/* HAS_SBRK_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the sbrk() function.  Otherwise, it is up
+ *	to the program to supply one.  Good guesses are
+ *		extern void* sbrk(int);
+ *		extern void* sbrk(size_t);
+ */
+/*#define	HAS_SBRK_PROTO	/**/
+
+/* HAS_SCALBNL:
+ *	This symbol, if defined, indicates that the scalbnl routine is
+ *	available.  If ilogbl is also present we can emulate frexpl.
+ */
+/*#define HAS_SCALBNL		/**/
+
+/* HAS_SENDMSG:
+ *	This symbol, if defined, indicates that the sendmsg routine is
+ *	available to send structured socket messages.
+ */
+/*#define HAS_SENDMSG		/**/
+
+/* HAS_SETITIMER:
+ *	This symbol, if defined, indicates that the setitimer routine is
+ *	available to set interval timers.
+ */
+/*#define HAS_SETITIMER		/**/
+
+/* HAS_SETPROCTITLE:
+ *	This symbol, if defined, indicates that the setproctitle routine is
+ *	available to set process title.
+ */
+/*#define HAS_SETPROCTITLE		/**/
+
+/* USE_SFIO:
+ *	This symbol, if defined, indicates that sfio should
+ *	be used.
+ */
+/*#define	USE_SFIO		/**/
+
+/* HAS_SIGNBIT:
+ *	This symbol, if defined, indicates that the signbit routine is
+ *	available to check if the given number has the sign bit set.
+ *	This should include correct testing of -0.0.  This will only be set
+ *	if the signbit() routine is safe to use with the NV type used internally
+ *	in perl.  Users should call Perl_signbit(), which will be #defined to
+ *	the system's signbit() function or macro if this symbol is defined.
+ */
+/*#define HAS_SIGNBIT		/**/
+
+/* HAS_SIGPROCMASK:
+ *	This symbol, if defined, indicates that the sigprocmask
+ *	system call is available to examine or change the signal mask
+ *	of the calling process.
+ */
+/*#define HAS_SIGPROCMASK		/**/
+
+/* USE_SITECUSTOMIZE:
+ *	This symbol, if defined, indicates that sitecustomize should
+ *	be used.
+ */
+#ifndef USE_SITECUSTOMIZE
+/*#define	USE_SITECUSTOMIZE		/**/
+#endif
+
+/* HAS_SNPRINTF:
+ *	This symbol, if defined, indicates that the snprintf () library
+ *	function is available for use.
+ */
+/* HAS_VSNPRINTF:
+ *	This symbol, if defined, indicates that the vsnprintf () library
+ *	function is available for use.
+ */
+#define HAS_SNPRINTF	/**/
+#define HAS_VSNPRINTF	/**/
+
+/* HAS_SOCKATMARK:
+ *	This symbol, if defined, indicates that the sockatmark routine is
+ *	available to test whether a socket is at the out-of-band mark.
+ */
+/*#define HAS_SOCKATMARK		/**/
+
+/* HAS_SOCKATMARK_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the sockatmark() function.  Otherwise, it is up
+ *	to the program to supply one.  A good guess is
+ *		extern int sockatmark(int);
+ */
+/*#define	HAS_SOCKATMARK_PROTO	/**/
+
+/* HAS_SOCKS5_INIT:
+ *	This symbol, if defined, indicates that the socks5_init routine is
+ *	available to initialize SOCKS 5.
+ */
+/*#define HAS_SOCKS5_INIT		/**/
+
+/* SPRINTF_RETURNS_STRLEN:
+ *	This variable defines whether sprintf returns the length of the string
+ *	(as per the ANSI spec). Some C libraries retain compatibility with
+ *	pre-ANSI C and return a pointer to the passed in buffer; for these
+ *	this variable will be undef.
+ */
+#define SPRINTF_RETURNS_STRLEN	/**/
+
+/* HAS_SQRTL:
+ *	This symbol, if defined, indicates that the sqrtl routine is
+ *	available to do long double square roots.
+ */
+/*#define HAS_SQRTL		/**/
+
+/* HAS_SETRESGID_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the setresgid() function.  Otherwise, it is up
+ *	to the program to supply one.  Good guesses are
+ *		extern int setresgid(uid_t ruid, uid_t euid, uid_t suid);
+ */
+/*#define	HAS_SETRESGID_PROTO	/**/
+
+/* HAS_SETRESUID_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the setresuid() function.  Otherwise, it is up
+ *	to the program to supply one.  Good guesses are
+ *		extern int setresuid(uid_t ruid, uid_t euid, uid_t suid);
+ */
+/*#define	HAS_SETRESUID_PROTO	/**/
+
+/* HAS_STRUCT_STATFS_F_FLAGS:
+ *	This symbol, if defined, indicates that the struct statfs
+ *	does have the f_flags member containing the mount flags of
+ *	the filesystem containing the file.
+ *	This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3),
+ *	not from <sys/statfs.h> (SYSV).  Older BSDs (like Ultrix) do not
+ *	have statfs() and struct statfs, they have ustat() and getmnt()
+ *	with struct ustat and struct fs_data.
+ */
+/*#define HAS_STRUCT_STATFS_F_FLAGS		/**/
+
+/* HAS_STRUCT_STATFS:
+ *	This symbol, if defined, indicates that the struct statfs
+ *	to do statfs() is supported.
+ */
+/*#define HAS_STRUCT_STATFS	/**/
+
+/* HAS_FSTATVFS:
+ *	This symbol, if defined, indicates that the fstatvfs routine is
+ *	available to stat filesystems by file descriptors.
+ */
+/*#define HAS_FSTATVFS		/**/
 
 /* HAS_STRFTIME:
  *	This symbol, if defined, indicates that the strftime routine is
@@ -3117,13 +3938,13 @@
  *	This symbol, if defined, indicates that the strlcat () routine is
  *	available to do string concatenation.
  */
-/*#define HAS_STRLCAT			/**/
+/*#define HAS_STRLCAT		/**/
 
 /* HAS_STRLCPY:
  *	This symbol, if defined, indicates that the strlcpy () routine is
  *	available to do string copying.
  */
-/*#define HAS_STRLCPY			/**/
+/*#define HAS_STRLCPY		/**/
 
 /* HAS_STRTOLD:
  *	This symbol, if defined, indicates that the strtold routine is
@@ -3143,12 +3964,6 @@
  */
 /*#define HAS_STRTOQ		/**/
 
-/* HAS_STRTOUL:
- *	This symbol, if defined, indicates that the strtoul routine is
- *	available to provide conversion of strings to unsigned long.
- */
-#define HAS_STRTOUL	/**/
-
 /* HAS_STRTOULL:
  *	This symbol, if defined, indicates that the strtoull routine is
  *	available to convert strings to unsigned long longs.
@@ -3178,49 +3993,42 @@
  */
 #define	HAS_TELLDIR_PROTO	/**/
 
-/* HAS_TIME:
- *	This symbol, if defined, indicates that the time() routine exists.
+/* HAS_CTIME64:
+ *	This symbol, if defined, indicates that the ctime64 () routine is
+ *	available to do the 64bit variant of ctime ()
  */
-/* Time_t:
- *	This symbol holds the type returned by time(). It can be long,
- *	or time_t on BSD sites (in which case <sys/types.h> should be
- *	included).
+/* HAS_LOCALTIME64:
+ *	This symbol, if defined, indicates that the localtime64 () routine is
+ *	available to do the 64bit variant of localtime ()
  */
-#define HAS_TIME		/**/
-#define Time_t time_t		/* Time type */
-
-/* HAS_TIMES:
- *	This symbol, if defined, indicates that the times() routine exists.
- *	Note that this became obsolete on some systems (SUNOS), which now
- * use getrusage(). It may be necessary to include <sys/times.h>.
+/* HAS_GMTIME64:
+ *	This symbol, if defined, indicates that the gmtime64 () routine is
+ *	available to do the 64bit variant of gmtime ()
  */
-#define HAS_TIMES		/**/
-
-/* HAS_TMPNAM_R:
- *	This symbol, if defined, indicates that the tmpnam_r routine
- *	is available to tmpnam re-entrantly.
+/* HAS_MKTIME64:
+ *	This symbol, if defined, indicates that the mktime64 () routine is
+ *	available to do the 64bit variant of mktime ()
  */
-/* TMPNAM_R_PROTO:
- *	This symbol encodes the prototype of tmpnam_r.
- *	It is zero if d_tmpnam_r is undef, and one of the
- *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r
- *	is defined.
+/* HAS_DIFFTIME64:
+ *	This symbol, if defined, indicates that the difftime64 () routine is
+ *	available to do the 64bit variant of difftime ()
  */
-/*#define HAS_TMPNAM_R	   /**/
-#define TMPNAM_R_PROTO 0	   /**/
-
-/* HAS_TTYNAME_R:
- *	This symbol, if defined, indicates that the ttyname_r routine
- *	is available to ttyname re-entrantly.
+/* HAS_ASCTIME64:
+ *	This symbol, if defined, indicates that the asctime64 () routine is
+ *	available to do the 64bit variant of asctime ()
  */
-/* TTYNAME_R_PROTO:
- *	This symbol encodes the prototype of ttyname_r.
- *	It is zero if d_ttyname_r is undef, and one of the
- *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
- *	is defined.
+/*#define	HAS_CTIME64		/**/
+/*#define	HAS_LOCALTIME64		/**/
+/*#define	HAS_GMTIME64		/**/
+/*#define	HAS_MKTIME64		/**/
+/*#define	HAS_DIFFTIME64		/**/
+/*#define	HAS_ASCTIME64		/**/
+
+/* HAS_TIMEGM:
+ *	This symbol, if defined, indicates that the timegm routine is
+ *	available to do the opposite of gmtime ()
  */
-/*#define HAS_TTYNAME_R	   /**/
-#define TTYNAME_R_PROTO 0	   /**/
+/*#define HAS_TIMEGM		/**/
 
 /* U32_ALIGNMENT_REQUIRED:
  *	This symbol, if defined, indicates that you must access
@@ -3236,28 +4044,6 @@
  */
 /*#define HAS_UALARM		/**/
 
-/* HAS_UNION_SEMUN:
- *	This symbol, if defined, indicates that the union semun is
- *	defined by including <sys/sem.h>.  If not, the user code
- *	probably needs to define it as:
- *	union semun {
- *	    int val;
- *	    struct semid_ds *buf;
- *	    unsigned short *array;
- *	}
- */
-/* USE_SEMCTL_SEMUN:
- *	This symbol, if defined, indicates that union semun is
- *	used for semctl IPC_STAT.
- */
-/* USE_SEMCTL_SEMID_DS:
- *	This symbol, if defined, indicates that struct semid_ds * is
- *	used for semctl IPC_STAT.
- */
-#define HAS_UNION_SEMUN	/**/
-/*#define USE_SEMCTL_SEMUN	/**/
-/*#define USE_SEMCTL_SEMID_DS	/**/
-
 /* HAS_UNORDERED:
  *	This symbol, if defined, indicates that the unordered routine is
  *	available to check whether two doubles are unordered
@@ -3285,39 +4071,6 @@
  */
 /*#define HAS_USTAT		/**/
 
-/* HAS_VFORK:
- *	This symbol, if defined, indicates that vfork() exists.
- */
-/*#define HAS_VFORK	/**/
-
-/* HAS_PSEUDOFORK:
- *	This symbol, if defined, indicates that an emulation of the
- *	fork routine is available.
- */
-/*#define HAS_PSEUDOFORK	/**/
-
-/* Signal_t:
- *	This symbol's value is either "void" or "int", corresponding to the
- *	appropriate return type of a signal handler.  Thus, you can declare
- *	a signal handler using "Signal_t (*handler)()", and define the
- *	handler using "Signal_t handler(sig)".
- */
-#define Signal_t void	/* Signal handler's return type */
-
-/* HAS_VPRINTF:
- *	This symbol, if defined, indicates that the vprintf routine is available
- *	to printf with a pointer to an argument list.  If unavailable, you
- *	may need to write your own, probably in terms of _doprnt().
- */
-/* USE_CHAR_VSPRINTF:
- *	This symbol is defined if this system has vsprintf() returning type
- *	(char*).  The trend seems to be to declare it as "int vsprintf()".  It
- *	is up to the package author to declare vsprintf correctly based on the
- *	symbol.
- */
-#define HAS_VPRINTF	/**/
-/*#define USE_CHAR_VSPRINTF 	/**/
-
 /* HAS_WRITEV:
  *	This symbol, if defined, indicates that the writev routine is
  *	available to do scatter writes.
@@ -3330,18 +4083,6 @@
  */
 #define USE_DYNAMIC_LOADING		/**/
 
-/* DOUBLESIZE:
- *	This symbol contains the size of a double, so that the C preprocessor
- *	can make decisions based on it.
- */
-#define DOUBLESIZE 8		/**/
-
-/* EBCDIC:
- *     This symbol, if defined, indicates that this system uses
- *	EBCDIC encoding.
- */
-/*#define	EBCDIC 		/**/
-
 /* FFLUSH_NULL:
  *	This symbol, if defined, tells that fflush(NULL) does flush
  *	all pending stdio output.
@@ -3356,50 +4097,11 @@
 #define	FFLUSH_NULL 		/**/
 /*#define	FFLUSH_ALL 		/**/
 
-/* Fpos_t:
- *	This symbol holds the type used to declare file positions in libc.
- *	It can be fpos_t, long, uint, etc... It may be necessary to include
- *	<sys/types.h> to get any typedef'ed information.
- */
-#define Fpos_t fpos_t		/* File position type */
-
-/* Gid_t_f:
- *	This symbol defines the format string used for printing a Gid_t.
- */
-#define	Gid_t_f		"ld"		/**/
-
-/* Gid_t_sign:
- *	This symbol holds the signedess of a Gid_t.
- *	1 for unsigned, -1 for signed.
+/* I_ASSERT:
+ *	This symbol, if defined, indicates that <assert.h> exists and
+ *	could be included by the C program to get the assert() macro.
  */
-#define Gid_t_sign	-1		/* GID sign */
-
-/* Gid_t_size:
- *	This symbol holds the size of a Gid_t in bytes.
- */
-#define Gid_t_size 4		/* GID size */
-
-/* Gid_t:
- *	This symbol holds the return type of getgid() and the type of
- *	argument to setrgid() and related functions.  Typically,
- *	it is the type of group ids in the kernel. It can be int, ushort,
- *	gid_t, etc... It may be necessary to include <sys/types.h> to get
- *	any typedef'ed information.
- */
-#define Gid_t gid_t		/* Type for getgid(), etc... */
-
-/* Groups_t:
- *	This symbol holds the type used for the second argument to
- *	getgroups() and setgroups().  Usually, this is the same as
- *	gidtype (gid_t) , but sometimes it isn't.
- *	It can be int, ushort, gid_t, etc... 
- *	It may be necessary to include <sys/types.h> to get any 
- *	typedef'ed information.  This is only required if you have
- *	getgroups() or setgroups()..
- */
-#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
-#define Groups_t gid_t	/* Type for 2nd arg to [sg]etgroups() */
-#endif
+#define	I_ASSERT		/**/
 
 /* I_CRYPT:
  *	This symbol, if defined, indicates that <crypt.h> exists and
@@ -3449,17 +4151,6 @@
  */
 /*#define	I_FP_CLASS		/**/
 
-/* I_GRP:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <grp.h>.
- */
-/* GRPASSWD:
- *	This symbol, if defined, indicates to the C program that struct group
- *	in <grp.h> contains gr_passwd.
- */
-/*#define I_GRP		/**/
-/*#define GRPASSWD	/**/
-
 /* I_IEEEFP:
  *	This symbol, if defined, indicates that <ieeefp.h> exists and
  *	should be included.
@@ -3484,11 +4175,11 @@
  */
 /*#define	I_LIBUTIL		/**/
 
-/* I_MACH_CTHREADS:
- *     This symbol, if defined, indicates to the C program that it should
- *     include <mach/cthreads.h>.
+/* I_MALLOCMALLOC:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <malloc/malloc.h>.
  */
-/*#define   I_MACH_CTHREADS	/**/
+/*#define I_MALLOCMALLOC		/**/
 
 /* I_MNTENT:
  *	This symbol, if defined, indicates that <mntent.h> exists and
@@ -3496,18 +4187,6 @@
  */
 /*#define	I_MNTENT		/**/
 
-/* I_NDBM:
- *	This symbol, if defined, indicates that <ndbm.h> exists and should
- *	be included.
- */
-/*#define I_NDBM	/**/
-
-/* I_NETDB:
- *	This symbol, if defined, indicates that <netdb.h> exists and
- *	should be included.
- */
-/*#define I_NETDB		/**/
-
 /* I_NETINET_TCP:
  *     This symbol, if defined, indicates to the C program that it should
  *     include <netinet/tcp.h>.
@@ -3526,58 +4205,6 @@
  */
 /*#define	I_PROT		/**/
 
-/* I_PTHREAD:
- *     This symbol, if defined, indicates to the C program that it should
- *     include <pthread.h>.
- */
-/*#define   I_PTHREAD	/**/
-
-/* I_PWD:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <pwd.h>.
- */
-/* PWQUOTA:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_quota.
- */
-/* PWAGE:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_age.
- */
-/* PWCHANGE:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_change.
- */
-/* PWCLASS:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_class.
- */
-/* PWEXPIRE:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_expire.
- */
-/* PWCOMMENT:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_comment.
- */
-/* PWGECOS:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_gecos.
- */
-/* PWPASSWD:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_passwd.
- */
-/*#define I_PWD		/**/
-/*#define PWQUOTA	/**/
-/*#define PWAGE	/**/
-/*#define PWCHANGE	/**/
-/*#define PWCLASS	/**/
-/*#define PWEXPIRE	/**/
-/*#define PWCOMMENT	/**/
-/*#define PWGECOS	/**/
-/*#define PWPASSWD	/**/
-
 /* I_SHADOW:
  *	This symbol, if defined, indicates that <shadow.h> exists and
  *	should be included.
@@ -3625,12 +4252,6 @@
  */
 /*#define	I_SYS_STATVFS		/**/
 
-/* I_SYSUIO:
- *	This symbol, if defined, indicates that <sys/uio.h> exists and
- *	should be included.
- */
-/*#define	I_SYSUIO		/**/
-
 /* I_SYSUTSNAME:
  *	This symbol, if defined, indicates that <sys/utsname.h> exists and
  *	should be included.
@@ -3643,64 +4264,12 @@
  */
 /*#define	I_SYS_VFS		/**/
 
-/* I_TIME:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <time.h>.
- */
-/* I_SYS_TIME:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <sys/time.h>.
- */
-/* I_SYS_TIME_KERNEL:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <sys/time.h> with KERNEL defined.
- */
-/* HAS_TM_TM_ZONE:
- *	This symbol, if defined, indicates to the C program that
- *	the struct tm has a tm_zone field.
- */
-/* HAS_TM_TM_GMTOFF:
- *	This symbol, if defined, indicates to the C program that
- *	the struct tm has a tm_gmtoff field.
- */
-#define I_TIME		/**/
-/*#define I_SYS_TIME		/**/
-/*#define I_SYS_TIME_KERNEL		/**/
-/*#define HAS_TM_TM_ZONE		/**/
-/*#define HAS_TM_TM_GMTOFF		/**/
-
 /* I_USTAT:
  *	This symbol, if defined, indicates that <ustat.h> exists and
  *	should be included.
  */
 /*#define	I_USTAT		/**/
 
-/* I_STDARG:
- *	This symbol, if defined, indicates that <stdarg.h> exists and should
- *	be included.
- */
-/* I_VARARGS:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <varargs.h>.
- */
-#define I_STDARG		/**/
-/*#define I_VARARGS	/**/
-
-/* PERL_INC_VERSION_LIST:
- *	This variable specifies the list of subdirectories in over
- *	which perl.c:incpush() and lib/lib.pm will automatically
- *	search when adding directories to @INC, in a format suitable
- *	for a C initialization string.  See the inc_version_list entry
- *	in Porting/Glossary for more details.
- */
-#define PERL_INC_VERSION_LIST 0		/**/
-
-/* INSTALL_USR_BIN_PERL:
- *	This symbol, if defined, indicates that Perl is to be installed
- * 	also as /usr/bin/perl.
- */
-/*#define INSTALL_USR_BIN_PERL	/**/
-
 /* PERL_PRIfldbl:
  *	This symbol, if defined, contains the string used by stdio to
  *	format long doubles (format 'f') for output.
@@ -3722,86 +4291,12 @@
 /*#define PERL_PRIeldbl	"e"	/**/
 /*#define PERL_SCNfldbl	"f"	/**/
 
-/* Off_t:
- *	This symbol holds the type used to declare offsets in the kernel.
- *	It can be int, long, off_t, etc... It may be necessary to include
- *	<sys/types.h> to get any typedef'ed information.
- */
-/* LSEEKSIZE:
- *	This symbol holds the number of bytes used by the Off_t.
- */
-/* Off_t_size:
- *	This symbol holds the number of bytes used by the Off_t.
- */
-#ifndef _MSC_VER
-#   define Off_t long long		/* <offset> type */
-#else
-#   define Off_t __int64		/* <offset> type */
-#endif
-#define LSEEKSIZE 8		/* <offset> size */
-#define Off_t_size 8	/* <offset> size */
-
 /* PERL_MAD:
  *	This symbol, if defined, indicates that the Misc Attribution
  *	Declaration code should be conditionally compiled.
  */
 /*#define	PERL_MAD		/**/
 
-/* Free_t:
- *	This variable contains the return type of free().  It is usually
- * void, but occasionally int.
- */
-/* Malloc_t:
- *	This symbol is the type of pointer returned by malloc and realloc.
- */
-#define Malloc_t void *			/**/
-#define Free_t void			/**/
-
-/* PERL_MALLOC_WRAP:
- *	This symbol, if defined, indicates that we'd like malloc wrap checks.
- */
-#define PERL_MALLOC_WRAP		/**/
-
-/* MYMALLOC:
- *	This symbol, if defined, indicates that we're using our own malloc.
- */
-/*#define MYMALLOC			/**/
-
-/* Mode_t:
- *	This symbol holds the type used to declare file modes 
- *	for systems calls.  It is usually mode_t, but may be
- *	int or unsigned short.  It may be necessary to include <sys/types.h>
- *	to get any typedef'ed information.
- */
-#define Mode_t mode_t	 /* file mode parameter for system calls */
-
-/* VAL_O_NONBLOCK:
- *	This symbol is to be used during open() or fcntl(F_SETFL) to turn on
- *	non-blocking I/O for the file descriptor. Note that there is no way
- *	back, i.e. you cannot turn it blocking again this way. If you wish to
- *	alternatively switch between blocking and non-blocking, use the
- *	ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
- */
-/* VAL_EAGAIN:
- *	This symbol holds the errno error code set by read() when no data was
- *	present on the non-blocking file descriptor.
- */
-/* RD_NODATA:
- *	This symbol holds the return code from read() when no data is present
- *	on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
- *	not defined, then you can't distinguish between no data and EOF by
- *	issuing a read(). You'll have to find another way to tell for sure!
- */
-/* EOF_NONBLOCK:
- *	This symbol, if defined, indicates to the C program that a read() on
- *	a non-blocking file descriptor will return 0 on EOF, and not the value
- *	held in RD_NODATA (-1 usually, in that case!).
- */
-#define VAL_O_NONBLOCK O_NONBLOCK
-#define VAL_EAGAIN EAGAIN
-#define RD_NODATA -1
-#define EOF_NONBLOCK
-
 /* NEED_VA_COPY:
  *	This symbol, if defined, indicates that the system stores
  *	the variable argument list datatype, va_list, in a format
@@ -3813,58 +4308,6 @@
  */
 /*#define	NEED_VA_COPY		/**/
 
-/* Netdb_host_t:
- *	This symbol holds the type used for the 1st argument
- *	to gethostbyaddr().
- */
-/* Netdb_hlen_t:
- *	This symbol holds the type used for the 2nd argument
- *	to gethostbyaddr().
- */
-/* Netdb_name_t:
- *	This symbol holds the type used for the argument to
- *	gethostbyname().
- */
-/* Netdb_net_t:
- *	This symbol holds the type used for the 1st argument to
- *	getnetbyaddr().
- */
-#define Netdb_host_t		char * /**/
-#define Netdb_hlen_t		int /**/
-#define Netdb_name_t		char * /**/
-#define Netdb_net_t		long /**/
-
-/* PERL_OTHERLIBDIRS:
- *	This variable contains a colon-separated set of paths for the perl
- *	binary to search for additional library files or modules.
- *	These directories will be tacked to the end of @INC.
- *	Perl will automatically search below each path for version-
- *	and architecture-specific directories.  See PERL_INC_VERSION_LIST
- *	for more details.
- */
-/*#define PERL_OTHERLIBDIRS ""		/**/
-
-/* HAS_QUAD:
- *	This symbol, if defined, tells that there's a 64-bit integer type,
- *	Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one
- *	of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, or QUAD_IS_INT64_T.
- */
-/*#define HAS_QUAD	/**/
-#ifdef HAS_QUAD
-#   ifndef _MSC_VER
-#	define Quad_t long long	/**/
-#	define Uquad_t unsigned long long	/**/
-#   else
-#	define Quad_t __int64	/**/
-#	define Uquad_t unsigned __int64	/**/
-#   endif
-#   define QUADKIND 5	/**/
-#   define QUAD_IS_INT	1
-#   define QUAD_IS_LONG	2
-#   define QUAD_IS_LONG_LONG	3
-#   define QUAD_IS_INT64_T	4
-#endif
-
 /* IVTYPE:
  *	This symbol defines the C type used for Perl's IV.
  */
@@ -3939,7 +4382,13 @@
  *	This symbol contains the number of bits a variable of type NVTYPE
  *	can preserve of a variable of type UVTYPE.
  */
-/* NV_ZERO_IS_ALLBITS_ZERO
+/* NV_OVERFLOWS_INTEGERS_AT:
+ *	This symbol gives the largest integer value that NVs can hold. This
+ *	value + 1.0 cannot be stored accurately. It is expressed as constant
+ *	floating point expression to reduce the chance of decimale/binary
+ *	conversion issues. If it can not be determined, the value 0 is given.
+ */
+/* NV_ZERO_IS_ALLBITS_ZERO:
  *	This symbol, if defined, indicates that a variable of type NVTYPE
  *	stores 0.0 in memory as all bits zero.
  */
@@ -3976,8 +4425,9 @@
 #define	NVSIZE		8		/**/
 #define	NV_PRESERVES_UV
 #define	NV_PRESERVES_UV_BITS	32
-#define NV_ZERO_IS_ALLBITS_ZERO
-#if 4 == 8
+#define	NV_OVERFLOWS_INTEGERS_AT	256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0
+#define	NV_ZERO_IS_ALLBITS_ZERO
+#if UVSIZE == 8
 #   ifdef BYTEORDER
 #       if BYTEORDER == 0x1234
 #           undef BYTEORDER
@@ -4032,77 +4482,6 @@
 #define	NVff		"f"		/**/
 #define	NVgf		"g"		/**/
 
-/* Pid_t:
- *	This symbol holds the type used to declare process ids in the kernel.
- *	It can be int, uint, pid_t, etc... It may be necessary to include
- *	<sys/types.h> to get any typedef'ed information.
- */
-#define Pid_t int		/* PID type */
-
-/* PRIVLIB:
- *	This symbol contains the name of the private library for this package.
- *	The library is private in the sense that it needn't be in anyone's
- *	execution path, but it should be accessible by the world.  The program
- *	should be prepared to do ~ expansion.
- */
-/* PRIVLIB_EXP:
- *	This symbol contains the ~name expanded version of PRIVLIB, to be used
- *	in programs that are not prepared to deal with ~ expansion at run-time.
- */
-#define PRIVLIB "c:\\perl\\5.10.0\\lib"		/**/
-#define PRIVLIB_EXP (win32_get_privlib("5.10.0"))	/**/
-
-/* CAN_PROTOTYPE:
- *	If defined, this macro indicates that the C compiler can handle
- *	function prototypes.
- */
-/* _:
- *	This macro is used to declare function parameters for folks who want
- *	to make declarations with prototypes using a different style than
- *	the above macros.  Use double parentheses.  For example:
- *
- *		int main _((int argc, char *argv[]));
- */
-#define	CAN_PROTOTYPE	/**/
-#ifdef CAN_PROTOTYPE
-#define	_(args) args
-#else
-#define	_(args) ()
-#endif
-
-/* PTRSIZE:
- *	This symbol contains the size of a pointer, so that the C preprocessor
- *	can make decisions based on it.  It will be sizeof(void *) if
- *	the compiler supports (void *); otherwise it will be
- *	sizeof(char *).
- */
-#define PTRSIZE 4		/**/
-
-/* Drand01:
- *	This macro is to be used to generate uniformly distributed
- *	random numbers over the range [0., 1.[.  You may have to supply
- *	an 'extern double drand48();' in your program since SunOS 4.1.3
- *	doesn't provide you with anything relevant in its headers.
- *	See HAS_DRAND48_PROTO.
- */
-/* Rand_seed_t:
- *	This symbol defines the type of the argument of the
- *	random seed function.
- */
-/* seedDrand01:
- *	This symbol defines the macro to be used in seeding the
- *	random number generator (see Drand01).
- */
-/* RANDBITS:
- *	This symbol indicates how many bits are produced by the
- *	function used to generate normalized random numbers.
- *	Values include 15, 16, 31, and 48.
- */
-#define Drand01()		(rand()/(double)((unsigned)1<<RANDBITS))		/**/
-#define Rand_seed_t		unsigned		/**/
-#define seedDrand01(x)	srand((Rand_seed_t)x)	/**/
-#define RANDBITS		15		/**/
-
 /* SELECT_MIN_BITS:
  *	This symbol holds the minimum number of bits operated by select.
  *	That is, if you do select(n, ...), how many bits at least will be
@@ -4112,134 +4491,6 @@
  */
 #define SELECT_MIN_BITS 	32	/**/
 
-/* Select_fd_set_t:
- *	This symbol holds the type used for the 2nd, 3rd, and 4th
- *	arguments to select.  Usually, this is 'fd_set *', if HAS_FD_SET
- *	is defined, and 'int *' otherwise.  This is only useful if you 
- *	have select(), of course.
- */
-#define Select_fd_set_t 	Perl_fd_set *	/**/
-
-/* SH_PATH:
- *	This symbol contains the full pathname to the shell used on this
- *	on this system to execute Bourne shell scripts.  Usually, this will be
- *	/bin/sh, though it's possible that some systems will have /bin/ksh,
- *	/bin/pdksh, /bin/ash, /bin/bash, or even something such as
- *	D:/bin/sh.exe.
- */
-#define SH_PATH "cmd /x /c"  /**/
-
-/* SIG_NAME:
- *	This symbol contains a list of signal names in order of
- *	signal number. This is intended
- *	to be used as a static array initialization, like this:
- *		char *sig_name[] = { SIG_NAME };
- *	The signals in the list are separated with commas, and each signal
- *	is surrounded by double quotes. There is no leading SIG in the signal
- *	name, i.e. SIGQUIT is known as "QUIT".
- *	Gaps in the signal numbers (up to NSIG) are filled in with NUMnn,
- *	etc., where nn is the actual signal number (e.g. NUM37).
- *	The signal number for sig_name[i] is stored in sig_num[i].
- *	The last element is 0 to terminate the list with a NULL.  This
- *	corresponds to the 0 at the end of the sig_name_init list.
- *	Note that this variable is initialized from the sig_name_init,
- *	not from sig_name (which is unused).
- */
-/* SIG_NUM:
- *	This symbol contains a list of signal numbers, in the same order as the
- *	SIG_NAME list. It is suitable for static array initialization, as in:
- *		int sig_num[] = { SIG_NUM };
- *	The signals in the list are separated with commas, and the indices
- *	within that list and the SIG_NAME list match, so it's easy to compute
- *	the signal name from a number or vice versa at the price of a small
- *	dynamic linear lookup. 
- *	Duplicates are allowed, but are moved to the end of the list.
- *	The signal number corresponding to sig_name[i] is sig_number[i].
- *	if (i < NSIG) then sig_number[i] == i.  
- *	The last element is 0, corresponding to the 0 at the end of
- *	the sig_name_init list.
- *	Note that this variable is initialized from the sig_num_init,
- *	not from sig_num (which is unused).
- */
-/* SIG_SIZE:
- *	This variable contains the number of elements of the SIG_NAME
- *	and SIG_NUM arrays, excluding the final NULL entry.
- */
-#define SIG_NAME "ZERO", "HUP", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "NUM16", "NUM17", "NUM18", "NUM19", "CHLD", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0		/**/
-#define SIG_NUM  0, 1, 2, 21, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 20, 0		/**/
-#define SIG_SIZE 27			/**/
-
-/* SITEARCH:
- *	This symbol contains the name of the private library for this package.
- *	The library is private in the sense that it needn't be in anyone's
- *	execution path, but it should be accessible by the world.  The program
- *	should be prepared to do ~ expansion.
- *	The standard distribution will put nothing in this directory.
- *	After perl has been installed, users may install their own local
- *	architecture-dependent modules in this directory with
- *		MakeMaker Makefile.PL
- *	or equivalent.  See INSTALL for details.
- */
-/* SITEARCH_EXP:
- *	This symbol contains the ~name expanded version of SITEARCH, to be used
- *	in programs that are not prepared to deal with ~ expansion at run-time.
- */
-#define SITEARCH "c:\\perl\\site\\5.10.0\\lib\\MSWin32-x86"		/**/
-/*#define SITEARCH_EXP ""	/**/
-
-/* SITELIB:
- *	This symbol contains the name of the private library for this package.
- *	The library is private in the sense that it needn't be in anyone's
- *	execution path, but it should be accessible by the world.  The program
- *	should be prepared to do ~ expansion.
- *	The standard distribution will put nothing in this directory.
- *	After perl has been installed, users may install their own local
- *	architecture-independent modules in this directory with
- *		MakeMaker Makefile.PL
- *	or equivalent.  See INSTALL for details.
- */
-/* SITELIB_EXP:
- *	This symbol contains the ~name expanded version of SITELIB, to be used
- *	in programs that are not prepared to deal with ~ expansion at run-time.
- */
-/* SITELIB_STEM:
- *	This define is SITELIB_EXP with any trailing version-specific component
- *	removed.  The elements in inc_version_list (inc_version_list.U) can
- *	be tacked onto this variable to generate a list of directories to search.
- */
-#define SITELIB "c:\\perl\\site\\5.10.0\\lib"		/**/
-#define SITELIB_EXP (win32_get_sitelib("5.10.0"))	/**/
-#define SITELIB_STEM ""		/**/
-
-/* Size_t_size:
- *	This symbol holds the size of a Size_t in bytes.
- */
-#define Size_t_size 4		/**/
-
-/* Size_t:
- *	This symbol holds the type used to declare length parameters
- *	for string functions.  It is usually size_t, but may be
- *	unsigned long, int, etc.  It may be necessary to include
- *	<sys/types.h> to get any typedef'ed information.
- */
-#define Size_t size_t	 /* length paramater for string functions */
-
-/* Sock_size_t:
- *	This symbol holds the type used for the size argument of
- *	various socket calls (just the base type, not the pointer-to).
- */
-#define Sock_size_t		int /**/
-
-/* SSize_t:
- *	This symbol holds the type used by functions that return
- *	a count of bytes or an error condition.  It must be a signed type.
- *	It is usually ssize_t, but may be long or int, etc.
- *	It may be necessary to include <sys/types.h> or <unistd.h>
- *	to get any typedef'ed information.
- *	We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
- */
-#define SSize_t int	 /* signed count of bytes */
-
 /* STARTPERL:
  *	This variable contains the string to put in front of a perl
  *	script to make sure (one hopes) that it runs with perl and not
@@ -4247,12 +4498,6 @@
  */
 #define STARTPERL "#!perl"		/**/
 
-/* STDCHAR:
- *	This symbol is defined to be the type of char used in stdio.h.
- *	It has the values "unsigned char" or "char".
- */
-#define STDCHAR char	/**/
-
 /* HAS_STDIO_STREAM_ARRAY:
  *	This symbol, if defined, tells that there is an array
  *	holding the stdio streams.
@@ -4262,30 +4507,30 @@
  *	Usual values include _iob, __iob, and __sF.
  */
 /*#define	HAS_STDIO_STREAM_ARRAY	/**/
+#ifdef HAS_STDIO_STREAM_ARRAY
 #define STDIO_STREAM_ARRAY	
+#endif
 
-/* Uid_t_f:
- *	This symbol defines the format string used for printing a Uid_t.
+/* GMTIME_MAX:
+ *	This symbol contains the maximum value for the time_t offset that
+ *	the system function gmtime () accepts, and defaults to 0
  */
-#define	Uid_t_f		"ld"		/**/
-
-/* Uid_t_sign:
- *	This symbol holds the signedess of a Uid_t.
- *	1 for unsigned, -1 for signed.
+/* GMTIME_MIN:
+ *	This symbol contains the minimum value for the time_t offset that
+ *	the system function gmtime () accepts, and defaults to 0
  */
-#define Uid_t_sign	-1		/* UID sign */
-
-/* Uid_t_size:
- *	This symbol holds the size of a Uid_t in bytes.
+/* LOCALTIME_MAX:
+ *	This symbol contains the maximum value for the time_t offset that
+ *	the system function localtime () accepts, and defaults to 0
  */
-#define Uid_t_size 4		/* UID size */
-
-/* Uid_t:
- *	This symbol holds the type used to declare user ids in the kernel.
- *	It can be int, ushort, uid_t, etc... It may be necessary to include
- *	<sys/types.h> to get any typedef'ed information.
+/* LOCALTIME_MIN:
+ *	This symbol contains the minimum value for the time_t offset that
+ *	the system function localtime () accepts, and defaults to 0
  */
-#define Uid_t uid_t		/* UID type */
+#define GMTIME_MAX		2147483647	/**/
+#define GMTIME_MIN		0	/**/
+#define LOCALTIME_MAX	2147483647	/**/
+#define LOCALTIME_MIN	0	/**/
 
 /* USE_64_BIT_INT:
  *	This symbol, if defined, indicates that 64-bit integers should
@@ -4308,18 +4553,23 @@
 #ifndef USE_64_BIT_INT
 /*#define	USE_64_BIT_INT		/**/
 #endif
-
 #ifndef USE_64_BIT_ALL
 /*#define	USE_64_BIT_ALL		/**/
 #endif
 
+/* USE_DTRACE:
+ *	This symbol, if defined, indicates that Perl should
+ *	be built with support for DTrace.
+ */
+/*#define USE_DTRACE		/**/
+
 /* USE_FAST_STDIO:
  *	This symbol, if defined, indicates that Perl should
  *	be built to use 'fast stdio'.
  *	Defaults to define in Perls 5.8 and earlier, to undef later.
  */
 #ifndef USE_FAST_STDIO
-/*#define	USE_FAST_STDIO		/ **/
+/*#define	USE_FAST_STDIO		/**/
 #endif
 
 /* USE_LARGE_FILES:
@@ -4371,91 +4621,4 @@
 /*#define	USE_SOCKS		/**/
 #endif
 
-/* USE_ITHREADS:
- *	This symbol, if defined, indicates that Perl should be built to
- *	use the interpreter-based threading implementation.
- */
-/* USE_5005THREADS:
- *	This symbol, if defined, indicates that Perl should be built to
- *	use the 5.005-based threading implementation.
- */
-/* OLD_PTHREADS_API:
- *	This symbol, if defined, indicates that Perl should
- *	be built to use the old draft POSIX threads API.
- */
-/* USE_REENTRANT_API:
- *	This symbol, if defined, indicates that Perl should
- *	try to use the various _r versions of library functions.
- *	This is extremely experimental.
- */
-/*#define	USE_5005THREADS		/**/
-/*#define	USE_ITHREADS		/**/
-#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
-#define		USE_THREADS		/* until src is revised*/
-#endif
-/*#define	OLD_PTHREADS_API		/**/
-/*#define	USE_REENTRANT_API	/**/
-
-/* PERL_VENDORARCH:
- *	If defined, this symbol contains the name of a private library.
- *	The library is private in the sense that it needn't be in anyone's
- *	execution path, but it should be accessible by the world.
- *	It may have a ~ on the front.
- *	The standard distribution will put nothing in this directory.
- *	Vendors who distribute perl may wish to place their own
- *	architecture-dependent modules and extensions in this directory with
- *		MakeMaker Makefile.PL INSTALLDIRS=vendor
- *	or equivalent.  See INSTALL for details.
- */
-/* PERL_VENDORARCH_EXP:
- *	This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used
- *	in programs that are not prepared to deal with ~ expansion at run-time.
- */
-/*#define PERL_VENDORARCH ""		/**/
-/*#define PERL_VENDORARCH_EXP ""		/**/
-
-/* PERL_VENDORLIB_EXP:
- *	This symbol contains the ~name expanded version of VENDORLIB, to be used
- *	in programs that are not prepared to deal with ~ expansion at run-time.
- */
-/* PERL_VENDORLIB_STEM:
- *	This define is PERL_VENDORLIB_EXP with any trailing version-specific component
- *	removed.  The elements in inc_version_list (inc_version_list.U) can
- *	be tacked onto this variable to generate a list of directories to search.
- */
-/*#define PERL_VENDORLIB_EXP ""		/**/
-/*#define PERL_VENDORLIB_STEM ""		/**/
-
-/* VOIDFLAGS:
- *	This symbol indicates how much support of the void type is given by this
- *	compiler.  What various bits mean:
- *
- *	    1 = supports declaration of void
- *	    2 = supports arrays of pointers to functions returning void
- *	    4 = supports comparisons between pointers to void functions and
- *		    addresses of void functions
- *	    8 = suports declaration of generic void pointers
- *
- *	The package designer should define VOIDUSED to indicate the requirements
- *	of the package.  This can be done either by #defining VOIDUSED before
- *	including config.h, or by defining defvoidused in Myinit.U.  If the
- *	latter approach is taken, only those flags will be tested.  If the
- *	level of void support necessary is not present, defines void to int.
- */
-#ifndef VOIDUSED
-#define VOIDUSED 15
-#endif
-#define VOIDFLAGS 15
-#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
-#define void int		/* is void to be avoided? */
-#define M_VOID			/* Xenix strikes again */
-#endif
-
-/* HAS_POLL:
- *	This symbol, if defined, indicates that the poll routine is
- *	available to poll active file descriptors. You may safely
- *	include <poll.h> when both this symbol *and* I_POLL are defined.
- */
-/*#define HAS_POLL		/**/
-
 #endif
diff --git a/gnu/usr.bin/perl/win32/config_H.vc b/gnu/usr.bin/perl/win32/config_H.vc
index 1a02400848c..37ac2bae94e 100644
--- a/gnu/usr.bin/perl/win32/config_H.vc
+++ b/gnu/usr.bin/perl/win32/config_H.vc
@@ -7,14 +7,14 @@
  * that running config_h.SH again will wipe out any changes you've made.
  * For a more permanent change edit undef and rerun config_h.SH.
  *
- * $Id: Config_h.U,v 3.0.1.5 1997/02/28 14:57:43 ram Exp $
+ * $Id: Config_h.U 1 2006-08-24 12:32:52Z rmanfredi $
  */
 
 /*
  * Package name      : perl5
  * Source directory  : 
- * Configuration time: Mon Mar 17 20:15:35 2003
- * Configured by     : gsar
+ * Configuration time: Fri Dec 12 15:19:23 2008
+ * Configured by     : shay
  * Target system     : 
  */
 
@@ -68,16 +68,11 @@
  */
 #define	HAS_CHSIZE		/**/
 
-/* HASCONST:
- *	This symbol, if defined, indicates that this C compiler knows about
- *	the const type. There is no need to actually test for that symbol
- *	within your programs. The mere use of the "const" keyword will
- *	trigger the necessary tests.
+/* HAS_CRYPT:
+ *	This symbol, if defined, indicates that the crypt routine is available
+ *	to encrypt passwords and the like.
  */
-#define HASCONST	/**/
-#ifndef HASCONST
-#define const
-#endif
+/*#define HAS_CRYPT		/**/
 
 /* HAS_CTERMID:
  *	This symbol, if defined, indicates that the ctermid routine is
@@ -112,6 +107,26 @@
  */
 #define HAS_DLERROR	/**/
 
+/* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ *	This symbol, if defined, indicates that the bug that prevents
+ *	setuid scripts from being secure is not present in this kernel.
+ */
+/* DOSUID:
+ *	This symbol, if defined, indicates that the C program should
+ *	check the script that it is executing for setuid/setgid bits, and
+ *	attempt to emulate setuid/setgid on systems that have disabled
+ *	setuid #! scripts because the kernel can't do it securely.
+ *	It is up to the package designer to make sure that this emulation
+ *	is done securely.  Among other things, it should do an fstat on
+ *	the script it just opened to make sure it really is a setuid/setgid
+ *	script, it should make sure the arguments passed correspond exactly
+ *	to the argument on the #! line, and it should not trust any
+ *	subprocesses to which it must pass the filename rather than the
+ *	file descriptor of the script to be executed.
+ */
+/*#define SETUID_SCRIPTS_ARE_SECURE_NOW	/**/
+/*#define DOSUID		/**/
+
 /* HAS_DUP2:
  *	This symbol, if defined, indicates that the dup2 routine is
  *	available to duplicate file descriptors.
@@ -355,6 +370,13 @@
  */
 #define HAS_PIPE		/**/
 
+/* HAS_POLL:
+ *	This symbol, if defined, indicates that the poll routine is
+ *	available to poll active file descriptors.  Please check I_POLL and
+ *	I_SYS_POLL to know which header should be included as well.
+ */
+/*#define HAS_POLL		/**/
+
 /* HAS_READDIR:
  *	This symbol, if defined, indicates that the readdir routine is
  *	available to read directory entries. You may have to include
@@ -419,6 +441,13 @@
  */
 /*#define HAS_SETEUID		/**/
 
+/* HAS_SETGROUPS:
+ *	This symbol, if defined, indicates that the setgroups() routine is
+ *	available to set the list of process groups.  If unavailable, multiple
+ *	groups are probably not supported.
+ */
+/*#define HAS_SETGROUPS		/**/
+
 /* HAS_SETLINEBUF:
  *	This symbol, if defined, indicates that the setlinebuf routine is
  *	available to change stderr or stdout from block-buffered or unbuffered
@@ -512,13 +541,6 @@
  */
 #define HAS_STRCOLL	/**/
 
-/* USE_STRUCT_COPY:
- *	This symbol, if defined, indicates that this C compiler knows how
- *	to copy structures.  If undefined, you'll need to use a block copy
- *	routine of some sort instead.
- */
-#define	USE_STRUCT_COPY	/**/
-
 /* HAS_STRTOD:
  *	This symbol, if defined, indicates that the strtod routine is
  *	available to provide better numeric string conversion than atof().
@@ -597,15 +619,6 @@
  */
 /*#define HAS_USLEEP		/**/
 
-/* HASVOLATILE:
- *	This symbol, if defined, indicates that this C compiler knows about
- *	the volatile declaration.
- */
-#define	HASVOLATILE	/**/
-#ifndef HASVOLATILE
-#define volatile
-#endif
-
 /* HAS_WAIT4:
  *	This symbol, if defined, indicates that wait4() exists.
  */
@@ -629,6 +642,19 @@
  */
 #define HAS_WCTOMB		/**/
 
+/* Groups_t:
+ *	This symbol holds the type used for the second argument to
+ *	getgroups() and setgroups().  Usually, this is the same as
+ *	gidtype (gid_t) , but sometimes it isn't.
+ *	It can be int, ushort, gid_t, etc... 
+ *	It may be necessary to include <sys/types.h> to get any 
+ *	typedef'ed information.  This is only required if you have
+ *	getgroups() or setgroups()..
+ */
+#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
+#define Groups_t gid_t	/* Type for 2nd arg to [sg]etgroups() */
+#endif
+
 /* I_ARPA_INET:
  *	This symbol, if defined, indicates to the C program that it should
  *	include <arpa/inet.h> to get inet_addr and friends declarations.
@@ -646,26 +672,6 @@
 /*#define I_DBM	/**/
 #define I_RPCSVC_DBM	/**/
 
-/* I_DIRENT:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <dirent.h>. Using this symbol also triggers the definition
- *	of the Direntry_t define which ends up being 'struct dirent' or
- *	'struct direct' depending on the availability of <dirent.h>.
- */
-/* DIRNAMLEN:
- *	This symbol, if defined, indicates to the C program that the length
- *	of directory entry names is provided by a d_namlen field.  Otherwise
- *	you need to do strlen() on the d_name field.
- */
-/* Direntry_t:
- *	This symbol is set to 'struct direct' or 'struct dirent' depending on
- *	whether dirent is available or not. You should use this pseudo type to
- *	portably declare your directory entries.
- */
-#define I_DIRENT		/**/
-#define DIRNAMLEN	/**/
-#define Direntry_t struct direct
-
 /* I_DLFCN:
  *	This symbol, if defined, indicates that <dlfcn.h> exists and should
  *	be included.
@@ -684,6 +690,12 @@
  */
 #define I_FLOAT		/**/
 
+/* I_GDBM:
+ *	This symbol, if defined, indicates that <gdbm.h> exists and should
+ *	be included.
+ */
+/*#define I_GDBM	/**/
+
 /* I_LIMITS:
  *	This symbol, if defined, indicates to the C program that it should
  *	include <limits.h> to get definition of symbols like WORD_BIT or
@@ -709,12 +721,6 @@
  */
 /*#define I_MEMORY		/**/
 
-/* I_NET_ERRNO:
- *	This symbol, if defined, indicates that <net/errno.h> exists and 
- *	should be included.
- */
-/*#define I_NET_ERRNO		/**/
-
 /* I_NETINET_IN:
  *	This symbol, if defined, indicates to the C program that it should
  *	include <netinet/in.h>. Otherwise, you may try <sys/in.h>.
@@ -780,6 +786,13 @@
  */
 /*#define I_SYS_PARAM		/**/
 
+/* I_SYS_POLL:
+ *	This symbol, if defined, indicates that the program may include
+ *	<sys/poll.h>.  When I_POLL is also defined, it's probably safest
+ *	to only include <poll.h>.
+ */
+/*#define I_SYS_POLL	/**/
+
 /* I_SYS_RESOURCE:
  *	This symbol, if defined, indicates to the C program that it should
  *	include <sys/resource.h>.
@@ -868,40 +881,53 @@
  */
 /*#define I_VFORK	/**/
 
-/* HAS_ACCESSX:
- *	This symbol, if defined, indicates that the accessx routine is
- *	available to do extended access checks.
+/* INTSIZE:
+ *	This symbol contains the value of sizeof(int) so that the C
+ *	preprocessor can make decisions based on it.
  */
-/*#define HAS_ACCESSX		/**/
-
-/* HAS_EACCESS:
- *	This symbol, if defined, indicates that the eaccess routine is
- *	available to do extended access checks.
+/* LONGSIZE:
+ *	This symbol contains the value of sizeof(long) so that the C
+ *	preprocessor can make decisions based on it.
  */
-/*#define HAS_EACCESS		/**/
-
-/* I_SYS_ACCESS:
- *     This symbol, if defined, indicates to the C program that it should
- *     include <sys/access.h>.
+/* SHORTSIZE:
+ *	This symbol contains the value of sizeof(short) so that the C
+ *	preprocessor can make decisions based on it.
  */
-/*#define   I_SYS_ACCESS                /**/
+#define INTSIZE 4		/**/
+#define LONGSIZE 4		/**/
+#define SHORTSIZE 2		/**/
 
-/* I_SYS_SECURITY:
- *     This symbol, if defined, indicates to the C program that it should
- *     include <sys/security.h>.
+/* MULTIARCH:
+ *	This symbol, if defined, signifies that the build
+ *	process will produce some binary files that are going to be
+ *	used in a cross-platform environment.  This is the case for
+ *	example with the NeXT "fat" binaries that contain executables
+ *	for several CPUs.
  */
-/*#define   I_SYS_SECURITY	/**/
+/*#define MULTIARCH		/**/
 
-/* USE_CROSS_COMPILE:
- *	This symbol, if defined, indicates that Perl is being cross-compiled.
- */
-/* PERL_TARGETARCH:
- *	This symbol, if defined, indicates the target architecture
- *	Perl has been cross-compiled to.  Undefined if not a cross-compile.
+/* HAS_QUAD:
+ *	This symbol, if defined, tells that there's a 64-bit integer type,
+ *	Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one
+ *	of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, QUAD_IS_INT64_T.
+ *	or QUAD_IS___INT64.
  */
-#ifndef USE_CROSS_COMPILE
-/*#define	USE_CROSS_COMPILE	/**/
-#define	PERL_TARGETARCH	""	/**/
+#define HAS_QUAD	/**/
+#ifdef HAS_QUAD
+#   ifndef __GNUC__
+#	define Quad_t __int64	/**/
+#	define Uquad_t unsigned __int64	/**/
+#	define QUADKIND 5	/**/
+#   else
+#	define Quad_t long long	/**/
+#	define Uquad_t unsigned long long	/**/
+#	define QUADKIND 3	/**/
+#   endif
+#   define QUAD_IS_INT	1
+#   define QUAD_IS_LONG	2
+#   define QUAD_IS_LONG_LONG	3
+#   define QUAD_IS_INT64_T	4
+#   define QUAD_IS___INT64	5
 #endif
 
 /* OSNAME:
@@ -915,27 +941,7 @@
  *	feature tests from Configure are generally more reliable.
  */
 #define OSNAME "MSWin32"		/**/
-#define OSVERS "4.0"		/**/
-
-/* MULTIARCH:
- *	This symbol, if defined, signifies that the build
- *	process will produce some binary files that are going to be
- *	used in a cross-platform environment.  This is the case for
- *	example with the NeXT "fat" binaries that contain executables
- *	for several CPUs.
- */
-/*#define MULTIARCH		/**/
-
-/* MEM_ALIGNBYTES:
- *	This symbol contains the number of bytes required to align a
- *	double, or a long double when applicable. Usual values are 2,
- *	4 and 8. The default is eight, for safety.
- */
-#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH)
-#  define MEM_ALIGNBYTES 8
-#else
-#define MEM_ALIGNBYTES 8
-#endif
+#define OSVERS "5.1"		/**/
 
 /* ARCHLIB:
  *	This variable, if defined, holds the name of the directory in
@@ -950,7 +956,7 @@
  *	This symbol contains the ~name expanded version of ARCHLIB, to be used
  *	in programs that are not prepared to deal with ~ expansion at run-time.
  */
-#define ARCHLIB "c:\\perl\\5.10.0\\lib\\MSWin32-x86"		/**/
+#define ARCHLIB "c:\\perl\\lib"		/**/
 /*#define ARCHLIB_EXP ""	/**/
 
 /* ARCHNAME:
@@ -961,18 +967,6 @@
  */
 #define ARCHNAME "MSWin32-x86"		/**/
 
-/* HAS_ATOLF:
- *	This symbol, if defined, indicates that the atolf routine is
- *	available to convert strings into long doubles.
- */
-/*#define HAS_ATOLF		/**/
-
-/* HAS_ATOLL:
- *	This symbol, if defined, indicates that the atoll routine is
- *	available to convert strings into long longs.
- */
-/*#define HAS_ATOLL		/**/
-
 /* BIN:
  *	This symbol holds the path of the bin directory where the package will
  *	be installed. Program must be prepared to deal with ~name substitution.
@@ -985,68 +979,9 @@
  *	This symbol, if defined, indicates that we'd like to relocate entries
  *	in @INC at run time based on the location of the perl binary.
  */
-#define BIN "c:\\perl\\5.10.0\\bin\\MSWin32-x86"	/**/
-#define BIN_EXP "c:\\perl\\5.10.0\\bin\\MSWin32-x86"	/**/
-/*#define PERL_RELOCATABLE_INC "" 		/**/
-
-/* INTSIZE:
- *	This symbol contains the value of sizeof(int) so that the C
- *	preprocessor can make decisions based on it.
- */
-/* LONGSIZE:
- *	This symbol contains the value of sizeof(long) so that the C
- *	preprocessor can make decisions based on it.
- */
-/* SHORTSIZE:
- *	This symbol contains the value of sizeof(short) so that the C
- *	preprocessor can make decisions based on it.
- */
-#define INTSIZE 4		/**/
-#define LONGSIZE 4		/**/
-#define SHORTSIZE 2		/**/
-
-/* BYTEORDER:
- *	This symbol holds the hexadecimal constant defined in byteorder,
- *	in a UV, i.e. 0x1234 or 0x4321 or 0x12345678, etc...
- *	If the compiler supports cross-compiling or multiple-architecture
- *	binaries (eg. on NeXT systems), use compiler-defined macros to
- *	determine the byte order.
- *	On NeXT 3.2 (and greater), you can build "Fat" Multiple Architecture
- *	Binaries (MAB) on either big endian or little endian machines.
- *	The endian-ness is available at compile-time.  This only matters
- *	for perl, where the config.h can be generated and installed on 
- *	one system, and used by a different architecture to build an
- *	extension.  Older versions of NeXT that might not have
- *	defined either *_ENDIAN__ were all on Motorola 680x0 series,
- *	so the default case (for NeXT) is big endian to catch them. 
- *	This might matter for NeXT 3.0.
- */
-#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH)
-#  ifdef __LITTLE_ENDIAN__
-#    if LONGSIZE == 4
-#      define BYTEORDER 0x1234
-#    else
-#      if LONGSIZE == 8
-#        define BYTEORDER 0x12345678
-#      endif
-#    endif
-#  else
-#    ifdef __BIG_ENDIAN__
-#      if LONGSIZE == 4
-#        define BYTEORDER 0x4321
-#      else
-#        if LONGSIZE == 8
-#          define BYTEORDER 0x87654321
-#        endif
-#      endif
-#    endif
-#  endif
-#  if !defined(BYTEORDER) && (defined(NeXT) || defined(__NeXT__))
-#    define BYTEORDER 0x4321
-#  endif
-#else
-#define BYTEORDER 0x1234	/* large digits for MSB */
-#endif /* NeXT */
+#define BIN "c:\\perl\\bin"	/**/
+#define BIN_EXP "c:\\perl\\bin"	/**/
+#define PERL_RELOCATABLE_INC "undef" 		/**/
 
 /* CAT2:
  *	This macro concatenates 2 tokens together.
@@ -1057,19 +992,16 @@
 #if 42 == 1
 #define CAT2(a,b)	a/**/b
 #define STRINGIFY(a)	"a"
-		/* If you can get stringification with catify, tell me how! */
 #endif
 #if 42 == 42
-#define PeRl_CaTiFy(a, b)	a ## b	
+#define PeRl_CaTiFy(a, b)	a ## b
 #define PeRl_StGiFy(a)	#a
-/* the additional level of indirection enables these macros to be
- * used as arguments to other macros.  See K&R 2nd ed., page 231. */
 #define CAT2(a,b)	PeRl_CaTiFy(a,b)
 #define StGiFy(a)	PeRl_StGiFy(a)
 #define STRINGIFY(a)	PeRl_StGiFy(a)
 #endif
 #if 42 != 1 && 42 != 42
-#   include "Bletch: How does this C preprocessor concatenate tokens?"
+#include "Bletch: How does this C preprocessor concatenate tokens?"
 #endif
 
 /* CPPSTDIN:
@@ -1108,12 +1040,6 @@
 #endif
 #define CPPLAST ""
 
-/* HAS__FWALK:
- *	This symbol, if defined, indicates that the _fwalk system call is
- *	available to apply a function to all the file handles.
- */
-/*#define HAS__FWALK		/**/
-
 /* HAS_ACCESS:
  *	This manifest constant lets the C program know that the access()
  *	system call is available to check for accessibility using real UID/GID.
@@ -1121,11 +1047,11 @@
  */
 #define HAS_ACCESS		/**/
 
-/* HAS_AINTL:
- *	This symbol, if defined, indicates that the aintl routine is
- *	available.  If copysignl is also present we can emulate modfl.
+/* HAS_ACCESSX:
+ *	This symbol, if defined, indicates that the accessx routine is
+ *	available to do extended access checks.
  */
-/*#define HAS_AINTL		/ **/
+/*#define HAS_ACCESSX		/**/
 
 /* HAS_ASCTIME_R:
  *	This symbol, if defined, indicates that the asctime_r routine
@@ -1161,110 +1087,33 @@
 /* HASATTRIBUTE_UNUSED:
  *	Can we handle GCC attribute for unused variables and arguments
  */
+/* HASATTRIBUTE_DEPRECATED:
+ *	Can we handle GCC attribute for marking deprecated APIs
+ */
 /* HASATTRIBUTE_WARN_UNUSED_RESULT:
  *	Can we handle GCC attribute for warning on unused results
  */
+/*#define HASATTRIBUTE_DEPRECATED	/**/
 /*#define HASATTRIBUTE_FORMAT	/**/
 /*#define PRINTF_FORMAT_NULL_OK	/**/
+/*#define HASATTRIBUTE_NORETURN	/**/
 /*#define HASATTRIBUTE_MALLOC	/**/
 /*#define HASATTRIBUTE_NONNULL	/**/
-/*#define HASATTRIBUTE_NORETURN	/**/
 /*#define HASATTRIBUTE_PURE	/**/
 /*#define HASATTRIBUTE_UNUSED	/**/
 /*#define HASATTRIBUTE_WARN_UNUSED_RESULT	/**/
 
-/* HAS_BUILTIN_CHOOSE_EXPR:
- *	Can we handle GCC builtin for compile-time ternary-like expressions
- */
-/* HAS_BUILTIN_EXPECT:
- *	Can we handle GCC builtin for telling that certain values are more
- *	likely
- */
-/*#define HAS_BUILTIN_EXPECT    / **/
-/*#define HAS_BUILTIN_CHOOSE_EXPR /**/
-
-/* HAS_C99_VARIADIC_MACROS:
- *	If defined, the compiler supports C99 variadic macros.
- */
-/*#define HAS_C99_VARIADIC_MACROS	/**/
-
-/* CASTI32:
- *	This symbol is defined if the C compiler can cast negative
- *	or large floating point numbers to 32-bit ints.
+/* HASCONST:
+ *	This symbol, if defined, indicates that this C compiler knows about
+ *	the const type. There is no need to actually test for that symbol
+ *	within your programs. The mere use of the "const" keyword will
+ *	trigger the necessary tests.
  */
-#ifdef __GNUC__
-#   define	CASTI32		/**/
+#define HASCONST	/**/
+#ifndef HASCONST
+#define const
 #endif
 
-/* CASTNEGFLOAT:
- *	This symbol is defined if the C compiler can cast negative
- *	numbers to unsigned longs, ints and shorts.
- */
-/* CASTFLAGS:
- *	This symbol contains flags that say what difficulties the compiler
- *	has casting odd floating values to unsigned long:
- *		0 = ok
- *		1 = couldn't cast < 0
- *		2 = couldn't cast >= 0x80000000
- *		4 = couldn't cast in argument expression list
- */
-#define	CASTNEGFLOAT		/**/
-#define CASTFLAGS 0		/**/
-
-/* HAS_CLASS:
- *	This symbol, if defined, indicates that the class routine is
- *	available to classify doubles.  Available for example in AIX.
- *	The returned values are defined in <float.h> and are:
- *
- *	FP_PLUS_NORM	Positive normalized, nonzero
- *	FP_MINUS_NORM	Negative normalized, nonzero
- *	FP_PLUS_DENORM	Positive denormalized, nonzero
- *	FP_MINUS_DENORM	Negative denormalized, nonzero
- *	FP_PLUS_ZERO	+0.0
- *	FP_MINUS_ZERO	-0.0
- *	FP_PLUS_INF	+INF
- *	FP_MINUS_INF	-INF
- *	FP_NANS		Signaling Not a Number (NaNS)
- *	FP_NANQ		Quiet Not a Number (NaNQ)
- */
-/*#define HAS_CLASS		/**/
-
-/* HAS_CLEARENV:
- *	This symbol, if defined, indicates that the clearenv () routine is
- *	available for use.
- */
-/*#define HAS_CLEARENV		/**/
-
-/* VOID_CLOSEDIR:
- *	This symbol, if defined, indicates that the closedir() routine
- *	does not return a value.
- */
-/*#define VOID_CLOSEDIR		/**/
-
-/* HAS_STRUCT_CMSGHDR:
- *	This symbol, if defined, indicates that the struct cmsghdr
- *	is supported.
- */
-/*#define HAS_STRUCT_CMSGHDR	/**/
-
-/* HAS_COPYSIGNL:
- *	This symbol, if defined, indicates that the copysignl routine is
- *	available.  If aintl is also present we can emulate modfl.
- */
-/*#define HAS_COPYSIGNL		/**/
-
-/* USE_CPLUSPLUS:
- *	This symbol, if defined, indicates that a C++ compiler was
- *	used to compiled Perl and will be used to compile extensions.
- */
-/*#define USE_CPLUSPLUS		/**/
-
-/* HAS_CRYPT:
- *	This symbol, if defined, indicates that the crypt routine is available
- *	to encrypt passwords and the like.
- */
-/*#define HAS_CRYPT		/**/
-
 /* HAS_CRYPT_R:
  *	This symbol, if defined, indicates that the crypt_r routine
  *	is available to crypt re-entrantly.
@@ -1315,48 +1164,6 @@
 /*#define HAS_CTIME_R	   /**/
 #define CTIME_R_PROTO 0	   /**/
 
-/* HAS_DBMINIT_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the dbminit() function.  Otherwise, it is up
- *	to the program to supply one.  A good guess is
- *		extern int dbminit(char *);
- */
-/*#define	HAS_DBMINIT_PROTO	/**/
-
-/* HAS_DIRFD:
- *	This manifest constant lets the C program know that dirfd
- *	is available.
- */
-/*#define HAS_DIRFD		/**/
-
-/* DLSYM_NEEDS_UNDERSCORE:
- *	This symbol, if defined, indicates that we need to prepend an
- *	underscore to the symbol name before calling dlsym().  This only
- *	makes sense if you *have* dlsym, which we will presume is the
- *	case if you're using dl_dlopen.xs.
- */
-/*#define 	DLSYM_NEEDS_UNDERSCORE 	/**/
-
-/* SETUID_SCRIPTS_ARE_SECURE_NOW:
- *	This symbol, if defined, indicates that the bug that prevents
- *	setuid scripts from being secure is not present in this kernel.
- */
-/* DOSUID:
- *	This symbol, if defined, indicates that the C program should
- *	check the script that it is executing for setuid/setgid bits, and
- *	attempt to emulate setuid/setgid on systems that have disabled
- *	setuid #! scripts because the kernel can't do it securely.
- *	It is up to the package designer to make sure that this emulation
- *	is done securely.  Among other things, it should do an fstat on
- *	the script it just opened to make sure it really is a setuid/setgid
- *	script, it should make sure the arguments passed correspond exactly
- *	to the argument on the #! line, and it should not trust any
- *	subprocesses to which it must pass the filename rather than the
- *	file descriptor of the script to be executed.
- */
-/*#define SETUID_SCRIPTS_ARE_SECURE_NOW	/**/
-/*#define DOSUID		/**/
-
 /* HAS_DRAND48_R:
  *	This symbol, if defined, indicates that the drand48_r routine
  *	is available to drand48 re-entrantly.
@@ -1378,6 +1185,12 @@
  */
 /*#define	HAS_DRAND48_PROTO	/**/
 
+/* HAS_EACCESS:
+ *	This symbol, if defined, indicates that the eaccess routine is
+ *	available to do extended access checks.
+ */
+/*#define HAS_EACCESS		/**/
+
 /* HAS_ENDGRENT:
  *	This symbol, if defined, indicates that the getgrent routine is
  *	available for finalizing sequential access of the group database.
@@ -1492,210 +1305,12 @@
 /*#define HAS_ENDSERVENT_R	   /**/
 #define ENDSERVENT_R_PROTO 0	   /**/
 
-/* HAS_FAST_STDIO:
- *	This symbol, if defined, indicates that the "fast stdio"
- *	is available to manipulate the stdio buffers directly.
- */
-#define HAS_FAST_STDIO		/**/
-
-/* HAS_FCHDIR:
- *	This symbol, if defined, indicates that the fchdir routine is
- *	available to change directory using a file descriptor.
- */
-/*#define HAS_FCHDIR		/**/
-
-/* FCNTL_CAN_LOCK:
- *	This symbol, if defined, indicates that fcntl() can be used
- *	for file locking.  Normally on Unix systems this is defined.
- *	It may be undefined on VMS.
- */
-/*#define FCNTL_CAN_LOCK		/**/
-
-/* HAS_FD_SET:
- *	This symbol, when defined, indicates presence of the fd_set typedef
- *	in <sys/types.h>
- */
-#define HAS_FD_SET	/**/
-
-/* HAS_FINITE:
- *	This symbol, if defined, indicates that the finite routine is
- *	available to check whether a double is finite (non-infinity non-NaN).
- */
-/*#define HAS_FINITE		/**/
-
-/* HAS_FINITEL:
- *	This symbol, if defined, indicates that the finitel routine is
- *	available to check whether a long double is finite
- *	(non-infinity non-NaN).
- */
-/*#define HAS_FINITEL		/**/
-
 /* FLEXFILENAMES:
  *	This symbol, if defined, indicates that the system supports filenames
  *	longer than 14 characters.
  */
 #define	FLEXFILENAMES		/**/
 
-/* HAS_FLOCK_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the flock() function.  Otherwise, it is up
- *	to the program to supply one.  A good guess is
- *		extern int flock(int, int);
- */
-#define	HAS_FLOCK_PROTO	/**/
-
-/* HAS_FP_CLASS:
- *	This symbol, if defined, indicates that the fp_class routine is
- *	available to classify doubles.  Available for example in Digital UNIX.
- *	The returned values are defined in <math.h> and are:
- *
- *	FP_SNAN           Signaling NaN (Not-a-Number)
- *	FP_QNAN           Quiet NaN (Not-a-Number)
- *	FP_POS_INF        +infinity
- *	FP_NEG_INF        -infinity
- *	FP_POS_NORM       Positive normalized
- *	FP_NEG_NORM       Negative normalized
- *	FP_POS_DENORM     Positive denormalized
- *	FP_NEG_DENORM     Negative denormalized
- *	FP_POS_ZERO       +0.0 (positive zero)
- *	FP_NEG_ZERO       -0.0 (negative zero)
- */
-/*#define HAS_FP_CLASS		/**/
-
-/* HAS_FPCLASS:
- *	This symbol, if defined, indicates that the fpclass routine is
- *	available to classify doubles.  Available for example in Solaris/SVR4.
- *	The returned values are defined in <ieeefp.h> and are:
- *
- *	FP_SNAN		signaling NaN
- *	FP_QNAN		quiet NaN
- *	FP_NINF		negative infinity
- *	FP_PINF		positive infinity
- *	FP_NDENORM	negative denormalized non-zero
- *	FP_PDENORM	positive denormalized non-zero
- *	FP_NZERO	negative zero
- *	FP_PZERO	positive zero
- *	FP_NNORM	negative normalized non-zero
- *	FP_PNORM	positive normalized non-zero
- */
-/*#define HAS_FPCLASS		/**/
-
-/* HAS_FPCLASSIFY:
- *	This symbol, if defined, indicates that the fpclassify routine is
- *	available to classify doubles.  Available for example in HP-UX.
- *	The returned values are defined in <math.h> and are
- *
- *           FP_NORMAL     Normalized
- *           FP_ZERO       Zero
- *           FP_INFINITE   Infinity
- *           FP_SUBNORMAL  Denormalized
- *           FP_NAN        NaN
- *
- */
-/*#define HAS_FPCLASSIFY		/**/
-
-/* HAS_FPCLASSL:
- *	This symbol, if defined, indicates that the fpclassl routine is
- *	available to classify long doubles.  Available for example in IRIX.
- *	The returned values are defined in <ieeefp.h> and are:
- *
- *	FP_SNAN		signaling NaN
- *	FP_QNAN		quiet NaN
- *	FP_NINF		negative infinity
- *	FP_PINF		positive infinity
- *	FP_NDENORM	negative denormalized non-zero
- *	FP_PDENORM	positive denormalized non-zero
- *	FP_NZERO	negative zero
- *	FP_PZERO	positive zero
- *	FP_NNORM	negative normalized non-zero
- *	FP_PNORM	positive normalized non-zero
- */
-/*#define HAS_FPCLASSL		/**/
-
-/* HAS_FPOS64_T:
- *	This symbol will be defined if the C compiler supports fpos64_t.
- */
-/*#define	HAS_FPOS64_T    	/**/
-
-/* HAS_FREXPL:
- *	This symbol, if defined, indicates that the frexpl routine is
- *	available to break a long double floating-point number into
- *	a normalized fraction and an integral power of 2.
- */
-/*#define HAS_FREXPL		/**/
-
-/* HAS_STRUCT_FS_DATA:
- *	This symbol, if defined, indicates that the struct fs_data
- *	to do statfs() is supported.
- */
-/*#define HAS_STRUCT_FS_DATA	/**/
-
-/* HAS_FSEEKO:
- *	This symbol, if defined, indicates that the fseeko routine is
- *	available to fseek beyond 32 bits (useful for ILP32 hosts).
- */
-/*#define HAS_FSEEKO		/**/
-
-/* HAS_FSTATFS:
- *	This symbol, if defined, indicates that the fstatfs routine is
- *	available to stat filesystems by file descriptors.
- */
-/*#define HAS_FSTATFS		/**/
-
-/* HAS_FSYNC:
- *	This symbol, if defined, indicates that the fsync routine is
- *	available to write a file's modified data and attributes to
- *	permanent storage.
- */
-/*#define HAS_FSYNC		/**/
-
-/* HAS_FTELLO:
- *	This symbol, if defined, indicates that the ftello routine is
- *	available to ftell beyond 32 bits (useful for ILP32 hosts).
- */
-/*#define HAS_FTELLO		/**/
-
-/* HAS_FUTIMES:
- *	This symbol, if defined, indicates that the futimes routine is
- *	available to change file descriptor time stamps with struct timevals.
- */
-/*#define HAS_FUTIMES		/**/
-
-/* Gconvert:
- *	This preprocessor macro is defined to convert a floating point
- *	number to a string without a trailing decimal point.  This
- *	emulates the behavior of sprintf("%g"), but is sometimes much more
- *	efficient.  If gconvert() is not available, but gcvt() drops the
- *	trailing decimal point, then gcvt() is used.  If all else fails,
- *	a macro using sprintf("%g") is used. Arguments for the Gconvert
- *	macro are: value, number of digits, whether trailing zeros should
- *	be retained, and the output buffer.
- *	The usual values are:
- *		d_Gconvert='gconvert((x),(n),(t),(b))'
- *		d_Gconvert='gcvt((x),(n),(b))'
- *		d_Gconvert='sprintf((b),"%.*g",(n),(x))'
- *	The last two assume trailing zeros should not be kept.
- */
-#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x))
-
-/* HAS_GETCWD:
- *	This symbol, if defined, indicates that the getcwd routine is
- *	available to get the current working directory.
- */
-#define HAS_GETCWD		/**/
-
-/* HAS_GETESPWNAM:
- *	This symbol, if defined, indicates that the getespwnam system call is
- *	available to retrieve enchanced (shadow) password entries by name.
- */
-/*#define HAS_GETESPWNAM		/**/
-
-/* HAS_GETFSSTAT:
- *	This symbol, if defined, indicates that the getfsstat routine is
- *	available to stat filesystems in bulk.
- */
-/*#define HAS_GETFSSTAT		/**/
-
 /* HAS_GETGRENT:
  *	This symbol, if defined, indicates that the getgrent routine is
  *	available for sequential access of the group database.
@@ -1835,12 +1450,6 @@
  */
 #define	HAS_GETHOST_PROTOS	/**/
 
-/* HAS_GETITIMER:
- *	This symbol, if defined, indicates that the getitimer routine is
- *	available to return interval timers.
- */
-/*#define HAS_GETITIMER		/**/
-
 /* HAS_GETLOGIN_R:
  *	This symbol, if defined, indicates that the getlogin_r routine
  *	is available to getlogin re-entrantly.
@@ -1854,18 +1463,6 @@
 /*#define HAS_GETLOGIN_R	   /**/
 #define GETLOGIN_R_PROTO 0	   /**/
 
-/* HAS_GETMNT:
- *	This symbol, if defined, indicates that the getmnt routine is
- *	available to get filesystem mount info by filename.
- */
-/*#define HAS_GETMNT		/**/
-
-/* HAS_GETMNTENT:
- *	This symbol, if defined, indicates that the getmntent routine is
- *	available to iterate through mounted file systems to get their info.
- */
-/*#define HAS_GETMNTENT		/**/
-
 /* HAS_GETNETBYADDR:
  *	This symbol, if defined, indicates that the getnetbyaddr() routine is
  *	available to look up networks by their IP addresses.
@@ -1931,13 +1528,6 @@
  */
 /*#define	HAS_GETNET_PROTOS	/**/
 
-/* HAS_GETPAGESIZE:
- *	This symbol, if defined, indicates that the getpagesize system call
- *	is available to get system page size, which is the granularity of
- *	many memory management calls.
- */
-/*#define HAS_GETPAGESIZE		/**/
-
 /* HAS_GETPROTOENT:
  *	This symbol, if defined, indicates that the getprotoent() routine is
  *	available to look up protocols in some data base or another.
@@ -2013,12 +1603,6 @@
  */
 #define	HAS_GETPROTO_PROTOS	/**/
 
-/* HAS_GETPRPWNAM:
- *	This symbol, if defined, indicates that the getprpwnam system call is
- *	available to retrieve protected (shadow) password entries by name.
- */
-/*#define HAS_GETPRPWNAM		/**/
-
 /* HAS_GETPWENT:
  *	This symbol, if defined, indicates that the getpwent routine is
  *	available for sequential access of the passwd database.
@@ -2118,12 +1702,6 @@
  */
 #define	HAS_GETSERV_PROTOS	/**/
 
-/* HAS_GETSPNAM:
- *	This symbol, if defined, indicates that the getspnam system call is
- *	available to retrieve SysV shadow password entries by name.
- */
-/*#define HAS_GETSPNAM		/**/
-
 /* HAS_GETSPNAM_R:
  *	This symbol, if defined, indicates that the getspnam_r routine
  *	is available to getspnam re-entrantly.
@@ -2161,21 +1739,6 @@
 /*#define HAS_GMTIME_R	   /**/
 #define GMTIME_R_PROTO 0	   /**/
 
-/* HAS_GNULIBC:
- *	This symbol, if defined, indicates to the C program that 
- *	the GNU C library is being used.  A better check is to use
- *	the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc.
- */
-/*#define HAS_GNULIBC  	/**/
-#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)
-#   define _GNU_SOURCE
-#endif
-/* HAS_HASMNTOPT:
- *	This symbol, if defined, indicates that the hasmntopt routine is
- *	available to query the mount options of file systems.
- */
-/*#define HAS_HASMNTOPT		/**/
-
 /* HAS_HTONL:
  *	This symbol, if defined, indicates that the htonl() routine (and
  *	friends htons() ntohl() ntohs()) are available to do network
@@ -2201,70 +1764,6 @@
 #define HAS_NTOHL		/**/
 #define HAS_NTOHS		/**/
 
-/* HAS_ILOGBL:
- *	This symbol, if defined, indicates that the ilogbl routine is
- *	available.  If scalbnl is also present we can emulate frexpl.
- */
-/*#define HAS_ILOGBL		/**/
-
-/* HAS_INT64_T:
- *     This symbol will defined if the C compiler supports int64_t.
- *     Usually the <inttypes.h> needs to be included, but sometimes
- *	<sys/types.h> is enough.
- */
-/*#define     HAS_INT64_T               /**/
-
-/* HAS_ISASCII:
- *	This manifest constant lets the C program know that isascii 
- *	is available.
- */
-#define HAS_ISASCII		/**/
-
-/* HAS_ISFINITE:
- *	This symbol, if defined, indicates that the isfinite routine is
- *	available to check whether a double is finite (non-infinity non-NaN).
- */
-/*#define HAS_ISFINITE		/**/
-
-/* HAS_ISINF:
- *	This symbol, if defined, indicates that the isinf routine is
- *	available to check whether a double is an infinity.
- */
-/*#define HAS_ISINF		/**/
-
-/* HAS_ISNAN:
- *	This symbol, if defined, indicates that the isnan routine is
- *	available to check whether a double is a NaN.
- */
-#define HAS_ISNAN		/**/
-
-/* HAS_ISNANL:
- *	This symbol, if defined, indicates that the isnanl routine is
- *	available to check whether a long double is a NaN.
- */
-/*#define HAS_ISNANL		/**/
-
-/* HAS_LCHOWN:
- *	This symbol, if defined, indicates that the lchown routine is
- *	available to operate on a symbolic link (instead of following the
- *	link).
- */
-/*#define HAS_LCHOWN		/**/
-
-/* HAS_LDBL_DIG:
- *	This symbol, if defined, indicates that this system's <float.h>
- *	or <limits.h> defines the symbol LDBL_DIG, which is the number
- *	of significant digits in a long double precision number. Unlike
- *	for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined.
- */
-#define HAS_LDBL_DIG 	/**/
-
-/* LIBM_LIB_VERSION:
- *	This symbol, if defined, indicates that libm exports _LIB_VERSION
- *	and that math.h defines the enum to manipulate it.
- */
-/*#define LIBM_LIB_VERSION         /**/
-
 /* HAS_LOCALTIME_R:
  *	This symbol, if defined, indicates that the localtime_r routine
  *	is available to localtime re-entrantly.
@@ -2272,9 +1771,16 @@
 /* LOCALTIME_R_NEEDS_TZSET:
  *	Many libc's localtime_r implementations do not call tzset,
  *	making them differ from localtime(), and making timezone
- *	changes using $ENV{TZ} without explicitly calling tzset
+ *	changes using \undef{TZ} without explicitly calling tzset
  *	impossible. This symbol makes us call tzset before localtime_r
  */
+/*#define LOCALTIME_R_NEEDS_TZSET /**/
+#ifdef LOCALTIME_R_NEEDS_TZSET
+#define L_R_TZSET tzset(),
+#else
+#define L_R_TZSET
+#endif
+
 /* LOCALTIME_R_PROTO:
  *	This symbol encodes the prototype of localtime_r.
  *	It is zero if d_localtime_r is undef, and one of the
@@ -2282,7 +1788,6 @@
  *	is defined.
  */
 /*#define HAS_LOCALTIME_R	   /**/
-/*#define LOCALTIME_R_NEEDS_TZSET	   /**/
 #define LOCALTIME_R_PROTO 0	   /**/
 
 /* HAS_LONG_DOUBLE:
@@ -2290,14 +1795,14 @@
  *	doubles.
  */
 /* LONG_DOUBLESIZE:
- *	This symbol contains the size of a long double, so that the 
+ *	This symbol contains the size of a long double, so that the
  *	C preprocessor can make decisions based on it.  It is only
  *	defined if the system supports long doubles.
  */
 #define HAS_LONG_DOUBLE		/**/
 #ifdef HAS_LONG_DOUBLE
 #   ifndef __GNUC__
-#	define LONG_DOUBLESIZE 10		/**/
+#	define LONG_DOUBLESIZE 8		/**/
 #   else
 #	define LONG_DOUBLESIZE 12		/**/
 #   endif
@@ -2307,7 +1812,7 @@
  *	This symbol will be defined if the C compiler supports long long.
  */
 /* LONGLONGSIZE:
- *	This symbol contains the size of a long long, so that the 
+ *	This symbol contains the size of a long long, so that the
  *	C preprocessor can make decisions based on it.  It is only
  *	defined if the system supports long long.
  */
@@ -2324,36 +1829,12 @@
  */
 #define	HAS_LSEEK_PROTO	/**/
 
-/* HAS_MADVISE:
- *	This symbol, if defined, indicates that the madvise system call is
- *	available to map a file into memory.
- */
-/*#define HAS_MADVISE		/**/
-
-/* HAS_MALLOC_SIZE:
- *	This symbol, if defined, indicates that the malloc_size
- *	routine is available for use.
- */
-/*#define HAS_MALLOC_SIZE		/**/
-
-/* HAS_MALLOC_GOOD_SIZE:
- *	This symbol, if defined, indicates that the malloc_good_size
- *	routine is available for use.
- */
-/*#define HAS_MALLOC_GOOD_SIZE	/**/
-
 /* HAS_MEMCHR:
  *	This symbol, if defined, indicates that the memchr routine is available
  *	to locate characters within a C string.
  */
 #define HAS_MEMCHR	/**/
 
-/* HAS_MKDTEMP:
- *	This symbol, if defined, indicates that the mkdtemp routine is
- *	available to exclusively create a uniquely named temporary directory.
- */
-/*#define HAS_MKDTEMP		/**/
-
 /* HAS_MKSTEMP:
  *	This symbol, if defined, indicates that the mkstemp routine is
  *	available to exclusively create and open a uniquely named
@@ -2361,13 +1842,6 @@
  */
 /*#define HAS_MKSTEMP		/**/
 
-/* HAS_MKSTEMPS:
- *	This symbol, if defined, indicates that the mkstemps routine is
- *	available to excluslvely create and open a uniquely named
- *	(with a suffix) temporary file.
- */
-/*#define HAS_MKSTEMPS		/**/
-
 /* HAS_MMAP:
  *	This symbol, if defined, indicates that the mmap system call is
  *	available to map a file into memory.
@@ -2380,77 +1854,12 @@
 /*#define HAS_MMAP		/**/
 #define Mmap_t void *	/**/
 
-/* HAS_MODFL:
- *	This symbol, if defined, indicates that the modfl routine is
- *	available to split a long double x into a fractional part f and
- *	an integer part i such that |f| < 1.0 and (f + i) = x.
- */
-/* HAS_MODFL_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the modfl() function.  Otherwise, it is up
- *	to the program to supply one.
- */
-/* HAS_MODFL_POW32_BUG:
- *	This symbol, if defined, indicates that the modfl routine is
- *	broken for long doubles >= pow(2, 32).
- *	For example from 4294967303.150000 one would get 4294967302.000000
- *	and 1.150000.  The bug has been seen in certain versions of glibc,
- *	release 2.2.2 is known to be okay.
- */
-/*#define HAS_MODFL		/**/
-/*#define HAS_MODFL_PROTO		/**/
-/*#define HAS_MODFL_POW32_BUG		/**/
-
-/* HAS_MPROTECT:
- *	This symbol, if defined, indicates that the mprotect system call is
- *	available to modify the access protection of a memory mapped file.
- */
-/*#define HAS_MPROTECT		/**/
-
 /* HAS_MSG:
  *	This symbol, if defined, indicates that the entire msg*(2) library is
  *	supported (IPC mechanism based on message queues).
  */
 /*#define HAS_MSG		/**/
 
-/* HAS_STRUCT_MSGHDR:
- *	This symbol, if defined, indicates that the struct msghdr
- *	is supported.
- */
-/*#define HAS_STRUCT_MSGHDR	/**/
-
-/* HAS_NL_LANGINFO:
- *	This symbol, if defined, indicates that the nl_langinfo routine is
- *	available to return local data.  You will also need <langinfo.h>
- *	and therefore I_LANGINFO.
- */
-/*#define HAS_NL_LANGINFO		/**/
-
-/* HAS_OFF64_T:
- *	This symbol will be defined if the C compiler supports off64_t.
- */
-/*#define	HAS_OFF64_T    		/**/
-
-/* HAS_OPEN3:
- *	This manifest constant lets the C program know that the three
- *	argument form of open(2) is available.
- */
-/*#define HAS_OPEN3		/**/
-
-/* HAS_PROCSELFEXE:
- *	This symbol is defined if PROCSELFEXE_PATH is a symlink
- *	to the absolute pathname of the executing program.
- */
-/* PROCSELFEXE_PATH:
- *	If HAS_PROCSELFEXE is defined this symbol is the filename
- *	of the symbolic link pointing to the absolute pathname of
- *	the executing program.
- */
-/*#define HAS_PROCSELFEXE	/**/
-#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH)
-#define PROCSELFEXE_PATH		/**/
-#endif
-
 /* OLD_PTHREAD_CREATE_JOINABLE:
  *	This symbol, if defined, indicates how to create pthread
  *	in joinable (aka undetached) state.  NOTE: not defined
@@ -2467,15 +1876,8 @@
  */
 /*#define HAS_PTHREAD_ATFORK		/**/
 
-/* HAS_PTHREAD_ATTR_SETSCOPE:
- *	This symbol, if defined, indicates that the pthread_attr_setscope
- *	system call is available to set the contention scope attribute of
- *	a thread attribute object.
- */
-/*#define HAS_PTHREAD_ATTR_SETSCOPE		/ **/
-
 /* HAS_PTHREAD_YIELD:
- *	This symbol, if defined, indicates that the pthread_yield 
+ *	This symbol, if defined, indicates that the pthread_yield
  *	routine is available to yield the execution of the current
  *	thread.	 sched_yield is preferable to pthread_yield.
  */
@@ -2532,69 +1934,12 @@
 /*#define HAS_READDIR_R	   /**/
 #define READDIR_R_PROTO 0	   /**/
 
-/* HAS_READV:
- *	This symbol, if defined, indicates that the readv routine is
- *	available to do gather reads.  You will also need <sys/uio.h>
- *	and there I_SYSUIO.
- */
-/*#define HAS_READV		/**/
-
-/* HAS_RECVMSG:
- *	This symbol, if defined, indicates that the recvmsg routine is
- *	available to send structured socket messages.
- */
-/*#define HAS_RECVMSG		/**/
-
-/* HAS_SAFE_BCOPY:
- *	This symbol, if defined, indicates that the bcopy routine is available
- *	to copy potentially overlapping memory blocks. Normally, you should
- *	probably use memmove() or memcpy(). If neither is defined, roll your
- *	own version.
- */
-/*#define HAS_SAFE_BCOPY	/**/
-
-/* HAS_SAFE_MEMCPY:
- *	This symbol, if defined, indicates that the memcpy routine is available
- *	to copy potentially overlapping memory blocks.  If you need to
- *	copy overlapping memory blocks, you should check HAS_MEMMOVE and
- *	use memmove() instead, if available.
- */
-/*#define HAS_SAFE_MEMCPY	/**/
-
-/* HAS_SANE_MEMCMP:
- *	This symbol, if defined, indicates that the memcmp routine is available
- *	and can be used to compare relative magnitudes of chars with their high
- *	bits set.  If it is not defined, roll your own version.
- */
-#define HAS_SANE_MEMCMP	/**/
-
-/* HAS_SBRK_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the sbrk() function.  Otherwise, it is up
- *	to the program to supply one.  Good guesses are
- *		extern void* sbrk(int);
- *		extern void* sbrk(size_t);
- */
-/*#define	HAS_SBRK_PROTO	/**/
-
-/* HAS_SCALBNL:
- *	This symbol, if defined, indicates that the scalbnl routine is
- *	available.  If ilogbl is also present we can emulate frexpl.
- */
-/*#define HAS_SCALBNL		/**/
-
 /* HAS_SEM:
  *	This symbol, if defined, indicates that the entire sem*(2) library is
  *	supported.
  */
 /*#define HAS_SEM		/**/
 
-/* HAS_SENDMSG:
- *	This symbol, if defined, indicates that the sendmsg routine is
- *	available to send structured socket messages.
- */
-/*#define HAS_SENDMSG		/**/
-
 /* HAS_SETGRENT:
  *	This symbol, if defined, indicates that the setgrent routine is
  *	available for initializing sequential access of the group database.
@@ -2614,13 +1959,6 @@
 /*#define HAS_SETGRENT_R	   /**/
 #define SETGRENT_R_PROTO 0	   /**/
 
-/* HAS_SETGROUPS:
- *	This symbol, if defined, indicates that the setgroups() routine is
- *	available to set the list of process groups.  If unavailable, multiple
- *	groups are probably not supported.
- */
-/*#define HAS_SETGROUPS		/**/
-
 /* HAS_SETHOSTENT:
  *	This symbol, if defined, indicates that the sethostent() routine is
  *	available.
@@ -2640,12 +1978,6 @@
 /*#define HAS_SETHOSTENT_R	   /**/
 #define SETHOSTENT_R_PROTO 0	   /**/
 
-/* HAS_SETITIMER:
- *	This symbol, if defined, indicates that the setitimer routine is
- *	available to set interval timers.
- */
-/*#define HAS_SETITIMER		/**/
-
 /* HAS_SETLOCALE_R:
  *	This symbol, if defined, indicates that the setlocale_r routine
  *	is available to setlocale re-entrantly.
@@ -2696,12 +2028,6 @@
 /*#define HAS_SETPGRP		/**/
 /*#define USE_BSD_SETPGRP	/**/
 
-/* HAS_SETPROCTITLE:
- *	This symbol, if defined, indicates that the setproctitle routine is
- *	available to set process title.
- */
-/*#define HAS_SETPROCTITLE		/**/
-
 /* HAS_SETPROTOENT_R:
  *	This symbol, if defined, indicates that the setprotoent_r routine
  *	is available to setprotoent re-entrantly.
@@ -2760,12 +2086,6 @@
  */
 #define HAS_SETVBUF		/**/
 
-/* USE_SFIO:
- *	This symbol, if defined, indicates that sfio should
- *	be used.
- */
-/*#define	USE_SFIO		/**/
-
 /* HAS_SHM:
  *	This symbol, if defined, indicates that the entire shm*(2) library is
  *	supported.
@@ -2786,81 +2106,6 @@
 #define Shmat_t void *	/**/
 /*#define HAS_SHMAT_PROTOTYPE	/**/
 
-/* HAS_SIGACTION:
- *	This symbol, if defined, indicates that Vr4's sigaction() routine
- *	is available.
- */
-/*#define HAS_SIGACTION	/**/
-
-/* HAS_SIGPROCMASK:
- *	This symbol, if defined, indicates that the sigprocmask
- *	system call is available to examine or change the signal mask
- *	of the calling process.
- */
-/*#define HAS_SIGPROCMASK		/**/
-
-/* HAS_SIGSETJMP:
- *	This variable indicates to the C program that the sigsetjmp()
- *	routine is available to save the calling process's registers
- *	and stack environment for later use by siglongjmp(), and
- *	to optionally save the process's signal mask.  See
- *	Sigjmp_buf, Sigsetjmp, and Siglongjmp.
- */
-/* Sigjmp_buf:
- *	This is the buffer type to be used with Sigsetjmp and Siglongjmp.
- */
-/* Sigsetjmp:
- *	This macro is used in the same way as sigsetjmp(), but will invoke
- *	traditional setjmp() if sigsetjmp isn't available.
- *	See HAS_SIGSETJMP.
- */
-/* Siglongjmp:
- *	This macro is used in the same way as siglongjmp(), but will invoke
- *	traditional longjmp() if siglongjmp isn't available.
- *	See HAS_SIGSETJMP.
- */
-/*#define HAS_SIGSETJMP	/**/
-#ifdef HAS_SIGSETJMP
-#define Sigjmp_buf sigjmp_buf
-#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask))
-#define Siglongjmp(buf,retval) siglongjmp((buf),(retval))
-#else
-#define Sigjmp_buf jmp_buf
-#define Sigsetjmp(buf,save_mask) setjmp((buf))
-#define Siglongjmp(buf,retval) longjmp((buf),(retval))
-#endif
-
-/* USE_SITECUSTOMIZE:
- *	This symbol, if defined, indicates that sitecustomize should
- *	be used.
- */
-/*#define	USE_SITECUSTOMIZE		/**/
-
-/* HAS_SNPRINTF:
- *	This symbol, if defined, indicates that the snprintf () library
- *	function is available for use.
- */
-/* HAS_VSNPRINTF:
- *	This symbol, if defined, indicates that the vsnprintf () library
- *	function is available for use.
- */
-#define HAS_SNPRINTF	/**/
-#define HAS_VSNPRINTF	/**/
-
-/* HAS_SOCKATMARK:
- *	This symbol, if defined, indicates that the sockatmark routine is
- *	available to test whether a socket is at the out-of-band mark.
- */
-/*#define HAS_SOCKATMARK		/**/
-
-/* HAS_SOCKATMARK_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the sockatmark() function.  Otherwise, it is up
- *	to the program to supply one.  A good guess is
- *		extern int sockatmark(int);
- */
-/*#define	HAS_SOCKATMARK_PROTO	/**/
-
 /* HAS_SOCKET:
  *	This symbol, if defined, indicates that the BSD socket interface is
  *	supported.
@@ -2908,26 +2153,6 @@
 /*#define	HAS_MSG_PROXY	/**/
 /*#define	HAS_SCM_RIGHTS	/**/
 
-/* HAS_SOCKS5_INIT:
- *	This symbol, if defined, indicates that the socks5_init routine is
- *	available to initialize SOCKS 5.
- */
-/*#define HAS_SOCKS5_INIT		/**/
-
-/* SPRINTF_RETURNS_STRLEN:
- *	This variable defines whether sprintf returns the length of the string
- *	(as per the ANSI spec). Some C libraries retain compatibility with
- *	pre-ANSI C and return a pointer to the passed in buffer; for these
- *	this variable will be undef.
- */
-#define SPRINTF_RETURNS_STRLEN       /**/
-
-/* HAS_SQRTL:
- *	This symbol, if defined, indicates that the sqrtl routine is
- *	available to do long double square roots.
- */
-/*#define HAS_SQRTL		/**/
-
 /* HAS_SRAND48_R:
  *	This symbol, if defined, indicates that the srand48_r routine
  *	is available to srand48 re-entrantly.
@@ -2954,22 +2179,6 @@
 /*#define HAS_SRANDOM_R	   /**/
 #define SRANDOM_R_PROTO 0	   /**/
 
-/* HAS_SETRESGID_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the setresgid() function.  Otherwise, it is up
- *	to the program to supply one.  Good guesses are
- *		extern int setresgid(uid_t ruid, uid_t euid, uid_t suid);
- */
-/*#define	HAS_SETRESGID_PROTO	/**/
-
-/* HAS_SETRESUID_PROTO:
- *	This symbol, if defined, indicates that the system provides
- *	a prototype for the setresuid() function.  Otherwise, it is up
- *	to the program to supply one.  Good guesses are
- *		extern int setresuid(uid_t ruid, uid_t euid, uid_t suid);
- */
-/*#define	HAS_SETRESUID_PROTO	/**/
-
 /* USE_STAT_BLOCKS:
  *	This symbol is defined if this system has a stat structure declaring
  *	st_blksize and st_blocks.
@@ -2978,28 +2187,914 @@
 /*#define USE_STAT_BLOCKS 	/**/
 #endif
 
-/* HAS_STRUCT_STATFS_F_FLAGS:
- *	This symbol, if defined, indicates that the struct statfs
- *	does have the f_flags member containing the mount flags of
- *	the filesystem containing the file.
- *	This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3),
- *	not from <sys/statfs.h> (SYSV).  Older BSDs (like Ultrix) do not
- *	have statfs() and struct statfs, they have ustat() and getmnt()
- *	with struct ustat and struct fs_data.
+/* USE_STRUCT_COPY:
+ *	This symbol, if defined, indicates that this C compiler knows how
+ *	to copy structures.  If undefined, you'll need to use a block copy
+ *	routine of some sort instead.
  */
-/*#define HAS_STRUCT_STATFS_F_FLAGS		/**/
+#define	USE_STRUCT_COPY	/**/
 
-/* HAS_STRUCT_STATFS:
- *	This symbol, if defined, indicates that the struct statfs
- *	to do statfs() is supported.
+/* HAS_STRERROR:
+ *	This symbol, if defined, indicates that the strerror routine is
+ *	available to translate error numbers to strings. See the writeup
+ *	of Strerror() in this file before you try to define your own.
  */
-/*#define HAS_STRUCT_STATFS	/**/
+/* HAS_SYS_ERRLIST:
+ *	This symbol, if defined, indicates that the sys_errlist array is
+ *	available to translate error numbers to strings. The extern int
+ *	sys_nerr gives the size of that table.
+ */
+/* Strerror:
+ *	This preprocessor symbol is defined as a macro if strerror() is
+ *	not available to translate error numbers to strings but sys_errlist[]
+ *	array is there.
+ */
+#define HAS_STRERROR		/**/
+#define HAS_SYS_ERRLIST	/**/
+#define Strerror(e) strerror(e)
 
-/* HAS_FSTATVFS:
- *	This symbol, if defined, indicates that the fstatvfs routine is
- *	available to stat filesystems by file descriptors.
+/* HAS_STRERROR_R:
+ *	This symbol, if defined, indicates that the strerror_r routine
+ *	is available to strerror re-entrantly.
  */
-/*#define HAS_FSTATVFS		/**/
+/* STRERROR_R_PROTO:
+ *	This symbol encodes the prototype of strerror_r.
+ *	It is zero if d_strerror_r is undef, and one of the
+ *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r
+ *	is defined.
+ */
+/*#define HAS_STRERROR_R	   /**/
+#define STRERROR_R_PROTO 0	   /**/
+
+/* HAS_STRTOUL:
+ *	This symbol, if defined, indicates that the strtoul routine is
+ *	available to provide conversion of strings to unsigned long.
+ */
+#define HAS_STRTOUL	/**/
+
+/* HAS_TIME:
+ *	This symbol, if defined, indicates that the time() routine exists.
+ */
+/* Time_t:
+ *	This symbol holds the type returned by time(). It can be long,
+ *	or time_t on BSD sites (in which case <sys/types.h> should be
+ *	included).
+ */
+#define HAS_TIME		/**/
+#define Time_t time_t		/* Time type */
+
+/* HAS_TIMES:
+ *	This symbol, if defined, indicates that the times() routine exists.
+ *	Note that this became obsolete on some systems (SUNOS), which now
+ * use getrusage(). It may be necessary to include <sys/times.h>.
+ */
+#define HAS_TIMES		/**/
+
+/* HAS_TMPNAM_R:
+ *	This symbol, if defined, indicates that the tmpnam_r routine
+ *	is available to tmpnam re-entrantly.
+ */
+/* TMPNAM_R_PROTO:
+ *	This symbol encodes the prototype of tmpnam_r.
+ *	It is zero if d_tmpnam_r is undef, and one of the
+ *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r
+ *	is defined.
+ */
+/*#define HAS_TMPNAM_R	   /**/
+#define TMPNAM_R_PROTO 0	   /**/
+
+/* HAS_TTYNAME_R:
+ *	This symbol, if defined, indicates that the ttyname_r routine
+ *	is available to ttyname re-entrantly.
+ */
+/* TTYNAME_R_PROTO:
+ *	This symbol encodes the prototype of ttyname_r.
+ *	It is zero if d_ttyname_r is undef, and one of the
+ *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
+ *	is defined.
+ */
+/*#define HAS_TTYNAME_R	   /**/
+#define TTYNAME_R_PROTO 0	   /**/
+
+/* HAS_UNION_SEMUN:
+ *	This symbol, if defined, indicates that the union semun is
+ *	defined by including <sys/sem.h>.  If not, the user code
+ *	probably needs to define it as:
+ *	union semun {
+ *	    int val;
+ *	    struct semid_ds *buf;
+ *	    unsigned short *array;
+ *	}
+ */
+/* USE_SEMCTL_SEMUN:
+ *	This symbol, if defined, indicates that union semun is
+ *	used for semctl IPC_STAT.
+ */
+/* USE_SEMCTL_SEMID_DS:
+ *	This symbol, if defined, indicates that struct semid_ds * is
+ *	used for semctl IPC_STAT.
+ */
+#define HAS_UNION_SEMUN	/**/
+/*#define USE_SEMCTL_SEMUN	/**/
+/*#define USE_SEMCTL_SEMID_DS	/**/
+
+/* HAS_VFORK:
+ *	This symbol, if defined, indicates that vfork() exists.
+ */
+/*#define HAS_VFORK	/**/
+
+/* HAS_PSEUDOFORK:
+ *	This symbol, if defined, indicates that an emulation of the
+ *	fork routine is available.
+ */
+/*#define HAS_PSEUDOFORK	/**/
+
+/* Signal_t:
+ *	This symbol's value is either "void" or "int", corresponding to the
+ *	appropriate return type of a signal handler.  Thus, you can declare
+ *	a signal handler using "Signal_t (*handler)()", and define the
+ *	handler using "Signal_t handler(sig)".
+ */
+#define Signal_t void	/* Signal handler's return type */
+
+/* HASVOLATILE:
+ *	This symbol, if defined, indicates that this C compiler knows about
+ *	the volatile declaration.
+ */
+#define	HASVOLATILE	/**/
+#ifndef HASVOLATILE
+#define volatile
+#endif
+
+/* Fpos_t:
+ *	This symbol holds the type used to declare file positions in libc.
+ *	It can be fpos_t, long, uint, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Fpos_t fpos_t		/* File position type */
+
+/* Gid_t_f:
+ *	This symbol defines the format string used for printing a Gid_t.
+ */
+#define	Gid_t_f		"ld"		/**/
+
+/* Gid_t_sign:
+ *	This symbol holds the signedess of a Gid_t.
+ *	1 for unsigned, -1 for signed.
+ */
+#define Gid_t_sign	-1		/* GID sign */
+
+/* Gid_t_size:
+ *	This symbol holds the size of a Gid_t in bytes.
+ */
+#define Gid_t_size 4		/* GID size */
+
+/* Gid_t:
+ *	This symbol holds the return type of getgid() and the type of
+ *	argument to setrgid() and related functions.  Typically,
+ *	it is the type of group ids in the kernel. It can be int, ushort,
+ *	gid_t, etc... It may be necessary to include <sys/types.h> to get
+ *	any typedef'ed information.
+ */
+#define Gid_t gid_t		/* Type for getgid(), etc... */
+
+/* I_DIRENT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <dirent.h>. Using this symbol also triggers the definition
+ *	of the Direntry_t define which ends up being 'struct dirent' or
+ *	'struct direct' depending on the availability of <dirent.h>.
+ */
+/* DIRNAMLEN:
+ *	This symbol, if defined, indicates to the C program that the length
+ *	of directory entry names is provided by a d_namlen field.  Otherwise
+ *	you need to do strlen() on the d_name field.
+ */
+/* Direntry_t:
+ *	This symbol is set to 'struct direct' or 'struct dirent' depending on
+ *	whether dirent is available or not. You should use this pseudo type to
+ *	portably declare your directory entries.
+ */
+#define I_DIRENT		/**/
+#define DIRNAMLEN	/**/
+#define Direntry_t struct direct
+
+/* I_GRP:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <grp.h>.
+ */
+/* GRPASSWD:
+ *	This symbol, if defined, indicates to the C program that struct group
+ *	in <grp.h> contains gr_passwd.
+ */
+/*#define I_GRP		/**/
+/*#define GRPASSWD	/**/
+
+/* I_MACH_CTHREADS:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <mach/cthreads.h>.
+ */
+/*#define   I_MACH_CTHREADS	/**/
+
+/* I_NDBM:
+ *	This symbol, if defined, indicates that <ndbm.h> exists and should
+ *	be included.
+ */
+/* I_GDBMNDBM:
+ *	This symbol, if defined, indicates that <gdbm/ndbm.h> exists and should
+ *	be included.  This was the location of the ndbm.h compatibility file
+ *	in RedHat 7.1.
+ */
+/* I_GDBM_NDBM:
+ *	This symbol, if defined, indicates that <gdbm-ndbm.h> exists and should
+ *	be included.  This is the location of the ndbm.h compatibility file
+ *	in Debian 4.0.
+ */
+/* NDBM_H_USES_PROTOTYPES:
+ *	This symbol, if defined, indicates that <ndbm.h> uses real ANSI C
+ *	prototypes instead of K&R style function declarations without any
+ *	parameter information. While ANSI C prototypes are supported in C++,
+ *	K&R style function declarations will yield errors.
+ */
+/* GDBMNDBM_H_USES_PROTOTYPES:
+ *	This symbol, if defined, indicates that <gdbm/ndbm.h> uses real ANSI C
+ *	prototypes instead of K&R style function declarations without any
+ *	parameter information. While ANSI C prototypes are supported in C++,
+ *	K&R style function declarations will yield errors.
+ */
+/* GDBM_NDBM_H_USES_PROTOTYPES:
+ *	This symbol, if defined, indicates that <gdbm-ndbm.h> uses real ANSI C
+ *	prototypes instead of K&R style function declarations without any
+ *	parameter information. While ANSI C prototypes are supported in C++,
+ *	K&R style function declarations will yield errors.
+ */
+/*#define I_NDBM	/**/
+/*#define I_GDBMNDBM	/**/
+/*#define I_GDBM_NDBM	/**/
+/*#define NDBM_H_USES_PROTOTYPES	/**/
+/*#define GDBMNDBM_H_USES_PROTOTYPES	/**/
+/*#define GDBM_NDBM_H_USES_PROTOTYPES	/**/
+
+/* I_NETDB:
+ *	This symbol, if defined, indicates that <netdb.h> exists and
+ *	should be included.
+ */
+/*#define I_NETDB		/**/
+
+/* I_NET_ERRNO:
+ *	This symbol, if defined, indicates that <net/errno.h> exists and
+ *	should be included.
+ */
+/*#define I_NET_ERRNO		/**/
+
+/* I_PTHREAD:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <pthread.h>.
+ */
+/*#define   I_PTHREAD	/**/
+
+/* I_PWD:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <pwd.h>.
+ */
+/* PWQUOTA:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_quota.
+ */
+/* PWAGE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_age.
+ */
+/* PWCHANGE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_change.
+ */
+/* PWCLASS:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_class.
+ */
+/* PWEXPIRE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_expire.
+ */
+/* PWCOMMENT:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_comment.
+ */
+/* PWGECOS:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_gecos.
+ */
+/* PWPASSWD:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_passwd.
+ */
+/*#define I_PWD		/**/
+/*#define PWQUOTA	/**/
+/*#define PWAGE	/**/
+/*#define PWCHANGE	/**/
+/*#define PWCLASS	/**/
+/*#define PWEXPIRE	/**/
+/*#define PWCOMMENT	/**/
+/*#define PWGECOS	/**/
+/*#define PWPASSWD	/**/
+
+/* I_SYS_ACCESS:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <sys/access.h>.
+ */
+/*#define   I_SYS_ACCESS                /**/
+
+/* I_SYS_SECURITY:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <sys/security.h>.
+ */
+/*#define   I_SYS_SECURITY	/**/
+
+/* I_SYSUIO:
+ *	This symbol, if defined, indicates that <sys/uio.h> exists and
+ *	should be included.
+ */
+/*#define	I_SYSUIO		/**/
+
+/* I_STDARG:
+ *	This symbol, if defined, indicates that <stdarg.h> exists and should
+ *	be included.
+ */
+/* I_VARARGS:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <varargs.h>.
+ */
+#define I_STDARG		/**/
+/*#define I_VARARGS	/**/
+
+/* PERL_INC_VERSION_LIST:
+ *	This variable specifies the list of subdirectories in over
+ *	which perl.c:incpush() and lib/lib.pm will automatically
+ *	search when adding directories to @INC, in a format suitable
+ *	for a C initialization string.  See the inc_version_list entry
+ *	in Porting/Glossary for more details.
+ */
+/*#define PERL_INC_VERSION_LIST 0		/**/
+
+/* INSTALL_USR_BIN_PERL:
+ *	This symbol, if defined, indicates that Perl is to be installed
+ * 	also as /usr/bin/perl.
+ */
+/*#define INSTALL_USR_BIN_PERL	/**/
+
+/* Off_t:
+ *	This symbol holds the type used to declare offsets in the kernel.
+ *	It can be int, long, off_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+/* LSEEKSIZE:
+ *	This symbol holds the number of bytes used by the Off_t.
+ */
+/* Off_t_size:
+ *	This symbol holds the number of bytes used by the Off_t.
+ */
+#define Off_t long		/* <offset> type */
+#define LSEEKSIZE 4		/* <offset> size */
+#define Off_t_size 4	/* <offset> size */
+
+/* Free_t:
+ *	This variable contains the return type of free().  It is usually
+ * void, but occasionally int.
+ */
+/* Malloc_t:
+ *	This symbol is the type of pointer returned by malloc and realloc.
+ */
+#define Malloc_t void *			/**/
+#define Free_t void			/**/
+
+/* PERL_MALLOC_WRAP:
+ *	This symbol, if defined, indicates that we'd like malloc wrap checks.
+ */
+#define PERL_MALLOC_WRAP		/**/
+
+/* MYMALLOC:
+ *	This symbol, if defined, indicates that we're using our own malloc.
+ */
+/*#define MYMALLOC			/**/
+
+/* Mode_t:
+ *	This symbol holds the type used to declare file modes
+ *	for systems calls.  It is usually mode_t, but may be
+ *	int or unsigned short.  It may be necessary to include <sys/types.h>
+ *	to get any typedef'ed information.
+ */
+#define Mode_t mode_t	 /* file mode parameter for system calls */
+
+/* Netdb_host_t:
+ *	This symbol holds the type used for the 1st argument
+ *	to gethostbyaddr().
+ */
+/* Netdb_hlen_t:
+ *	This symbol holds the type used for the 2nd argument
+ *	to gethostbyaddr().
+ */
+/* Netdb_name_t:
+ *	This symbol holds the type used for the argument to
+ *	gethostbyname().
+ */
+/* Netdb_net_t:
+ *	This symbol holds the type used for the 1st argument to
+ *	getnetbyaddr().
+ */
+#define Netdb_host_t		char * /**/
+#define Netdb_hlen_t		int /**/
+#define Netdb_name_t		char * /**/
+#define Netdb_net_t		long /**/
+
+/* PERL_OTHERLIBDIRS:
+ *	This variable contains a colon-separated set of paths for the perl
+ *	binary to search for additional library files or modules.
+ *	These directories will be tacked to the end of @INC.
+ *	Perl will automatically search below each path for version-
+ *	and architecture-specific directories.  See PERL_INC_VERSION_LIST
+ *	for more details.
+ */
+/*#define PERL_OTHERLIBDIRS ""		/**/
+
+/* Pid_t:
+ *	This symbol holds the type used to declare process ids in the kernel.
+ *	It can be int, uint, pid_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Pid_t int		/* PID type */
+
+/* PRIVLIB:
+ *	This symbol contains the name of the private library for this package.
+ *	The library is private in the sense that it needn't be in anyone's
+ *	execution path, but it should be accessible by the world.  The program
+ *	should be prepared to do ~ expansion.
+ */
+/* PRIVLIB_EXP:
+ *	This symbol contains the ~name expanded version of PRIVLIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define PRIVLIB "c:\\perl\\lib"		/**/
+#define PRIVLIB_EXP (win32_get_privlib("5.11.0"))	/**/
+
+/* CAN_PROTOTYPE:
+ *	If defined, this macro indicates that the C compiler can handle
+ *	function prototypes.
+ */
+/* _:
+ *	This macro is used to declare function parameters for folks who want
+ *	to make declarations with prototypes using a different style than
+ *	the above macros.  Use double parentheses.  For example:
+ *
+ *		int main _((int argc, char *argv[]));
+ */
+#define	CAN_PROTOTYPE	/**/
+#ifdef CAN_PROTOTYPE
+#define	_(args) args
+#else
+#define	_(args) ()
+#endif
+
+/* Select_fd_set_t:
+ *	This symbol holds the type used for the 2nd, 3rd, and 4th
+ *	arguments to select.  Usually, this is 'fd_set *', if HAS_FD_SET
+ *	is defined, and 'int *' otherwise.  This is only useful if you
+ *	have select(), of course.
+ */
+#define Select_fd_set_t 	Perl_fd_set *	/**/
+
+/* SH_PATH:
+ *	This symbol contains the full pathname to the shell used on this
+ *	on this system to execute Bourne shell scripts.  Usually, this will be
+ *	/bin/sh, though it's possible that some systems will have /bin/ksh,
+ *	/bin/pdksh, /bin/ash, /bin/bash, or even something such as
+ *	D:/bin/sh.exe.
+ */
+#define SH_PATH "cmd /x /c"  /**/
+
+/* SIG_NAME:
+ *	This symbol contains a list of signal names in order of
+ *	signal number. This is intended
+ *	to be used as a static array initialization, like this:
+ *		char *sig_name[] = { SIG_NAME };
+ *	The signals in the list are separated with commas, and each signal
+ *	is surrounded by double quotes. There is no leading SIG in the signal
+ *	name, i.e. SIGQUIT is known as "QUIT".
+ *	Gaps in the signal numbers (up to NSIG) are filled in with NUMnn,
+ *	etc., where nn is the actual signal number (e.g. NUM37).
+ *	The signal number for sig_name[i] is stored in sig_num[i].
+ *	The last element is 0 to terminate the list with a NULL.  This
+ *	corresponds to the 0 at the end of the sig_name_init list.
+ *	Note that this variable is initialized from the sig_name_init,
+ *	not from sig_name (which is unused).
+ */
+/* SIG_NUM:
+ *	This symbol contains a list of signal numbers, in the same order as the
+ *	SIG_NAME list. It is suitable for static array initialization, as in:
+ *		int sig_num[] = { SIG_NUM };
+ *	The signals in the list are separated with commas, and the indices
+ *	within that list and the SIG_NAME list match, so it's easy to compute
+ *	the signal name from a number or vice versa at the price of a small
+ *	dynamic linear lookup.
+ *	Duplicates are allowed, but are moved to the end of the list.
+ *	The signal number corresponding to sig_name[i] is sig_number[i].
+ *	if (i < NSIG) then sig_number[i] == i.
+ *	The last element is 0, corresponding to the 0 at the end of
+ *	the sig_name_init list.
+ *	Note that this variable is initialized from the sig_num_init,
+ *	not from sig_num (which is unused).
+ */
+/* SIG_SIZE:
+ *	This variable contains the number of elements of the SIG_NAME
+ *	and SIG_NUM arrays, excluding the final NULL entry.
+ */
+#define SIG_NAME "ZERO", "HUP", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "NUM16", "NUM17", "NUM18", "NUM19", "CHLD", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0		/**/
+#define SIG_NUM  0, 1, 2, 21, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 20, 0		/**/
+#define SIG_SIZE 27			/**/
+
+/* SITEARCH:
+ *	This symbol contains the name of the private library for this package.
+ *	The library is private in the sense that it needn't be in anyone's
+ *	execution path, but it should be accessible by the world.  The program
+ *	should be prepared to do ~ expansion.
+ *	The standard distribution will put nothing in this directory.
+ *	After perl has been installed, users may install their own local
+ *	architecture-dependent modules in this directory with
+ *		MakeMaker Makefile.PL
+ *	or equivalent.  See INSTALL for details.
+ */
+/* SITEARCH_EXP:
+ *	This symbol contains the ~name expanded version of SITEARCH, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define SITEARCH "c:\\perl\\site\\lib"		/**/
+/*#define SITEARCH_EXP ""	/**/
+
+/* SITELIB:
+ *	This symbol contains the name of the private library for this package.
+ *	The library is private in the sense that it needn't be in anyone's
+ *	execution path, but it should be accessible by the world.  The program
+ *	should be prepared to do ~ expansion.
+ *	The standard distribution will put nothing in this directory.
+ *	After perl has been installed, users may install their own local
+ *	architecture-independent modules in this directory with
+ *		MakeMaker Makefile.PL
+ *	or equivalent.  See INSTALL for details.
+ */
+/* SITELIB_EXP:
+ *	This symbol contains the ~name expanded version of SITELIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+/* SITELIB_STEM:
+ *	This define is SITELIB_EXP with any trailing version-specific component
+ *	removed.  The elements in inc_version_list (inc_version_list.U) can
+ *	be tacked onto this variable to generate a list of directories to search.
+ */
+#define SITELIB "c:\\perl\\site\\lib"		/**/
+#define SITELIB_EXP (win32_get_sitelib("5.11.0"))	/**/
+#define SITELIB_STEM ""		/**/
+
+/* Size_t_size:
+ *	This symbol holds the size of a Size_t in bytes.
+ */
+#define Size_t_size 4		/**/
+
+/* Size_t:
+ *	This symbol holds the type used to declare length parameters
+ *	for string functions.  It is usually size_t, but may be
+ *	unsigned long, int, etc.  It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Size_t size_t	 /* length paramater for string functions */
+
+/* Sock_size_t:
+ *	This symbol holds the type used for the size argument of
+ *	various socket calls (just the base type, not the pointer-to).
+ */
+#define Sock_size_t		int /**/
+
+/* STDCHAR:
+ *	This symbol is defined to be the type of char used in stdio.h.
+ *	It has the values "unsigned char" or "char".
+ */
+#define STDCHAR char	/**/
+
+/* Uid_t_f:
+ *	This symbol defines the format string used for printing a Uid_t.
+ */
+#define	Uid_t_f		"ld"		/**/
+
+/* Uid_t_sign:
+ *	This symbol holds the signedess of a Uid_t.
+ *	1 for unsigned, -1 for signed.
+ */
+#define Uid_t_sign	-1		/* UID sign */
+
+/* Uid_t_size:
+ *	This symbol holds the size of a Uid_t in bytes.
+ */
+#define Uid_t_size 4		/* UID size */
+
+/* Uid_t:
+ *	This symbol holds the type used to declare user ids in the kernel.
+ *	It can be int, ushort, uid_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Uid_t uid_t		/* UID type */
+
+/* USE_ITHREADS:
+ *	This symbol, if defined, indicates that Perl should be built to
+ *	use the interpreter-based threading implementation.
+ */
+/* USE_5005THREADS:
+ *	This symbol, if defined, indicates that Perl should be built to
+ *	use the 5.005-based threading implementation.
+ *	Only valid up to 5.8.x.
+ */
+/* OLD_PTHREADS_API:
+ *	This symbol, if defined, indicates that Perl should
+ *	be built to use the old draft POSIX threads API.
+ */
+/* USE_REENTRANT_API:
+ *	This symbol, if defined, indicates that Perl should
+ *	try to use the various _r versions of library functions.
+ *	This is extremely experimental.
+ */
+/*#define	USE_5005THREADS		/**/
+/*#define	USE_ITHREADS		/**/
+#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
+#define		USE_THREADS		/* until src is revised*/
+#endif
+/*#define	OLD_PTHREADS_API		/**/
+/*#define	USE_REENTRANT_API	/**/
+
+/* PERL_VENDORARCH:
+ *	If defined, this symbol contains the name of a private library.
+ *	The library is private in the sense that it needn't be in anyone's
+ *	execution path, but it should be accessible by the world.
+ *	It may have a ~ on the front.
+ *	The standard distribution will put nothing in this directory.
+ *	Vendors who distribute perl may wish to place their own
+ *	architecture-dependent modules and extensions in this directory with
+ *		MakeMaker Makefile.PL INSTALLDIRS=vendor
+ *	or equivalent.  See INSTALL for details.
+ */
+/* PERL_VENDORARCH_EXP:
+ *	This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+/*#define PERL_VENDORARCH ""		/**/
+/*#define PERL_VENDORARCH_EXP ""		/**/
+
+/* PERL_VENDORLIB_EXP:
+ *	This symbol contains the ~name expanded version of VENDORLIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+/* PERL_VENDORLIB_STEM:
+ *	This define is PERL_VENDORLIB_EXP with any trailing version-specific component
+ *	removed.  The elements in inc_version_list (inc_version_list.U) can
+ *	be tacked onto this variable to generate a list of directories to search.
+ */
+/*#define PERL_VENDORLIB_EXP ""		/**/
+/*#define PERL_VENDORLIB_STEM ""		/**/
+
+/* VOIDFLAGS:
+ *	This symbol indicates how much support of the void type is given by this
+ *	compiler.  What various bits mean:
+ *
+ *	    1 = supports declaration of void
+ *	    2 = supports arrays of pointers to functions returning void
+ *	    4 = supports comparisons between pointers to void functions and
+ *		    addresses of void functions
+ *	    8 = suports declaration of generic void pointers
+ *
+ *	The package designer should define VOIDUSED to indicate the requirements
+ *	of the package.  This can be done either by #defining VOIDUSED before
+ *	including config.h, or by defining defvoidused in Myinit.U.  If the
+ *	latter approach is taken, only those flags will be tested.  If the
+ *	level of void support necessary is not present, defines void to int.
+ */
+#ifndef VOIDUSED
+#define VOIDUSED 15
+#endif
+#define VOIDFLAGS 15
+#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
+#define void int		/* is void to be avoided? */
+#define M_VOID			/* Xenix strikes again */
+#endif
+
+/* USE_CROSS_COMPILE:
+ *	This symbol, if defined, indicates that Perl is being cross-compiled.
+ */
+/* PERL_TARGETARCH:
+ *	This symbol, if defined, indicates the target architecture
+ *	Perl has been cross-compiled to.  Undefined if not a cross-compile.
+ */
+#ifndef USE_CROSS_COMPILE
+/*#define	USE_CROSS_COMPILE	/**/
+#define	PERL_TARGETARCH	""	/**/
+#endif
+
+/* MEM_ALIGNBYTES:
+ *	This symbol contains the number of bytes required to align a
+ *	double, or a long double when applicable. Usual values are 2,
+ *	4 and 8. The default is eight, for safety.
+ */
+#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH)
+#  define MEM_ALIGNBYTES 8
+#else
+#define MEM_ALIGNBYTES 8
+#endif
+
+/* BYTEORDER:
+ *	This symbol holds the hexadecimal constant defined in byteorder,
+ *	in a UV, i.e. 0x1234 or 0x4321 or 0x12345678, etc...
+ *	If the compiler supports cross-compiling or multiple-architecture
+ *	binaries (eg. on NeXT systems), use compiler-defined macros to
+ *	determine the byte order.
+ *	On NeXT 3.2 (and greater), you can build "Fat" Multiple Architecture
+ *	Binaries (MAB) on either big endian or little endian machines.
+ *	The endian-ness is available at compile-time.  This only matters
+ *	for perl, where the config.h can be generated and installed on
+ *	one system, and used by a different architecture to build an
+ *	extension.  Older versions of NeXT that might not have
+ *	defined either *_ENDIAN__ were all on Motorola 680x0 series,
+ *	so the default case (for NeXT) is big endian to catch them.
+ *	This might matter for NeXT 3.0.
+ */
+#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH)
+#  ifdef __LITTLE_ENDIAN__
+#    if LONGSIZE == 4
+#      define BYTEORDER 0x1234
+#    else
+#      if LONGSIZE == 8
+#        define BYTEORDER 0x12345678
+#      endif
+#    endif
+#  else
+#    ifdef __BIG_ENDIAN__
+#      if LONGSIZE == 4
+#        define BYTEORDER 0x4321
+#      else
+#        if LONGSIZE == 8
+#          define BYTEORDER 0x87654321
+#        endif
+#      endif
+#    endif
+#  endif
+#  if !defined(BYTEORDER) && (defined(NeXT) || defined(__NeXT__))
+#    define BYTEORDER 0x4321
+#  endif
+#else
+#define BYTEORDER 0x1234	/* large digits for MSB */
+#endif /* NeXT */
+
+/* CASTI32:
+ *	This symbol is defined if the C compiler can cast negative
+ *	or large floating point numbers to 32-bit ints.
+ */
+#ifdef __GNUC__
+#   define	CASTI32		/**/
+#endif
+
+/* CASTNEGFLOAT:
+ *	This symbol is defined if the C compiler can cast negative
+ *	numbers to unsigned longs, ints and shorts.
+ */
+/* CASTFLAGS:
+ *	This symbol contains flags that say what difficulties the compiler
+ *	has casting odd floating values to unsigned long:
+ *		0 = ok
+ *		1 = couldn't cast < 0
+ *		2 = couldn't cast >= 0x80000000
+ *		4 = couldn't cast in argument expression list
+ */
+#define	CASTNEGFLOAT		/**/
+#define CASTFLAGS 0		/**/
+
+/* VOID_CLOSEDIR:
+ *	This symbol, if defined, indicates that the closedir() routine
+ *	does not return a value.
+ */
+/*#define VOID_CLOSEDIR		/**/
+
+/* HAS_FD_SET:
+ *	This symbol, when defined, indicates presence of the fd_set typedef
+ *	in <sys/types.h>
+ */
+#define HAS_FD_SET	/**/
+
+/* Gconvert:
+ *	This preprocessor macro is defined to convert a floating point
+ *	number to a string without a trailing decimal point.  This
+ *	emulates the behavior of sprintf("%g"), but is sometimes much more
+ *	efficient.  If gconvert() is not available, but gcvt() drops the
+ *	trailing decimal point, then gcvt() is used.  If all else fails,
+ *	a macro using sprintf("%g") is used. Arguments for the Gconvert
+ *	macro are: value, number of digits, whether trailing zeros should
+ *	be retained, and the output buffer.
+ *	The usual values are:
+ *		d_Gconvert='gconvert((x),(n),(t),(b))'
+ *		d_Gconvert='gcvt((x),(n),(b))'
+ *		d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+ *	The last two assume trailing zeros should not be kept.
+ */
+#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x))
+
+/* HAS_GETPAGESIZE:
+ *	This symbol, if defined, indicates that the getpagesize system call
+ *	is available to get system page size, which is the granularity of
+ *	many memory management calls.
+ */
+/*#define HAS_GETPAGESIZE		/**/
+
+/* HAS_GNULIBC:
+ *	This symbol, if defined, indicates to the C program that
+ *	the GNU C library is being used.  A better check is to use
+ *	the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc.
+ */
+/*#define HAS_GNULIBC  	/**/
+#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)
+#   define _GNU_SOURCE
+#endif
+
+/* HAS_ISASCII:
+ *	This manifest constant lets the C program know that isascii
+ *	is available.
+ */
+#define HAS_ISASCII		/**/
+
+/* HAS_LCHOWN:
+ *	This symbol, if defined, indicates that the lchown routine is
+ *	available to operate on a symbolic link (instead of following the
+ *	link).
+ */
+/*#define HAS_LCHOWN		/**/
+
+/* HAS_OPEN3:
+ *	This manifest constant lets the C program know that the three
+ *	argument form of open(2) is available.
+ */
+/*#define HAS_OPEN3		/**/
+
+/* HAS_SAFE_BCOPY:
+ *	This symbol, if defined, indicates that the bcopy routine is available
+ *	to copy potentially overlapping memory blocks. Normally, you should
+ *	probably use memmove() or memcpy(). If neither is defined, roll your
+ *	own version.
+ */
+/*#define HAS_SAFE_BCOPY	/**/
+
+/* HAS_SAFE_MEMCPY:
+ *	This symbol, if defined, indicates that the memcpy routine is available
+ *	to copy potentially overlapping memory blocks.  If you need to
+ *	copy overlapping memory blocks, you should check HAS_MEMMOVE and
+ *	use memmove() instead, if available.
+ */
+/*#define HAS_SAFE_MEMCPY	/**/
+
+/* HAS_SANE_MEMCMP:
+ *	This symbol, if defined, indicates that the memcmp routine is available
+ *	and can be used to compare relative magnitudes of chars with their high
+ *	bits set.  If it is not defined, roll your own version.
+ */
+#define HAS_SANE_MEMCMP	/**/
+
+/* HAS_SIGACTION:
+ *	This symbol, if defined, indicates that Vr4's sigaction() routine
+ *	is available.
+ */
+/*#define HAS_SIGACTION	/**/
+
+/* HAS_SIGSETJMP:
+ *	This variable indicates to the C program that the sigsetjmp()
+ *	routine is available to save the calling process's registers
+ *	and stack environment for later use by siglongjmp(), and
+ *	to optionally save the process's signal mask.  See
+ *	Sigjmp_buf, Sigsetjmp, and Siglongjmp.
+ */
+/* Sigjmp_buf:
+ *	This is the buffer type to be used with Sigsetjmp and Siglongjmp.
+ */
+/* Sigsetjmp:
+ *	This macro is used in the same way as sigsetjmp(), but will invoke
+ *	traditional setjmp() if sigsetjmp isn't available.
+ *	See HAS_SIGSETJMP.
+ */
+/* Siglongjmp:
+ *	This macro is used in the same way as siglongjmp(), but will invoke
+ *	traditional longjmp() if siglongjmp isn't available.
+ *	See HAS_SIGSETJMP.
+ */
+/*#define HAS_SIGSETJMP	/**/
+#ifdef HAS_SIGSETJMP
+#define Sigjmp_buf sigjmp_buf
+#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask))
+#define Siglongjmp(buf,retval) siglongjmp((buf),(retval))
+#else
+#define Sigjmp_buf jmp_buf
+#define Sigsetjmp(buf,save_mask) setjmp((buf))
+#define Siglongjmp(buf,retval) longjmp((buf),(retval))
+#endif
 
 /* USE_STDIO_PTR:
  *	This symbol is defined if the _ptr and _cnt fields (or similar)
@@ -3071,37 +3166,763 @@
 #define FILE_bufsiz(fp)	((fp)->_cnt + (fp)->_ptr - (fp)->_base)
 #endif
 
-/* HAS_STRERROR:
- *	This symbol, if defined, indicates that the strerror routine is
- *	available to translate error numbers to strings. See the writeup
- *	of Strerror() in this file before you try to define your own.
+/* HAS_VPRINTF:
+ *	This symbol, if defined, indicates that the vprintf routine is available
+ *	to printf with a pointer to an argument list.  If unavailable, you
+ *	may need to write your own, probably in terms of _doprnt().
  */
-/* HAS_SYS_ERRLIST:
- *	This symbol, if defined, indicates that the sys_errlist array is
- *	available to translate error numbers to strings. The extern int
- *	sys_nerr gives the size of that table.
+/* USE_CHAR_VSPRINTF:
+ *	This symbol is defined if this system has vsprintf() returning type
+ *	(char*).  The trend seems to be to declare it as "int vsprintf()".  It
+ *	is up to the package author to declare vsprintf correctly based on the
+ *	symbol.
  */
-/* Strerror:
- *	This preprocessor symbol is defined as a macro if strerror() is
- *	not available to translate error numbers to strings but sys_errlist[]
- *	array is there.
+#define HAS_VPRINTF	/**/
+/*#define USE_CHAR_VSPRINTF 	/**/
+
+/* DOUBLESIZE:
+ *	This symbol contains the size of a double, so that the C preprocessor
+ *	can make decisions based on it.
  */
-#define HAS_STRERROR		/**/
-#define HAS_SYS_ERRLIST	/**/
-#define Strerror(e) strerror(e)
+#define DOUBLESIZE 8		/**/
 
-/* HAS_STRERROR_R:
- *	This symbol, if defined, indicates that the strerror_r routine
- *	is available to strerror re-entrantly.
+/* I_TIME:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <time.h>.
  */
-/* STRERROR_R_PROTO:
- *	This symbol encodes the prototype of strerror_r.
- *	It is zero if d_strerror_r is undef, and one of the
- *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r
- *	is defined.
+/* I_SYS_TIME:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/time.h>.
  */
-/*#define HAS_STRERROR_R	   /**/
-#define STRERROR_R_PROTO 0	   /**/
+/* I_SYS_TIME_KERNEL:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/time.h> with KERNEL defined.
+ */
+/* HAS_TM_TM_ZONE:
+ *	This symbol, if defined, indicates to the C program that
+ *	the struct tm has a tm_zone field.
+ */
+/* HAS_TM_TM_GMTOFF:
+ *	This symbol, if defined, indicates to the C program that
+ *	the struct tm has a tm_gmtoff field.
+ */
+#define I_TIME		/**/
+/*#define I_SYS_TIME		/**/
+/*#define I_SYS_TIME_KERNEL		/**/
+/*#define HAS_TM_TM_ZONE		/**/
+/*#define HAS_TM_TM_GMTOFF		/**/
+
+/* VAL_O_NONBLOCK:
+ *	This symbol is to be used during open() or fcntl(F_SETFL) to turn on
+ *	non-blocking I/O for the file descriptor. Note that there is no way
+ *	back, i.e. you cannot turn it blocking again this way. If you wish to
+ *	alternatively switch between blocking and non-blocking, use the
+ *	ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
+ */
+/* VAL_EAGAIN:
+ *	This symbol holds the errno error code set by read() when no data was
+ *	present on the non-blocking file descriptor.
+ */
+/* RD_NODATA:
+ *	This symbol holds the return code from read() when no data is present
+ *	on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
+ *	not defined, then you can't distinguish between no data and EOF by
+ *	issuing a read(). You'll have to find another way to tell for sure!
+ */
+/* EOF_NONBLOCK:
+ *	This symbol, if defined, indicates to the C program that a read() on
+ *	a non-blocking file descriptor will return 0 on EOF, and not the value
+ *	held in RD_NODATA (-1 usually, in that case!).
+ */
+#define VAL_O_NONBLOCK O_NONBLOCK
+#define VAL_EAGAIN EAGAIN
+#define RD_NODATA -1
+#define EOF_NONBLOCK
+
+/* PTRSIZE:
+ *	This symbol contains the size of a pointer, so that the C preprocessor
+ *	can make decisions based on it.  It will be sizeof(void *) if
+ *	the compiler supports (void *); otherwise it will be
+ *	sizeof(char *).
+ */
+#define PTRSIZE 4		/**/
+
+/* Drand01:
+ *	This macro is to be used to generate uniformly distributed
+ *	random numbers over the range [0., 1.[.  You may have to supply
+ *	an 'extern double drand48();' in your program since SunOS 4.1.3
+ *	doesn't provide you with anything relevant in its headers.
+ *	See HAS_DRAND48_PROTO.
+ */
+/* Rand_seed_t:
+ *	This symbol defines the type of the argument of the
+ *	random seed function.
+ */
+/* seedDrand01:
+ *	This symbol defines the macro to be used in seeding the
+ *	random number generator (see Drand01).
+ */
+/* RANDBITS:
+ *	This symbol indicates how many bits are produced by the
+ *	function used to generate normalized random numbers.
+ *	Values include 15, 16, 31, and 48.
+ */
+#define Drand01()		(rand()/(double)((unsigned)1<<RANDBITS))		/**/
+#define Rand_seed_t		unsigned		/**/
+#define seedDrand01(x)	srand((Rand_seed_t)x)	/**/
+#define RANDBITS		15		/**/
+
+/* SSize_t:
+ *	This symbol holds the type used by functions that return
+ *	a count of bytes or an error condition.  It must be a signed type.
+ *	It is usually ssize_t, but may be long or int, etc.
+ *	It may be necessary to include <sys/types.h> or <unistd.h>
+ *	to get any typedef'ed information.
+ *	We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
+ */
+#define SSize_t int	 /* signed count of bytes */
+
+/* EBCDIC:
+ *     This symbol, if defined, indicates that this system uses
+ *	EBCDIC encoding.
+ */
+/*#define	EBCDIC 		/**/
+
+/* PERL_USE_DEVEL:
+ *	This symbol, if defined, indicates that Perl was configured with
+ *	-Dusedevel, to enable development features.  This should not be
+ *	done for production builds.
+ */
+/*#define	PERL_USE_DEVEL		/**/
+
+/* HAS_ATOLF:
+ *	This symbol, if defined, indicates that the atolf routine is
+ *	available to convert strings into long doubles.
+ */
+/*#define HAS_ATOLF		/**/
+
+/* HAS_ATOLL:
+ *	This symbol, if defined, indicates that the atoll routine is
+ *	available to convert strings into long longs.
+ */
+/*#define HAS_ATOLL		/**/
+
+/* HAS__FWALK:
+ *	This symbol, if defined, indicates that the _fwalk system call is
+ *	available to apply a function to all the file handles.
+ */
+/*#define HAS__FWALK		/**/
+
+/* HAS_AINTL:
+ *	This symbol, if defined, indicates that the aintl routine is
+ *	available.  If copysignl is also present we can emulate modfl.
+ */
+/*#define HAS_AINTL		/**/
+
+/* HAS_BUILTIN_CHOOSE_EXPR:
+ *	Can we handle GCC builtin for compile-time ternary-like expressions
+ */
+/* HAS_BUILTIN_EXPECT:
+ *	Can we handle GCC builtin for telling that certain values are more
+ *	likely
+ */
+/*#define HAS_BUILTIN_EXPECT	/**/
+/*#define HAS_BUILTIN_CHOOSE_EXPR	/**/
+
+/* HAS_C99_VARIADIC_MACROS:
+ *	If defined, the compiler supports C99 variadic macros.
+ */
+/*#define	HAS_C99_VARIADIC_MACROS	/**/
+
+/* HAS_CLASS:
+ *	This symbol, if defined, indicates that the class routine is
+ *	available to classify doubles.  Available for example in AIX.
+ *	The returned values are defined in <float.h> and are:
+ *
+ *	FP_PLUS_NORM	Positive normalized, nonzero
+ *	FP_MINUS_NORM	Negative normalized, nonzero
+ *	FP_PLUS_DENORM	Positive denormalized, nonzero
+ *	FP_MINUS_DENORM	Negative denormalized, nonzero
+ *	FP_PLUS_ZERO	+0.0
+ *	FP_MINUS_ZERO	-0.0
+ *	FP_PLUS_INF	+INF
+ *	FP_MINUS_INF	-INF
+ *	FP_NANS		Signaling Not a Number (NaNS)
+ *	FP_NANQ		Quiet Not a Number (NaNQ)
+ */
+/*#define HAS_CLASS		/**/
+
+/* HAS_CLEARENV:
+ *	This symbol, if defined, indicates that the clearenv () routine is
+ *	available for use.
+ */
+/*#define HAS_CLEARENV		/**/
+
+/* HAS_STRUCT_CMSGHDR:
+ *	This symbol, if defined, indicates that the struct cmsghdr
+ *	is supported.
+ */
+/*#define HAS_STRUCT_CMSGHDR	/**/
+
+/* HAS_COPYSIGNL:
+ *	This symbol, if defined, indicates that the copysignl routine is
+ *	available.  If aintl is also present we can emulate modfl.
+ */
+/*#define HAS_COPYSIGNL		/**/
+
+/* USE_CPLUSPLUS:
+ *	This symbol, if defined, indicates that a C++ compiler was
+ *	used to compiled Perl and will be used to compile extensions.
+ */
+/*#define USE_CPLUSPLUS		/**/
+
+/* HAS_DBMINIT_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the dbminit() function.  Otherwise, it is up
+ *	to the program to supply one.  A good guess is
+ *		extern int dbminit(char *);
+ */
+/*#define	HAS_DBMINIT_PROTO	/**/
+
+/* HAS_DIR_DD_FD:
+ *	This symbol, if defined, indicates that the the DIR* dirstream
+ *	structure contains a member variable named dd_fd.
+ */
+/*#define HAS_DIR_DD_FD		/**/
+
+/* HAS_DIRFD:
+ *	This manifest constant lets the C program know that dirfd
+ *	is available.
+ */
+/*#define HAS_DIRFD		/**/
+
+/* DLSYM_NEEDS_UNDERSCORE:
+ *	This symbol, if defined, indicates that we need to prepend an
+ *	underscore to the symbol name before calling dlsym().  This only
+ *	makes sense if you *have* dlsym, which we will presume is the
+ *	case if you're using dl_dlopen.xs.
+ */
+/*#define 	DLSYM_NEEDS_UNDERSCORE 	/**/
+
+/* HAS_FAST_STDIO:
+ *	This symbol, if defined, indicates that the "fast stdio"
+ *	is available to manipulate the stdio buffers directly.
+ */
+#define HAS_FAST_STDIO		/**/
+
+/* HAS_FCHDIR:
+ *	This symbol, if defined, indicates that the fchdir routine is
+ *	available to change directory using a file descriptor.
+ */
+/*#define HAS_FCHDIR		/**/
+
+/* FCNTL_CAN_LOCK:
+ *	This symbol, if defined, indicates that fcntl() can be used
+ *	for file locking.  Normally on Unix systems this is defined.
+ *	It may be undefined on VMS.
+ */
+/*#define FCNTL_CAN_LOCK		/**/
+
+/* HAS_FINITE:
+ *	This symbol, if defined, indicates that the finite routine is
+ *	available to check whether a double is finite (non-infinity non-NaN).
+ */
+/*#define HAS_FINITE		/**/
+
+/* HAS_FINITEL:
+ *	This symbol, if defined, indicates that the finitel routine is
+ *	available to check whether a long double is finite
+ *	(non-infinity non-NaN).
+ */
+/*#define HAS_FINITEL		/**/
+
+/* HAS_FLOCK_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the flock() function.  Otherwise, it is up
+ *	to the program to supply one.  A good guess is
+ *		extern int flock(int, int);
+ */
+#define	HAS_FLOCK_PROTO	/**/
+
+/* HAS_FP_CLASS:
+ *	This symbol, if defined, indicates that the fp_class routine is
+ *	available to classify doubles.  Available for example in Digital UNIX.
+ *	The returned values are defined in <math.h> and are:
+ *
+ *	FP_SNAN           Signaling NaN (Not-a-Number)
+ *	FP_QNAN           Quiet NaN (Not-a-Number)
+ *	FP_POS_INF        +infinity
+ *	FP_NEG_INF        -infinity
+ *	FP_POS_NORM       Positive normalized
+ *	FP_NEG_NORM       Negative normalized
+ *	FP_POS_DENORM     Positive denormalized
+ *	FP_NEG_DENORM     Negative denormalized
+ *	FP_POS_ZERO       +0.0 (positive zero)
+ *	FP_NEG_ZERO       -0.0 (negative zero)
+ */
+/*#define HAS_FP_CLASS		/**/
+
+/* HAS_FPCLASS:
+ *	This symbol, if defined, indicates that the fpclass routine is
+ *	available to classify doubles.  Available for example in Solaris/SVR4.
+ *	The returned values are defined in <ieeefp.h> and are:
+ *
+ *	FP_SNAN		signaling NaN
+ *	FP_QNAN		quiet NaN
+ *	FP_NINF		negative infinity
+ *	FP_PINF		positive infinity
+ *	FP_NDENORM	negative denormalized non-zero
+ *	FP_PDENORM	positive denormalized non-zero
+ *	FP_NZERO	negative zero
+ *	FP_PZERO	positive zero
+ *	FP_NNORM	negative normalized non-zero
+ *	FP_PNORM	positive normalized non-zero
+ */
+/*#define HAS_FPCLASS		/**/
+
+/* HAS_FPCLASSIFY:
+ *	This symbol, if defined, indicates that the fpclassify routine is
+ *	available to classify doubles.  Available for example in HP-UX.
+ *	The returned values are defined in <math.h> and are
+ *
+ *           FP_NORMAL     Normalized
+ *           FP_ZERO       Zero
+ *           FP_INFINITE   Infinity
+ *           FP_SUBNORMAL  Denormalized
+ *           FP_NAN        NaN
+ *
+ */
+/*#define HAS_FPCLASSIFY		/**/
+
+/* HAS_FPCLASSL:
+ *	This symbol, if defined, indicates that the fpclassl routine is
+ *	available to classify long doubles.  Available for example in IRIX.
+ *	The returned values are defined in <ieeefp.h> and are:
+ *
+ *	FP_SNAN		signaling NaN
+ *	FP_QNAN		quiet NaN
+ *	FP_NINF		negative infinity
+ *	FP_PINF		positive infinity
+ *	FP_NDENORM	negative denormalized non-zero
+ *	FP_PDENORM	positive denormalized non-zero
+ *	FP_NZERO	negative zero
+ *	FP_PZERO	positive zero
+ *	FP_NNORM	negative normalized non-zero
+ *	FP_PNORM	positive normalized non-zero
+ */
+/*#define HAS_FPCLASSL		/**/
+
+/* HAS_FPOS64_T:
+ *	This symbol will be defined if the C compiler supports fpos64_t.
+ */
+/*#define	HAS_FPOS64_T    	/**/
+
+/* HAS_FREXPL:
+ *	This symbol, if defined, indicates that the frexpl routine is
+ *	available to break a long double floating-point number into
+ *	a normalized fraction and an integral power of 2.
+ */
+/*#define HAS_FREXPL		/**/
+
+/* HAS_STRUCT_FS_DATA:
+ *	This symbol, if defined, indicates that the struct fs_data
+ *	to do statfs() is supported.
+ */
+/*#define HAS_STRUCT_FS_DATA	/**/
+
+/* HAS_FSEEKO:
+ *	This symbol, if defined, indicates that the fseeko routine is
+ *	available to fseek beyond 32 bits (useful for ILP32 hosts).
+ */
+/*#define HAS_FSEEKO		/**/
+
+/* HAS_FSTATFS:
+ *	This symbol, if defined, indicates that the fstatfs routine is
+ *	available to stat filesystems by file descriptors.
+ */
+/*#define HAS_FSTATFS		/**/
+
+/* HAS_FSYNC:
+ *	This symbol, if defined, indicates that the fsync routine is
+ *	available to write a file's modified data and attributes to
+ *	permanent storage.
+ */
+/*#define HAS_FSYNC		/**/
+
+/* HAS_FTELLO:
+ *	This symbol, if defined, indicates that the ftello routine is
+ *	available to ftell beyond 32 bits (useful for ILP32 hosts).
+ */
+/*#define HAS_FTELLO		/**/
+
+/* HAS_FUTIMES:
+ *	This symbol, if defined, indicates that the futimes routine is
+ *	available to change file descriptor time stamps with struct timevals.
+ */
+/*#define HAS_FUTIMES		/**/
+
+/* HAS_GETCWD:
+ *	This symbol, if defined, indicates that the getcwd routine is
+ *	available to get the current working directory.
+ */
+#define HAS_GETCWD		/**/
+
+/* HAS_GETESPWNAM:
+ *	This symbol, if defined, indicates that the getespwnam system call is
+ *	available to retrieve enchanced (shadow) password entries by name.
+ */
+/*#define HAS_GETESPWNAM		/**/
+
+/* HAS_GETFSSTAT:
+ *	This symbol, if defined, indicates that the getfsstat routine is
+ *	available to stat filesystems in bulk.
+ */
+/*#define HAS_GETFSSTAT		/**/
+
+/* HAS_GETITIMER:
+ *	This symbol, if defined, indicates that the getitimer routine is
+ *	available to return interval timers.
+ */
+/*#define HAS_GETITIMER		/**/
+
+/* HAS_GETMNT:
+ *	This symbol, if defined, indicates that the getmnt routine is
+ *	available to get filesystem mount info by filename.
+ */
+/*#define HAS_GETMNT		/**/
+
+/* HAS_GETMNTENT:
+ *	This symbol, if defined, indicates that the getmntent routine is
+ *	available to iterate through mounted file systems to get their info.
+ */
+/*#define HAS_GETMNTENT		/**/
+
+/* HAS_GETPRPWNAM:
+ *	This symbol, if defined, indicates that the getprpwnam system call is
+ *	available to retrieve protected (shadow) password entries by name.
+ */
+/*#define HAS_GETPRPWNAM		/**/
+
+/* HAS_GETSPNAM:
+ *	This symbol, if defined, indicates that the getspnam system call is
+ *	available to retrieve SysV shadow password entries by name.
+ */
+/*#define HAS_GETSPNAM		/**/
+
+/* HAS_HASMNTOPT:
+ *	This symbol, if defined, indicates that the hasmntopt routine is
+ *	available to query the mount options of file systems.
+ */
+/*#define HAS_HASMNTOPT		/**/
+
+/* HAS_ILOGBL:
+ *	This symbol, if defined, indicates that the ilogbl routine is
+ *	available.  If scalbnl is also present we can emulate frexpl.
+ */
+/*#define HAS_ILOGBL		/**/
+
+/* HAS_INT64_T:
+ *     This symbol will defined if the C compiler supports int64_t.
+ *     Usually the <inttypes.h> needs to be included, but sometimes
+ *	<sys/types.h> is enough.
+ */
+/*#define     HAS_INT64_T               /**/
+
+/* HAS_ISFINITE:
+ *	This symbol, if defined, indicates that the isfinite routine is
+ *	available to check whether a double is finite (non-infinity non-NaN).
+ */
+/*#define HAS_ISFINITE		/**/
+
+/* HAS_ISINF:
+ *	This symbol, if defined, indicates that the isinf routine is
+ *	available to check whether a double is an infinity.
+ */
+/*#define HAS_ISINF		/**/
+
+/* HAS_ISNAN:
+ *	This symbol, if defined, indicates that the isnan routine is
+ *	available to check whether a double is a NaN.
+ */
+#define HAS_ISNAN		/**/
+
+/* HAS_ISNANL:
+ *	This symbol, if defined, indicates that the isnanl routine is
+ *	available to check whether a long double is a NaN.
+ */
+/*#define HAS_ISNANL		/**/
+
+/* HAS_LDBL_DIG:
+ *	This symbol, if defined, indicates that this system's <float.h>
+ *	or <limits.h> defines the symbol LDBL_DIG, which is the number
+ *	of significant digits in a long double precision number. Unlike
+ *	for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined.
+ */
+#define HAS_LDBL_DIG 	/**/
+
+/* LIBM_LIB_VERSION:
+ *	This symbol, if defined, indicates that libm exports _LIB_VERSION
+ *	and that math.h defines the enum to manipulate it.
+ */
+/*#define LIBM_LIB_VERSION		/**/
+
+/* HAS_MADVISE:
+ *	This symbol, if defined, indicates that the madvise system call is
+ *	available to map a file into memory.
+ */
+/*#define HAS_MADVISE		/**/
+
+/* HAS_MALLOC_SIZE:
+ *	This symbol, if defined, indicates that the malloc_size
+ *	routine is available for use.
+ */
+/*#define HAS_MALLOC_SIZE		/**/
+
+/* HAS_MALLOC_GOOD_SIZE:
+ *	This symbol, if defined, indicates that the malloc_good_size
+ *	routine is available for use.
+ */
+/*#define HAS_MALLOC_GOOD_SIZE	/**/
+
+/* HAS_MKDTEMP:
+ *	This symbol, if defined, indicates that the mkdtemp routine is
+ *	available to exclusively create a uniquely named temporary directory.
+ */
+/*#define HAS_MKDTEMP		/**/
+
+/* HAS_MKSTEMPS:
+ *	This symbol, if defined, indicates that the mkstemps routine is
+ *	available to excluslvely create and open a uniquely named
+ *	(with a suffix) temporary file.
+ */
+/*#define HAS_MKSTEMPS		/**/
+
+/* HAS_MODFL:
+ *	This symbol, if defined, indicates that the modfl routine is
+ *	available to split a long double x into a fractional part f and
+ *	an integer part i such that |f| < 1.0 and (f + i) = x.
+ */
+/* HAS_MODFL_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the modfl() function.  Otherwise, it is up
+ *	to the program to supply one.
+ */
+/* HAS_MODFL_POW32_BUG:
+ *	This symbol, if defined, indicates that the modfl routine is
+ *	broken for long doubles >= pow(2, 32).
+ *	For example from 4294967303.150000 one would get 4294967302.000000
+ *	and 1.150000.  The bug has been seen in certain versions of glibc,
+ *	release 2.2.2 is known to be okay.
+ */
+/*#define HAS_MODFL		/**/
+/*#define HAS_MODFL_PROTO		/**/
+/*#define HAS_MODFL_POW32_BUG		/**/
+
+/* HAS_MPROTECT:
+ *	This symbol, if defined, indicates that the mprotect system call is
+ *	available to modify the access protection of a memory mapped file.
+ */
+/*#define HAS_MPROTECT		/**/
+
+/* HAS_STRUCT_MSGHDR:
+ *	This symbol, if defined, indicates that the struct msghdr
+ *	is supported.
+ */
+/*#define HAS_STRUCT_MSGHDR	/**/
+
+/* HAS_NL_LANGINFO:
+ *	This symbol, if defined, indicates that the nl_langinfo routine is
+ *	available to return local data.  You will also need <langinfo.h>
+ *	and therefore I_LANGINFO.
+ */
+/*#define HAS_NL_LANGINFO		/**/
+
+/* HAS_OFF64_T:
+ *	This symbol will be defined if the C compiler supports off64_t.
+ */
+/*#define	HAS_OFF64_T    		/**/
+
+/* HAS_PROCSELFEXE:
+ *	This symbol is defined if PROCSELFEXE_PATH is a symlink
+ *	to the absolute pathname of the executing program.
+ */
+/* PROCSELFEXE_PATH:
+ *	If HAS_PROCSELFEXE is defined this symbol is the filename
+ *	of the symbolic link pointing to the absolute pathname of
+ *	the executing program.
+ */
+/*#define HAS_PROCSELFEXE	/**/
+#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH)
+#define PROCSELFEXE_PATH		/**/
+#endif
+
+/* HAS_PTHREAD_ATTR_SETSCOPE:
+ *	This symbol, if defined, indicates that the pthread_attr_setscope
+ *	system call is available to set the contention scope attribute of
+ *	a thread attribute object.
+ */
+/*#define HAS_PTHREAD_ATTR_SETSCOPE		/**/
+
+/* HAS_READV:
+ *	This symbol, if defined, indicates that the readv routine is
+ *	available to do gather reads.  You will also need <sys/uio.h>
+ *	and there I_SYSUIO.
+ */
+/*#define HAS_READV		/**/
+
+/* HAS_RECVMSG:
+ *	This symbol, if defined, indicates that the recvmsg routine is
+ *	available to send structured socket messages.
+ */
+/*#define HAS_RECVMSG		/**/
+
+/* HAS_SBRK_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the sbrk() function.  Otherwise, it is up
+ *	to the program to supply one.  Good guesses are
+ *		extern void* sbrk(int);
+ *		extern void* sbrk(size_t);
+ */
+/*#define	HAS_SBRK_PROTO	/**/
+
+/* HAS_SCALBNL:
+ *	This symbol, if defined, indicates that the scalbnl routine is
+ *	available.  If ilogbl is also present we can emulate frexpl.
+ */
+/*#define HAS_SCALBNL		/**/
+
+/* HAS_SENDMSG:
+ *	This symbol, if defined, indicates that the sendmsg routine is
+ *	available to send structured socket messages.
+ */
+/*#define HAS_SENDMSG		/**/
+
+/* HAS_SETITIMER:
+ *	This symbol, if defined, indicates that the setitimer routine is
+ *	available to set interval timers.
+ */
+/*#define HAS_SETITIMER		/**/
+
+/* HAS_SETPROCTITLE:
+ *	This symbol, if defined, indicates that the setproctitle routine is
+ *	available to set process title.
+ */
+/*#define HAS_SETPROCTITLE		/**/
+
+/* USE_SFIO:
+ *	This symbol, if defined, indicates that sfio should
+ *	be used.
+ */
+/*#define	USE_SFIO		/**/
+
+/* HAS_SIGNBIT:
+ *	This symbol, if defined, indicates that the signbit routine is
+ *	available to check if the given number has the sign bit set.
+ *	This should include correct testing of -0.0.  This will only be set
+ *	if the signbit() routine is safe to use with the NV type used internally
+ *	in perl.  Users should call Perl_signbit(), which will be #defined to
+ *	the system's signbit() function or macro if this symbol is defined.
+ */
+/*#define HAS_SIGNBIT		/**/
+
+/* HAS_SIGPROCMASK:
+ *	This symbol, if defined, indicates that the sigprocmask
+ *	system call is available to examine or change the signal mask
+ *	of the calling process.
+ */
+/*#define HAS_SIGPROCMASK		/**/
+
+/* USE_SITECUSTOMIZE:
+ *	This symbol, if defined, indicates that sitecustomize should
+ *	be used.
+ */
+#ifndef USE_SITECUSTOMIZE
+/*#define	USE_SITECUSTOMIZE		/**/
+#endif
+
+/* HAS_SNPRINTF:
+ *	This symbol, if defined, indicates that the snprintf () library
+ *	function is available for use.
+ */
+/* HAS_VSNPRINTF:
+ *	This symbol, if defined, indicates that the vsnprintf () library
+ *	function is available for use.
+ */
+#define HAS_SNPRINTF	/**/
+#define HAS_VSNPRINTF	/**/
+
+/* HAS_SOCKATMARK:
+ *	This symbol, if defined, indicates that the sockatmark routine is
+ *	available to test whether a socket is at the out-of-band mark.
+ */
+/*#define HAS_SOCKATMARK		/**/
+
+/* HAS_SOCKATMARK_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the sockatmark() function.  Otherwise, it is up
+ *	to the program to supply one.  A good guess is
+ *		extern int sockatmark(int);
+ */
+/*#define	HAS_SOCKATMARK_PROTO	/**/
+
+/* HAS_SOCKS5_INIT:
+ *	This symbol, if defined, indicates that the socks5_init routine is
+ *	available to initialize SOCKS 5.
+ */
+/*#define HAS_SOCKS5_INIT		/**/
+
+/* SPRINTF_RETURNS_STRLEN:
+ *	This variable defines whether sprintf returns the length of the string
+ *	(as per the ANSI spec). Some C libraries retain compatibility with
+ *	pre-ANSI C and return a pointer to the passed in buffer; for these
+ *	this variable will be undef.
+ */
+#define SPRINTF_RETURNS_STRLEN	/**/
+
+/* HAS_SQRTL:
+ *	This symbol, if defined, indicates that the sqrtl routine is
+ *	available to do long double square roots.
+ */
+/*#define HAS_SQRTL		/**/
+
+/* HAS_SETRESGID_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the setresgid() function.  Otherwise, it is up
+ *	to the program to supply one.  Good guesses are
+ *		extern int setresgid(uid_t ruid, uid_t euid, uid_t suid);
+ */
+/*#define	HAS_SETRESGID_PROTO	/**/
+
+/* HAS_SETRESUID_PROTO:
+ *	This symbol, if defined, indicates that the system provides
+ *	a prototype for the setresuid() function.  Otherwise, it is up
+ *	to the program to supply one.  Good guesses are
+ *		extern int setresuid(uid_t ruid, uid_t euid, uid_t suid);
+ */
+/*#define	HAS_SETRESUID_PROTO	/**/
+
+/* HAS_STRUCT_STATFS_F_FLAGS:
+ *	This symbol, if defined, indicates that the struct statfs
+ *	does have the f_flags member containing the mount flags of
+ *	the filesystem containing the file.
+ *	This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3),
+ *	not from <sys/statfs.h> (SYSV).  Older BSDs (like Ultrix) do not
+ *	have statfs() and struct statfs, they have ustat() and getmnt()
+ *	with struct ustat and struct fs_data.
+ */
+/*#define HAS_STRUCT_STATFS_F_FLAGS		/**/
+
+/* HAS_STRUCT_STATFS:
+ *	This symbol, if defined, indicates that the struct statfs
+ *	to do statfs() is supported.
+ */
+/*#define HAS_STRUCT_STATFS	/**/
+
+/* HAS_FSTATVFS:
+ *	This symbol, if defined, indicates that the fstatvfs routine is
+ *	available to stat filesystems by file descriptors.
+ */
+/*#define HAS_FSTATVFS		/**/
 
 /* HAS_STRFTIME:
  *	This symbol, if defined, indicates that the strftime routine is
@@ -3113,13 +3934,13 @@
  *	This symbol, if defined, indicates that the strlcat () routine is
  *	available to do string concatenation.
  */
-/*#define HAS_STRLCAT			/**/
+/*#define HAS_STRLCAT		/**/
 
 /* HAS_STRLCPY:
  *	This symbol, if defined, indicates that the strlcpy () routine is
  *	available to do string copying.
  */
-/*#define HAS_STRLCPY			/**/
+/*#define HAS_STRLCPY		/**/
 
 /* HAS_STRTOLD:
  *	This symbol, if defined, indicates that the strtold routine is
@@ -3139,12 +3960,6 @@
  */
 /*#define HAS_STRTOQ		/**/
 
-/* HAS_STRTOUL:
- *	This symbol, if defined, indicates that the strtoul routine is
- *	available to provide conversion of strings to unsigned long.
- */
-#define HAS_STRTOUL	/**/
-
 /* HAS_STRTOULL:
  *	This symbol, if defined, indicates that the strtoull routine is
  *	available to convert strings to unsigned long longs.
@@ -3174,49 +3989,42 @@
  */
 #define	HAS_TELLDIR_PROTO	/**/
 
-/* HAS_TIME:
- *	This symbol, if defined, indicates that the time() routine exists.
+/* HAS_CTIME64:
+ *	This symbol, if defined, indicates that the ctime64 () routine is
+ *	available to do the 64bit variant of ctime ()
  */
-/* Time_t:
- *	This symbol holds the type returned by time(). It can be long,
- *	or time_t on BSD sites (in which case <sys/types.h> should be
- *	included).
+/* HAS_LOCALTIME64:
+ *	This symbol, if defined, indicates that the localtime64 () routine is
+ *	available to do the 64bit variant of localtime ()
  */
-#define HAS_TIME		/**/
-#define Time_t time_t		/* Time type */
-
-/* HAS_TIMES:
- *	This symbol, if defined, indicates that the times() routine exists.
- *	Note that this became obsolete on some systems (SUNOS), which now
- * use getrusage(). It may be necessary to include <sys/times.h>.
+/* HAS_GMTIME64:
+ *	This symbol, if defined, indicates that the gmtime64 () routine is
+ *	available to do the 64bit variant of gmtime ()
  */
-#define HAS_TIMES		/**/
-
-/* HAS_TMPNAM_R:
- *	This symbol, if defined, indicates that the tmpnam_r routine
- *	is available to tmpnam re-entrantly.
+/* HAS_MKTIME64:
+ *	This symbol, if defined, indicates that the mktime64 () routine is
+ *	available to do the 64bit variant of mktime ()
  */
-/* TMPNAM_R_PROTO:
- *	This symbol encodes the prototype of tmpnam_r.
- *	It is zero if d_tmpnam_r is undef, and one of the
- *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r
- *	is defined.
+/* HAS_DIFFTIME64:
+ *	This symbol, if defined, indicates that the difftime64 () routine is
+ *	available to do the 64bit variant of difftime ()
  */
-/*#define HAS_TMPNAM_R	   /**/
-#define TMPNAM_R_PROTO 0	   /**/
-
-/* HAS_TTYNAME_R:
- *	This symbol, if defined, indicates that the ttyname_r routine
- *	is available to ttyname re-entrantly.
+/* HAS_ASCTIME64:
+ *	This symbol, if defined, indicates that the asctime64 () routine is
+ *	available to do the 64bit variant of asctime ()
  */
-/* TTYNAME_R_PROTO:
- *	This symbol encodes the prototype of ttyname_r.
- *	It is zero if d_ttyname_r is undef, and one of the
- *	REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
- *	is defined.
+/*#define	HAS_CTIME64		/**/
+/*#define	HAS_LOCALTIME64		/**/
+/*#define	HAS_GMTIME64		/**/
+/*#define	HAS_MKTIME64		/**/
+/*#define	HAS_DIFFTIME64		/**/
+/*#define	HAS_ASCTIME64		/**/
+
+/* HAS_TIMEGM:
+ *	This symbol, if defined, indicates that the timegm routine is
+ *	available to do the opposite of gmtime ()
  */
-/*#define HAS_TTYNAME_R	   /**/
-#define TTYNAME_R_PROTO 0	   /**/
+/*#define HAS_TIMEGM		/**/
 
 /* U32_ALIGNMENT_REQUIRED:
  *	This symbol, if defined, indicates that you must access
@@ -3232,28 +4040,6 @@
  */
 /*#define HAS_UALARM		/**/
 
-/* HAS_UNION_SEMUN:
- *	This symbol, if defined, indicates that the union semun is
- *	defined by including <sys/sem.h>.  If not, the user code
- *	probably needs to define it as:
- *	union semun {
- *	    int val;
- *	    struct semid_ds *buf;
- *	    unsigned short *array;
- *	}
- */
-/* USE_SEMCTL_SEMUN:
- *	This symbol, if defined, indicates that union semun is
- *	used for semctl IPC_STAT.
- */
-/* USE_SEMCTL_SEMID_DS:
- *	This symbol, if defined, indicates that struct semid_ds * is
- *	used for semctl IPC_STAT.
- */
-#define HAS_UNION_SEMUN	/**/
-/*#define USE_SEMCTL_SEMUN	/**/
-/*#define USE_SEMCTL_SEMID_DS	/**/
-
 /* HAS_UNORDERED:
  *	This symbol, if defined, indicates that the unordered routine is
  *	available to check whether two doubles are unordered
@@ -3281,39 +4067,6 @@
  */
 /*#define HAS_USTAT		/**/
 
-/* HAS_VFORK:
- *	This symbol, if defined, indicates that vfork() exists.
- */
-/*#define HAS_VFORK	/**/
-
-/* HAS_PSEUDOFORK:
- *	This symbol, if defined, indicates that an emulation of the
- *	fork routine is available.
- */
-/*#define HAS_PSEUDOFORK	/**/
-
-/* Signal_t:
- *	This symbol's value is either "void" or "int", corresponding to the
- *	appropriate return type of a signal handler.  Thus, you can declare
- *	a signal handler using "Signal_t (*handler)()", and define the
- *	handler using "Signal_t handler(sig)".
- */
-#define Signal_t void	/* Signal handler's return type */
-
-/* HAS_VPRINTF:
- *	This symbol, if defined, indicates that the vprintf routine is available
- *	to printf with a pointer to an argument list.  If unavailable, you
- *	may need to write your own, probably in terms of _doprnt().
- */
-/* USE_CHAR_VSPRINTF:
- *	This symbol is defined if this system has vsprintf() returning type
- *	(char*).  The trend seems to be to declare it as "int vsprintf()".  It
- *	is up to the package author to declare vsprintf correctly based on the
- *	symbol.
- */
-#define HAS_VPRINTF	/**/
-/*#define USE_CHAR_VSPRINTF 	/**/
-
 /* HAS_WRITEV:
  *	This symbol, if defined, indicates that the writev routine is
  *	available to do scatter writes.
@@ -3326,18 +4079,6 @@
  */
 #define USE_DYNAMIC_LOADING		/**/
 
-/* DOUBLESIZE:
- *	This symbol contains the size of a double, so that the C preprocessor
- *	can make decisions based on it.
- */
-#define DOUBLESIZE 8		/**/
-
-/* EBCDIC:
- *     This symbol, if defined, indicates that this system uses
- *	EBCDIC encoding.
- */
-/*#define	EBCDIC 		/**/
-
 /* FFLUSH_NULL:
  *	This symbol, if defined, tells that fflush(NULL) does flush
  *	all pending stdio output.
@@ -3352,50 +4093,11 @@
 #define	FFLUSH_NULL 		/**/
 /*#define	FFLUSH_ALL 		/**/
 
-/* Fpos_t:
- *	This symbol holds the type used to declare file positions in libc.
- *	It can be fpos_t, long, uint, etc... It may be necessary to include
- *	<sys/types.h> to get any typedef'ed information.
- */
-#define Fpos_t fpos_t		/* File position type */
-
-/* Gid_t_f:
- *	This symbol defines the format string used for printing a Gid_t.
- */
-#define	Gid_t_f		"ld"		/**/
-
-/* Gid_t_sign:
- *	This symbol holds the signedess of a Gid_t.
- *	1 for unsigned, -1 for signed.
+/* I_ASSERT:
+ *	This symbol, if defined, indicates that <assert.h> exists and
+ *	could be included by the C program to get the assert() macro.
  */
-#define Gid_t_sign	-1		/* GID sign */
-
-/* Gid_t_size:
- *	This symbol holds the size of a Gid_t in bytes.
- */
-#define Gid_t_size 4		/* GID size */
-
-/* Gid_t:
- *	This symbol holds the return type of getgid() and the type of
- *	argument to setrgid() and related functions.  Typically,
- *	it is the type of group ids in the kernel. It can be int, ushort,
- *	gid_t, etc... It may be necessary to include <sys/types.h> to get
- *	any typedef'ed information.
- */
-#define Gid_t gid_t		/* Type for getgid(), etc... */
-
-/* Groups_t:
- *	This symbol holds the type used for the second argument to
- *	getgroups() and setgroups().  Usually, this is the same as
- *	gidtype (gid_t) , but sometimes it isn't.
- *	It can be int, ushort, gid_t, etc... 
- *	It may be necessary to include <sys/types.h> to get any 
- *	typedef'ed information.  This is only required if you have
- *	getgroups() or setgroups()..
- */
-#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
-#define Groups_t gid_t	/* Type for 2nd arg to [sg]etgroups() */
-#endif
+#define	I_ASSERT		/**/
 
 /* I_CRYPT:
  *	This symbol, if defined, indicates that <crypt.h> exists and
@@ -3445,17 +4147,6 @@
  */
 /*#define	I_FP_CLASS		/**/
 
-/* I_GRP:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <grp.h>.
- */
-/* GRPASSWD:
- *	This symbol, if defined, indicates to the C program that struct group
- *	in <grp.h> contains gr_passwd.
- */
-/*#define I_GRP		/**/
-/*#define GRPASSWD	/**/
-
 /* I_IEEEFP:
  *	This symbol, if defined, indicates that <ieeefp.h> exists and
  *	should be included.
@@ -3480,11 +4171,11 @@
  */
 /*#define	I_LIBUTIL		/**/
 
-/* I_MACH_CTHREADS:
- *     This symbol, if defined, indicates to the C program that it should
- *     include <mach/cthreads.h>.
+/* I_MALLOCMALLOC:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <malloc/malloc.h>.
  */
-/*#define   I_MACH_CTHREADS	/**/
+/*#define I_MALLOCMALLOC		/**/
 
 /* I_MNTENT:
  *	This symbol, if defined, indicates that <mntent.h> exists and
@@ -3492,18 +4183,6 @@
  */
 /*#define	I_MNTENT		/**/
 
-/* I_NDBM:
- *	This symbol, if defined, indicates that <ndbm.h> exists and should
- *	be included.
- */
-/*#define I_NDBM	/**/
-
-/* I_NETDB:
- *	This symbol, if defined, indicates that <netdb.h> exists and
- *	should be included.
- */
-/*#define I_NETDB		/**/
-
 /* I_NETINET_TCP:
  *     This symbol, if defined, indicates to the C program that it should
  *     include <netinet/tcp.h>.
@@ -3522,58 +4201,6 @@
  */
 /*#define	I_PROT		/**/
 
-/* I_PTHREAD:
- *     This symbol, if defined, indicates to the C program that it should
- *     include <pthread.h>.
- */
-/*#define   I_PTHREAD	/**/
-
-/* I_PWD:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <pwd.h>.
- */
-/* PWQUOTA:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_quota.
- */
-/* PWAGE:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_age.
- */
-/* PWCHANGE:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_change.
- */
-/* PWCLASS:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_class.
- */
-/* PWEXPIRE:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_expire.
- */
-/* PWCOMMENT:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_comment.
- */
-/* PWGECOS:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_gecos.
- */
-/* PWPASSWD:
- *	This symbol, if defined, indicates to the C program that struct passwd
- *	contains pw_passwd.
- */
-/*#define I_PWD		/**/
-/*#define PWQUOTA	/**/
-/*#define PWAGE	/**/
-/*#define PWCHANGE	/**/
-/*#define PWCLASS	/**/
-/*#define PWEXPIRE	/**/
-/*#define PWCOMMENT	/**/
-/*#define PWGECOS	/**/
-/*#define PWPASSWD	/**/
-
 /* I_SHADOW:
  *	This symbol, if defined, indicates that <shadow.h> exists and
  *	should be included.
@@ -3621,12 +4248,6 @@
  */
 /*#define	I_SYS_STATVFS		/**/
 
-/* I_SYSUIO:
- *	This symbol, if defined, indicates that <sys/uio.h> exists and
- *	should be included.
- */
-/*#define	I_SYSUIO		/**/
-
 /* I_SYSUTSNAME:
  *	This symbol, if defined, indicates that <sys/utsname.h> exists and
  *	should be included.
@@ -3639,64 +4260,12 @@
  */
 /*#define	I_SYS_VFS		/**/
 
-/* I_TIME:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <time.h>.
- */
-/* I_SYS_TIME:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <sys/time.h>.
- */
-/* I_SYS_TIME_KERNEL:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <sys/time.h> with KERNEL defined.
- */
-/* HAS_TM_TM_ZONE:
- *	This symbol, if defined, indicates to the C program that
- *	the struct tm has a tm_zone field.
- */
-/* HAS_TM_TM_GMTOFF:
- *	This symbol, if defined, indicates to the C program that
- *	the struct tm has a tm_gmtoff field.
- */
-#define I_TIME		/**/
-/*#define I_SYS_TIME		/**/
-/*#define I_SYS_TIME_KERNEL		/**/
-/*#define HAS_TM_TM_ZONE		/**/
-/*#define HAS_TM_TM_GMTOFF		/**/
-
 /* I_USTAT:
  *	This symbol, if defined, indicates that <ustat.h> exists and
  *	should be included.
  */
 /*#define	I_USTAT		/**/
 
-/* I_STDARG:
- *	This symbol, if defined, indicates that <stdarg.h> exists and should
- *	be included.
- */
-/* I_VARARGS:
- *	This symbol, if defined, indicates to the C program that it should
- *	include <varargs.h>.
- */
-#define I_STDARG		/**/
-/*#define I_VARARGS	/**/
-
-/* PERL_INC_VERSION_LIST:
- *	This variable specifies the list of subdirectories in over
- *	which perl.c:incpush() and lib/lib.pm will automatically
- *	search when adding directories to @INC, in a format suitable
- *	for a C initialization string.  See the inc_version_list entry
- *	in Porting/Glossary for more details.
- */
-#define PERL_INC_VERSION_LIST 0		/**/
-
-/* INSTALL_USR_BIN_PERL:
- *	This symbol, if defined, indicates that Perl is to be installed
- * 	also as /usr/bin/perl.
- */
-/*#define INSTALL_USR_BIN_PERL	/**/
-
 /* PERL_PRIfldbl:
  *	This symbol, if defined, contains the string used by stdio to
  *	format long doubles (format 'f') for output.
@@ -3718,86 +4287,12 @@
 /*#define PERL_PRIeldbl	"e"	/**/
 /*#define PERL_SCNfldbl	"f"	/**/
 
-/* Off_t:
- *	This symbol holds the type used to declare offsets in the kernel.
- *	It can be int, long, off_t, etc... It may be necessary to include
- *	<sys/types.h> to get any typedef'ed information.
- */
-/* LSEEKSIZE:
- *	This symbol holds the number of bytes used by the Off_t.
- */
-/* Off_t_size:
- *	This symbol holds the number of bytes used by the Off_t.
- */
-#ifndef __GNUC__
-#   define Off_t __int64		/* <offset> type */
-#else
-#   define Off_t long long		/* <offset> type */
-#endif
-#define LSEEKSIZE 8		/* <offset> size */
-#define Off_t_size 8	/* <offset> size */
-
 /* PERL_MAD:
  *	This symbol, if defined, indicates that the Misc Attribution
  *	Declaration code should be conditionally compiled.
  */
 /*#define	PERL_MAD		/**/
 
-/* Free_t:
- *	This variable contains the return type of free().  It is usually
- * void, but occasionally int.
- */
-/* Malloc_t:
- *	This symbol is the type of pointer returned by malloc and realloc.
- */
-#define Malloc_t void *			/**/
-#define Free_t void			/**/
-
-/* PERL_MALLOC_WRAP:
- *	This symbol, if defined, indicates that we'd like malloc wrap checks.
- */
-#define PERL_MALLOC_WRAP		/**/
-
-/* MYMALLOC:
- *	This symbol, if defined, indicates that we're using our own malloc.
- */
-/*#define MYMALLOC			/**/
-
-/* Mode_t:
- *	This symbol holds the type used to declare file modes 
- *	for systems calls.  It is usually mode_t, but may be
- *	int or unsigned short.  It may be necessary to include <sys/types.h>
- *	to get any typedef'ed information.
- */
-#define Mode_t mode_t	 /* file mode parameter for system calls */
-
-/* VAL_O_NONBLOCK:
- *	This symbol is to be used during open() or fcntl(F_SETFL) to turn on
- *	non-blocking I/O for the file descriptor. Note that there is no way
- *	back, i.e. you cannot turn it blocking again this way. If you wish to
- *	alternatively switch between blocking and non-blocking, use the
- *	ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
- */
-/* VAL_EAGAIN:
- *	This symbol holds the errno error code set by read() when no data was
- *	present on the non-blocking file descriptor.
- */
-/* RD_NODATA:
- *	This symbol holds the return code from read() when no data is present
- *	on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
- *	not defined, then you can't distinguish between no data and EOF by
- *	issuing a read(). You'll have to find another way to tell for sure!
- */
-/* EOF_NONBLOCK:
- *	This symbol, if defined, indicates to the C program that a read() on
- *	a non-blocking file descriptor will return 0 on EOF, and not the value
- *	held in RD_NODATA (-1 usually, in that case!).
- */
-#define VAL_O_NONBLOCK O_NONBLOCK
-#define VAL_EAGAIN EAGAIN
-#define RD_NODATA -1
-#define EOF_NONBLOCK
-
 /* NEED_VA_COPY:
  *	This symbol, if defined, indicates that the system stores
  *	the variable argument list datatype, va_list, in a format
@@ -3809,58 +4304,6 @@
  */
 /*#define	NEED_VA_COPY		/**/
 
-/* Netdb_host_t:
- *	This symbol holds the type used for the 1st argument
- *	to gethostbyaddr().
- */
-/* Netdb_hlen_t:
- *	This symbol holds the type used for the 2nd argument
- *	to gethostbyaddr().
- */
-/* Netdb_name_t:
- *	This symbol holds the type used for the argument to
- *	gethostbyname().
- */
-/* Netdb_net_t:
- *	This symbol holds the type used for the 1st argument to
- *	getnetbyaddr().
- */
-#define Netdb_host_t		char * /**/
-#define Netdb_hlen_t		int /**/
-#define Netdb_name_t		char * /**/
-#define Netdb_net_t		long /**/
-
-/* PERL_OTHERLIBDIRS:
- *	This variable contains a colon-separated set of paths for the perl
- *	binary to search for additional library files or modules.
- *	These directories will be tacked to the end of @INC.
- *	Perl will automatically search below each path for version-
- *	and architecture-specific directories.  See PERL_INC_VERSION_LIST
- *	for more details.
- */
-/*#define PERL_OTHERLIBDIRS ""		/**/
-
-/* HAS_QUAD:
- *	This symbol, if defined, tells that there's a 64-bit integer type,
- *	Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one
- *	of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, or QUAD_IS_INT64_T.
- */
-/*#define HAS_QUAD	/**/
-#ifdef HAS_QUAD
-#   ifndef __GNUC__
-#	define Quad_t __int64	/**/
-#	define Uquad_t unsigned __int64	/**/
-#   else
-#	define Quad_t long long	/**/
-#	define Uquad_t unsigned long long	/**/
-#   endif
-#   define QUADKIND 5	/**/
-#   define QUAD_IS_INT	1
-#   define QUAD_IS_LONG	2
-#   define QUAD_IS_LONG_LONG	3
-#   define QUAD_IS_INT64_T	4
-#endif
-
 /* IVTYPE:
  *	This symbol defines the C type used for Perl's IV.
  */
@@ -3935,7 +4378,13 @@
  *	This symbol contains the number of bits a variable of type NVTYPE
  *	can preserve of a variable of type UVTYPE.
  */
-/* NV_ZERO_IS_ALLBITS_ZERO
+/* NV_OVERFLOWS_INTEGERS_AT:
+ *	This symbol gives the largest integer value that NVs can hold. This
+ *	value + 1.0 cannot be stored accurately. It is expressed as constant
+ *	floating point expression to reduce the chance of decimale/binary
+ *	conversion issues. If it can not be determined, the value 0 is given.
+ */
+/* NV_ZERO_IS_ALLBITS_ZERO:
  *	This symbol, if defined, indicates that a variable of type NVTYPE
  *	stores 0.0 in memory as all bits zero.
  */
@@ -3972,8 +4421,9 @@
 #define	NVSIZE		8		/**/
 #define	NV_PRESERVES_UV
 #define	NV_PRESERVES_UV_BITS	32
-#define NV_ZERO_IS_ALLBITS_ZERO
-#if 4 == 8
+#define	NV_OVERFLOWS_INTEGERS_AT	256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0
+#define	NV_ZERO_IS_ALLBITS_ZERO
+#if UVSIZE == 8
 #   ifdef BYTEORDER
 #       if BYTEORDER == 0x1234
 #           undef BYTEORDER
@@ -4028,77 +4478,6 @@
 #define	NVff		"f"		/**/
 #define	NVgf		"g"		/**/
 
-/* Pid_t:
- *	This symbol holds the type used to declare process ids in the kernel.
- *	It can be int, uint, pid_t, etc... It may be necessary to include
- *	<sys/types.h> to get any typedef'ed information.
- */
-#define Pid_t int		/* PID type */
-
-/* PRIVLIB:
- *	This symbol contains the name of the private library for this package.
- *	The library is private in the sense that it needn't be in anyone's
- *	execution path, but it should be accessible by the world.  The program
- *	should be prepared to do ~ expansion.
- */
-/* PRIVLIB_EXP:
- *	This symbol contains the ~name expanded version of PRIVLIB, to be used
- *	in programs that are not prepared to deal with ~ expansion at run-time.
- */
-#define PRIVLIB "c:\\perl\\5.10.0\\lib"		/**/
-#define PRIVLIB_EXP (win32_get_privlib("5.10.0"))	/**/
-
-/* CAN_PROTOTYPE:
- *	If defined, this macro indicates that the C compiler can handle
- *	function prototypes.
- */
-/* _:
- *	This macro is used to declare function parameters for folks who want
- *	to make declarations with prototypes using a different style than
- *	the above macros.  Use double parentheses.  For example:
- *
- *		int main _((int argc, char *argv[]));
- */
-#define	CAN_PROTOTYPE	/**/
-#ifdef CAN_PROTOTYPE
-#define	_(args) args
-#else
-#define	_(args) ()
-#endif
-
-/* PTRSIZE:
- *	This symbol contains the size of a pointer, so that the C preprocessor
- *	can make decisions based on it.  It will be sizeof(void *) if
- *	the compiler supports (void *); otherwise it will be
- *	sizeof(char *).
- */
-#define PTRSIZE 4		/**/
-
-/* Drand01:
- *	This macro is to be used to generate uniformly distributed
- *	random numbers over the range [0., 1.[.  You may have to supply
- *	an 'extern double drand48();' in your program since SunOS 4.1.3
- *	doesn't provide you with anything relevant in its headers.
- *	See HAS_DRAND48_PROTO.
- */
-/* Rand_seed_t:
- *	This symbol defines the type of the argument of the
- *	random seed function.
- */
-/* seedDrand01:
- *	This symbol defines the macro to be used in seeding the
- *	random number generator (see Drand01).
- */
-/* RANDBITS:
- *	This symbol indicates how many bits are produced by the
- *	function used to generate normalized random numbers.
- *	Values include 15, 16, 31, and 48.
- */
-#define Drand01()		(rand()/(double)((unsigned)1<<RANDBITS))		/**/
-#define Rand_seed_t		unsigned		/**/
-#define seedDrand01(x)	srand((Rand_seed_t)x)	/**/
-#define RANDBITS		15		/**/
-
 /* SELECT_MIN_BITS:
  *	This symbol holds the minimum number of bits operated by select.
  *	That is, if you do select(n, ...), how many bits at least will be
@@ -4108,134 +4487,6 @@
  */
 #define SELECT_MIN_BITS 	32	/**/
 
-/* Select_fd_set_t:
- *	This symbol holds the type used for the 2nd, 3rd, and 4th
- *	arguments to select.  Usually, this is 'fd_set *', if HAS_FD_SET
- *	is defined, and 'int *' otherwise.  This is only useful if you 
- *	have select(), of course.
- */
-#define Select_fd_set_t 	Perl_fd_set *	/**/
-
-/* SH_PATH:
- *	This symbol contains the full pathname to the shell used on this
- *	on this system to execute Bourne shell scripts.  Usually, this will be
- *	/bin/sh, though it's possible that some systems will have /bin/ksh,
- *	/bin/pdksh, /bin/ash, /bin/bash, or even something such as
- *	D:/bin/sh.exe.
- */
-#define SH_PATH "cmd /x /c"  /**/
-
-/* SIG_NAME:
- *	This symbol contains a list of signal names in order of
- *	signal number. This is intended
- *	to be used as a static array initialization, like this:
- *		char *sig_name[] = { SIG_NAME };
- *	The signals in the list are separated with commas, and each signal
- *	is surrounded by double quotes. There is no leading SIG in the signal
- *	name, i.e. SIGQUIT is known as "QUIT".
- *	Gaps in the signal numbers (up to NSIG) are filled in with NUMnn,
- *	etc., where nn is the actual signal number (e.g. NUM37).
- *	The signal number for sig_name[i] is stored in sig_num[i].
- *	The last element is 0 to terminate the list with a NULL.  This
- *	corresponds to the 0 at the end of the sig_name_init list.
- *	Note that this variable is initialized from the sig_name_init,
- *	not from sig_name (which is unused).
- */
-/* SIG_NUM:
- *	This symbol contains a list of signal numbers, in the same order as the
- *	SIG_NAME list. It is suitable for static array initialization, as in:
- *		int sig_num[] = { SIG_NUM };
- *	The signals in the list are separated with commas, and the indices
- *	within that list and the SIG_NAME list match, so it's easy to compute
- *	the signal name from a number or vice versa at the price of a small
- *	dynamic linear lookup. 
- *	Duplicates are allowed, but are moved to the end of the list.
- *	The signal number corresponding to sig_name[i] is sig_number[i].
- *	if (i < NSIG) then sig_number[i] == i.  
- *	The last element is 0, corresponding to the 0 at the end of
- *	the sig_name_init list.
- *	Note that this variable is initialized from the sig_num_init,
- *	not from sig_num (which is unused).
- */
-/* SIG_SIZE:
- *	This variable contains the number of elements of the SIG_NAME
- *	and SIG_NUM arrays, excluding the final NULL entry.
- */
-#define SIG_NAME "ZERO", "HUP", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "NUM16", "NUM17", "NUM18", "NUM19", "CHLD", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0		/**/
-#define SIG_NUM  0, 1, 2, 21, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 20, 0		/**/
-#define SIG_SIZE 27			/**/
-
-/* SITEARCH:
- *	This symbol contains the name of the private library for this package.
- *	The library is private in the sense that it needn't be in anyone's
- *	execution path, but it should be accessible by the world.  The program
- *	should be prepared to do ~ expansion.
- *	The standard distribution will put nothing in this directory.
- *	After perl has been installed, users may install their own local
- *	architecture-dependent modules in this directory with
- *		MakeMaker Makefile.PL
- *	or equivalent.  See INSTALL for details.
- */
-/* SITEARCH_EXP:
- *	This symbol contains the ~name expanded version of SITEARCH, to be used
- *	in programs that are not prepared to deal with ~ expansion at run-time.
- */
-#define SITEARCH "c:\\perl\\site\\5.10.0\\lib\\MSWin32-x86"		/**/
-/*#define SITEARCH_EXP ""	/**/
-
-/* SITELIB:
- *	This symbol contains the name of the private library for this package.
- *	The library is private in the sense that it needn't be in anyone's
- *	execution path, but it should be accessible by the world.  The program
- *	should be prepared to do ~ expansion.
- *	The standard distribution will put nothing in this directory.
- *	After perl has been installed, users may install their own local
- *	architecture-independent modules in this directory with
- *		MakeMaker Makefile.PL
- *	or equivalent.  See INSTALL for details.
- */
-/* SITELIB_EXP:
- *	This symbol contains the ~name expanded version of SITELIB, to be used
- *	in programs that are not prepared to deal with ~ expansion at run-time.
- */
-/* SITELIB_STEM:
- *	This define is SITELIB_EXP with any trailing version-specific component
- *	removed.  The elements in inc_version_list (inc_version_list.U) can
- *	be tacked onto this variable to generate a list of directories to search.
- */
-#define SITELIB "c:\\perl\\site\\5.10.0\\lib"		/**/
-#define SITELIB_EXP (win32_get_sitelib("5.10.0"))	/**/
-#define SITELIB_STEM ""		/**/
-
-/* Size_t_size:
- *	This symbol holds the size of a Size_t in bytes.
- */
-#define Size_t_size 4		/**/
-
-/* Size_t:
- *	This symbol holds the type used to declare length parameters
- *	for string functions.  It is usually size_t, but may be
- *	unsigned long, int, etc.  It may be necessary to include
- *	<sys/types.h> to get any typedef'ed information.
- */
-#define Size_t size_t	 /* length paramater for string functions */
-
-/* Sock_size_t:
- *	This symbol holds the type used for the size argument of
- *	various socket calls (just the base type, not the pointer-to).
- */
-#define Sock_size_t		int /**/
-
-/* SSize_t:
- *	This symbol holds the type used by functions that return
- *	a count of bytes or an error condition.  It must be a signed type.
- *	It is usually ssize_t, but may be long or int, etc.
- *	It may be necessary to include <sys/types.h> or <unistd.h>
- *	to get any typedef'ed information.
- *	We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
- */
-#define SSize_t int	 /* signed count of bytes */
-
 /* STARTPERL:
  *	This variable contains the string to put in front of a perl
  *	script to make sure (one hopes) that it runs with perl and not
@@ -4243,12 +4494,6 @@
  */
 #define STARTPERL "#!perl"		/**/
 
-/* STDCHAR:
- *	This symbol is defined to be the type of char used in stdio.h.
- *	It has the values "unsigned char" or "char".
- */
-#define STDCHAR char	/**/
-
 /* HAS_STDIO_STREAM_ARRAY:
  *	This symbol, if defined, tells that there is an array
  *	holding the stdio streams.
@@ -4258,30 +4503,30 @@
  *	Usual values include _iob, __iob, and __sF.
  */
 /*#define	HAS_STDIO_STREAM_ARRAY	/**/
+#ifdef HAS_STDIO_STREAM_ARRAY
 #define STDIO_STREAM_ARRAY	
+#endif
 
-/* Uid_t_f:
- *	This symbol defines the format string used for printing a Uid_t.
+/* GMTIME_MAX:
+ *	This symbol contains the maximum value for the time_t offset that
+ *	the system function gmtime () accepts, and defaults to 0
  */
-#define	Uid_t_f		"ld"		/**/
-
-/* Uid_t_sign:
- *	This symbol holds the signedess of a Uid_t.
- *	1 for unsigned, -1 for signed.
+/* GMTIME_MIN:
+ *	This symbol contains the minimum value for the time_t offset that
+ *	the system function gmtime () accepts, and defaults to 0
  */
-#define Uid_t_sign	-1		/* UID sign */
-
-/* Uid_t_size:
- *	This symbol holds the size of a Uid_t in bytes.
+/* LOCALTIME_MAX:
+ *	This symbol contains the maximum value for the time_t offset that
+ *	the system function localtime () accepts, and defaults to 0
  */
-#define Uid_t_size 4		/* UID size */
-
-/* Uid_t:
- *	This symbol holds the type used to declare user ids in the kernel.
- *	It can be int, ushort, uid_t, etc... It may be necessary to include
- *	<sys/types.h> to get any typedef'ed information.
+/* LOCALTIME_MIN:
+ *	This symbol contains the minimum value for the time_t offset that
+ *	the system function localtime () accepts, and defaults to 0
  */
-#define Uid_t uid_t		/* UID type */
+#define GMTIME_MAX		2147483647	/**/
+#define GMTIME_MIN		0	/**/
+#define LOCALTIME_MAX	2147483647	/**/
+#define LOCALTIME_MIN	0	/**/
 
 /* USE_64_BIT_INT:
  *	This symbol, if defined, indicates that 64-bit integers should
@@ -4304,18 +4549,23 @@
 #ifndef USE_64_BIT_INT
 /*#define	USE_64_BIT_INT		/**/
 #endif
-
 #ifndef USE_64_BIT_ALL
 /*#define	USE_64_BIT_ALL		/**/
 #endif
 
+/* USE_DTRACE:
+ *	This symbol, if defined, indicates that Perl should
+ *	be built with support for DTrace.
+ */
+/*#define USE_DTRACE		/**/
+
 /* USE_FAST_STDIO:
  *	This symbol, if defined, indicates that Perl should
  *	be built to use 'fast stdio'.
  *	Defaults to define in Perls 5.8 and earlier, to undef later.
  */
 #ifndef USE_FAST_STDIO
-/*#define	USE_FAST_STDIO		/ **/
+/*#define	USE_FAST_STDIO		/**/
 #endif
 
 /* USE_LARGE_FILES:
@@ -4367,91 +4617,4 @@
 /*#define	USE_SOCKS		/**/
 #endif
 
-/* USE_ITHREADS:
- *	This symbol, if defined, indicates that Perl should be built to
- *	use the interpreter-based threading implementation.
- */
-/* USE_5005THREADS:
- *	This symbol, if defined, indicates that Perl should be built to
- *	use the 5.005-based threading implementation.
- */
-/* OLD_PTHREADS_API:
- *	This symbol, if defined, indicates that Perl should
- *	be built to use the old draft POSIX threads API.
- */
-/* USE_REENTRANT_API:
- *	This symbol, if defined, indicates that Perl should
- *	try to use the various _r versions of library functions.
- *	This is extremely experimental.
- */
-/*#define	USE_5005THREADS		/**/
-/*#define	USE_ITHREADS		/**/
-#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
-#define		USE_THREADS		/* until src is revised*/
-#endif
-/*#define	OLD_PTHREADS_API		/**/
-/*#define	USE_REENTRANT_API	/**/
-
-/* PERL_VENDORARCH:
- *	If defined, this symbol contains the name of a private library.
- *	The library is private in the sense that it needn't be in anyone's
- *	execution path, but it should be accessible by the world.
- *	It may have a ~ on the front.
- *	The standard distribution will put nothing in this directory.
- *	Vendors who distribute perl may wish to place their own
- *	architecture-dependent modules and extensions in this directory with
- *		MakeMaker Makefile.PL INSTALLDIRS=vendor
- *	or equivalent.  See INSTALL for details.
- */
-/* PERL_VENDORARCH_EXP:
- *	This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used
- *	in programs that are not prepared to deal with ~ expansion at run-time.
- */
-/*#define PERL_VENDORARCH ""		/**/
-/*#define PERL_VENDORARCH_EXP ""		/**/
-
-/* PERL_VENDORLIB_EXP:
- *	This symbol contains the ~name expanded version of VENDORLIB, to be used
- *	in programs that are not prepared to deal with ~ expansion at run-time.
- */
-/* PERL_VENDORLIB_STEM:
- *	This define is PERL_VENDORLIB_EXP with any trailing version-specific component
- *	removed.  The elements in inc_version_list (inc_version_list.U) can
- *	be tacked onto this variable to generate a list of directories to search.
- */
-/*#define PERL_VENDORLIB_EXP ""		/**/
-/*#define PERL_VENDORLIB_STEM ""		/**/
-
-/* VOIDFLAGS:
- *	This symbol indicates how much support of the void type is given by this
- *	compiler.  What various bits mean:
- *
- *	    1 = supports declaration of void
- *	    2 = supports arrays of pointers to functions returning void
- *	    4 = supports comparisons between pointers to void functions and
- *		    addresses of void functions
- *	    8 = suports declaration of generic void pointers
- *
- *	The package designer should define VOIDUSED to indicate the requirements
- *	of the package.  This can be done either by #defining VOIDUSED before
- *	including config.h, or by defining defvoidused in Myinit.U.  If the
- *	latter approach is taken, only those flags will be tested.  If the
- *	level of void support necessary is not present, defines void to int.
- */
-#ifndef VOIDUSED
-#define VOIDUSED 15
-#endif
-#define VOIDFLAGS 15
-#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
-#define void int		/* is void to be avoided? */
-#define M_VOID			/* Xenix strikes again */
-#endif
-
-/* HAS_POLL:
- *	This symbol, if defined, indicates that the poll routine is
- *	available to poll active file descriptors. You may safely
- *	include <poll.h> when both this symbol *and* I_POLL are defined.
- */
-/*#define HAS_POLL		/**/
-
 #endif
diff --git a/gnu/usr.bin/perl/win32/config_sh.PL b/gnu/usr.bin/perl/win32/config_sh.PL
index 67f9c20353a..c36eeb3a23e 100644
--- a/gnu/usr.bin/perl/win32/config_sh.PL
+++ b/gnu/usr.bin/perl/win32/config_sh.PL
@@ -43,7 +43,6 @@ while (@{$optref} && $optref->[0] =~ /^([\w_]+)=(.*)$/) {
 }
 
 FindExt::scan_ext("../ext");
-FindExt::scan_ext("ext") if -d 'ext';  # also look in win32/ext/ if it exists
 FindExt::set_static_extensions(split ' ', $opt{'static_ext'});
 
 $opt{'nonxs_ext'}        = join(' ',FindExt::nonxs_ext()) || ' ';
@@ -78,7 +77,7 @@ if (-e $patch_file) {
 $opt{VERSION} = "$opt{PERL_REVISION}.$opt{PERL_VERSION}.$opt{PERL_SUBVERSION}";
 $opt{INST_VER} =~ s|~VERSION~|$opt{VERSION}|g;
 $opt{'version_patchlevel_string'} = "version $opt{PERL_VERSION} subversion $opt{PERL_SUBVERSION}";
-$opt{'version_patchlevel_string'} .= " patchlevel $opt{PERL_PATCHLEVEL}" if exists $opt{PERL_PATCHLEVEL};
+$opt{'version_patchlevel_string'} .= " patch $opt{PERL_PATCHLEVEL}" if exists $opt{PERL_PATCHLEVEL};
 
 my $ver = `ver 2>nul`;
 if ($ver =~ /Version (\d+\.\d+)/) {
@@ -117,9 +116,29 @@ unless (defined $ENV{SYSTEMROOT}) { # SystemRoot has been introduced by WinNT
     $opt{d_link} = 'undef';
 }
 
-if ($opt{uselargefiles} ne 'define') {
-    $opt{lseeksize} = 4;
-    $opt{lseektype} = 'off_t';
+# change the lseeksize and lseektype from their canned default values (which
+# are set-up for a non-uselargefiles build) if we are building with
+# uselargefiles. don't do this for bcc32: the code contains special handling
+# for bcc32 and the lseeksize and lseektype should not be changed.
+if ($opt{uselargefiles} eq 'define' and $opt{cc} ne 'bcc32') {
+    $opt{lseeksize} = 8;
+    if ($opt{cc} eq 'cl') {
+	$opt{lseektype} = '__int64';
+    }
+    elsif ($opt{cc} eq 'gcc') {
+	$opt{lseektype} = 'long long';
+    }
+}
+
+# change the s{GM|LOCAL}TIME_{min|max} for VS2005 (aka VC 8) and
+# VS2008 (aka VC 9) or higher (presuming that later versions will have
+# at least the range of that).
+if ($opt{cc} eq 'cl' and $opt{ccversion} =~ /^(\d+)/) {
+    my $ccversion = $1;
+    if ($ccversion >= 14) {
+	$opt{sGMTIME_max} = 32535291599;
+	$opt{sLOCALTIME_max} = 32535244799;
+    }
 }
 
 if ($opt{useithreads} eq 'define' && $opt{ccflags} =~ /-DPERL_IMPLICIT_SYS\b/) {
diff --git a/gnu/usr.bin/perl/win32/dl_win32.xs b/gnu/usr.bin/perl/win32/dl_win32.xs
index 6c094d22fd4..60ec703b92e 100644
--- a/gnu/usr.bin/perl/win32/dl_win32.xs
+++ b/gnu/usr.bin/perl/win32/dl_win32.xs
@@ -187,4 +187,19 @@ dl_error()
     OUTPUT:
     RETVAL
 
+#if defined(USE_ITHREADS)
+
+void
+CLONE(...)
+    CODE:
+    MY_CXT_CLONE;
+
+    /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
+     * using Perl variables that belong to another thread, we create our 
+     * own for this thread.
+     */
+    MY_CXT.x_dl_last_error = newSVpvn("", 0);
+
+#endif
+
 # end.
diff --git a/gnu/usr.bin/perl/win32/makefile.mk b/gnu/usr.bin/perl/win32/makefile.mk
index c609fa6e307..2416728171b 100644
--- a/gnu/usr.bin/perl/win32/makefile.mk
+++ b/gnu/usr.bin/perl/win32/makefile.mk
@@ -34,7 +34,7 @@ INST_TOP	*= $(INST_DRV)\perl
 # versioned installation can be obtained by setting INST_TOP above to a

 # path that includes an arbitrary version string.

 #

-#INST_VER	*= \5.10.0

+#INST_VER	*= \5.10.1

 

 #

 # Comment this out if you DON'T want your perl installation to have

@@ -330,7 +330,7 @@ BUILDOPT	+= -DPERL_IMPLICIT_CONTEXT
 BUILDOPT	+= -DPERL_IMPLICIT_SYS

 .ENDIF

 

-.IMPORT .IGNORE : PROCESSOR_ARCHITECTURE PROCESSOR_ARCHITEW6432

+.IMPORT .IGNORE : PROCESSOR_ARCHITECTURE PROCESSOR_ARCHITEW6432 WIN64

 

 PROCESSOR_ARCHITECTURE *= x86

 

@@ -382,16 +382,13 @@ DELAYLOAD	*= -DELAYLOAD:ws2_32.dll delayimp.lib
 

 # Visual C++ 2005 and 2008 (VC++ 8.x and 9.x) create manifest files for EXEs and

 # DLLs. These either need copying everywhere with the binaries, or else need

-# embedding in them otherwise MSVCR80.dll or MSVCR90.dll won't be found. Embed

-# them for simplicity, and delete them afterwards so that they don't get

-# installed too.

-.IF "$(CCTYPE)" == "MSVC80" || "$(CCTYPE)" == "MSVC80FREE" || \

-    "$(CCTYPE)" == "MSVC90" || "$(CCTYPE)" == "MSVC90FREE"

-EMBED_EXE_MANI	= mt -nologo -manifest $@.manifest -outputresource:$@;1 && \

-		  del $@.manifest

-EMBED_DLL_MANI	= mt -nologo -manifest $@.manifest -outputresource:$@;2 && \

-		  del $@.manifest

-.ENDIF

+# embedding in them otherwise MSVCR80.dll or MSVCR90.dll won't be found. For

+# simplicity, embed them if they exist (and delete them afterwards so that they

+# don't get installed too).

+EMBED_EXE_MANI	= if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1 && \

+		  if exist $@.manifest del $@.manifest

+EMBED_DLL_MANI	= if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2 && \

+		  if exist $@.manifest del $@.manifest

 

 ARCHDIR		= ..\lib\$(ARCHNAME)

 COREDIR		= ..\lib\CORE

@@ -496,7 +493,10 @@ LOCDEFS		= -DPERLDLL -DPERL_CORE
 SUBSYS		= console

 CXX_FLAG	= -xc++

 

-LIBC		= -lmsvcrt

+# Current releases of MinGW 5.1.4 (as of 11-Aug-2009) will fail to link

+# correctly if -lmsvcrt is specified explicitly.

+LIBC		=

+#LIBC		= -lmsvcrt

 

 # same libs as MSVC

 LIBFILES	= $(CRYPT_LIB) $(LIBC) \

@@ -758,7 +758,6 @@ UTILS		=			\
 		..\utils\cpan2dist	\

 		..\utils\shasum		\

 		..\utils\instmodsh	\

-		..\pod\checkpods	\

 		..\pod\pod2html		\

 		..\pod\pod2latex	\

 		..\pod\pod2man		\

@@ -925,7 +924,7 @@ CORE_NOCFG_H	=		\
 		.\include\sys\socket.h	\

 		.\win32.h

 

-CORE_H		= $(CORE_NOCFG_H) .\config.h

+CORE_H		= $(CORE_NOCFG_H) .\config.h ..\git_version.h

 

 UUDMAP_H	= ..\uudmap.h

 

@@ -1026,8 +1025,8 @@ ODBCCP32_DLL = $(windir)\system\odbccp32.dll
 # Top targets

 #

 

-all : CHECKDMAKE .\config.h $(GLOBEXE) $(MINIPERL) $(MK2)		\

-	$(RIGHTMAKE) $(MINIMOD) $(CONFIGPM) $(UNIDATAFILES) MakePPPort	\

+all : CHECKDMAKE .\config.h ..\git_version.h $(GLOBEXE) $(MINIPERL) $(MK2)	\

+	$(RIGHTMAKE) $(MINIMOD) $(CONFIGPM) $(UNIDATAFILES) MakePPPort		\

 	$(PERLEXE) $(X2P) Extensions $(PERLSTATIC)

 

 ..\regcharclass.h : ..\Porting\regcharclass.pl

@@ -1039,8 +1038,8 @@ regnodes : ..\regnodes.h
 

 ..\regexec$(o) : ..\regnodes.h ..\regcharclass.h

 

-reonly : regnodes .\config.h $(GLOBEXE) $(MINIPERL) $(MK2)		\

-	$(RIGHTMAKE) $(MINIMOD) $(CONFIGPM) $(UNIDATAFILES) $(PERLEXE)	\

+reonly : regnodes .\config.h ..\git_version.h $(GLOBEXE) $(MINIPERL) $(MK2)	\

+	$(RIGHTMAKE) $(MINIMOD) $(CONFIGPM) $(UNIDATAFILES) $(PERLEXE)		\

 	$(X2P) Extensions_reonly

 

 $(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c

@@ -1126,22 +1125,30 @@ config.w32 : $(CFGSH_TMPL)
 	-del /f config.h

 	copy $(CFGH_TMPL) config.h

 

+..\git_version.h : $(MINIPERL) ..\make_patchnum.pl

+	cd .. && miniperl -Ilib make_patchnum.pl

+

+# make sure that we recompile perl.c if the git version changes

+..\perl$(o) : ..\git_version.h

+

 ..\config.sh : config.w32 $(MINIPERL) config_sh.PL FindExt.pm

 	$(MINIPERL) -I..\lib config_sh.PL --cfgsh-option-file \

 	    $(mktmp $(CFG_VARS)) config.w32 > ..\config.sh

 

-# this target is for when changes to the main config.sh happen

-# edit config.{b,v,g}c and make this target once for each supported

-# compiler (e.g. `dmake CCTYPE=BORLAND regen_config_h`)

+# this target is for when changes to the main config.sh happen.

+# edit config.gc, then make perl using GCC in a minimal configuration (i.e.

+# with MULTI, ITHREADS, IMP_SYS, LARGE_FILES, PERLIO and CRYPT off), then make

+# this target to regenerate config_H.gc.

+# unfortunately, some further manual editing is also then required to restore all

+# the special _MSC_VER handling that is otherwise lost.

+# repeat for config.bc and config_H.bc (using BORLAND), except that there is no

+# _MSC_VER stuff in that case.

 regen_config_h:

-	perl config_sh.PL --cfgsh-option-file $(mktmp $(CFG_VARS)) \

+	$(MINIPERL) -I..\lib config_sh.PL --cfgsh-option-file $(mktmp $(CFG_VARS)) \

 	    $(CFGSH_TMPL) > ..\config.sh

-	-cd .. && del /f perl.exe

-	-cd .. && del /f perl*.dll

-	cd .. && perl configpm

+	cd .. && miniperl configpm

 	-del /f $(CFGH_TMPL)

-	-mkdir $(COREDIR)

-	-perl config_h.PL "INST_VER=$(INST_VER)"

+	-$(MINIPERL) -I..\lib config_h.PL "INST_VER=$(INST_VER)"

 	rename config.h $(CFGH_TMPL)

 

 $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl

@@ -1173,7 +1180,7 @@ $(MINIDIR) :
 	if not exist "$(MINIDIR)" mkdir "$(MINIDIR)"

 

 $(MINICORE_OBJ) : $(CORE_NOCFG_H)

-	$(CC) -c $(CFLAGS) -DPERL_EXTERNAL_GLOB $(OBJOUT_FLAG)$@ ..\$(*B).c

+	$(CC) -c $(CFLAGS) -DPERL_EXTERNAL_GLOB -DPERL_IS_MINIPERL $(OBJOUT_FLAG)$@ ..\$(*B).c

 

 $(MINIWIN32_OBJ) : $(CORE_NOCFG_H)

 	$(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*B).c

@@ -1192,6 +1199,7 @@ perllib$(o)	: perllib.c .\perlhost.h .\vdir.h .\vmem.h
 

 # 1. we don't want to rebuild miniperl.exe when config.h changes

 # 2. we don't want to rebuild miniperl.exe with non-default config.h

+# 3. we can't have miniperl.exe depend on git_version.h, as miniperl creates it

 $(MINI_OBJ)	: $(CORE_NOCFG_H)

 

 $(WIN32_OBJ)	: $(CORE_H)

@@ -1202,8 +1210,8 @@ $(DLL_OBJ)	: $(CORE_H)
 

 $(X2P_OBJ)	: $(CORE_H)

 

-perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym ..\pp.sym ..\makedef.pl

-	$(MINIPERL) -I..\lib buildext.pl --create-perllibst-h

+perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym ..\pp.sym ..\makedef.pl create_perllibst_h.pl

+	$(MINIPERL) -I..\lib create_perllibst_h.pl

 	$(MINIPERL) -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) \

 	$(BUILDOPT) CCTYPE=$(CCTYPE) > perldll.def

 

@@ -1379,29 +1387,24 @@ MakePPPort_clean:
 	-if exist $(MINIPERL) $(MINIPERL) -I..\lib ..\mkppport --clean

 

 #-------------------------------------------------------------------------------

-Extensions : buildext.pl $(PERLDEP) $(CONFIGPM)

+Extensions : ..\make_ext.pl $(PERLDEP) $(CONFIGPM)

 	$(XCOPY) ..\*.h $(COREDIR)\*.*

-	$(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --dynamic

-	-if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --dynamic

+	$(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(MAKE)" --dir=$(EXTDIR) --dynamic

 

-Extensions_reonly : buildext.pl $(PERLDEP) $(CONFIGPM)

+Extensions_reonly : ..\make_ext.pl $(PERLDEP) $(CONFIGPM)

 	$(XCOPY) ..\*.h $(COREDIR)\*.*

-	$(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --dynamic +re

-	-if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --dynamic +re

+	$(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(MAKE)" --dir=$(EXTDIR) --dynamic +re

 

-Extensions_static : buildext.pl $(PERLDEP) $(CONFIGPM)

+Extensions_static : ..\make_ext.pl list_static_libs.pl $(PERLDEP) $(CONFIGPM)

 	$(XCOPY) ..\*.h $(COREDIR)\*.*

-	$(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --static

-	-if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --static

-	$(MINIPERL) -I..\lib buildext.pl --list-static-libs > Extensions_static

+	$(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(MAKE)" --dir=$(EXTDIR) --static

+	$(MINIPERL) -I..\lib list_static_libs.pl > Extensions_static

 

 Extensions_clean :

-	-if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) clean

-	-if exist $(MINIPERL) if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext clean

+	-if exist $(MINIPERL) $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(MAKE)" --dir=$(EXTDIR) --all --target=clean

 

 Extensions_realclean :

-	-if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) realclean

-	-if exist $(MINIPERL) if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext realclean

+	-if exist $(MINIPERL) $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(MAKE)" --dir=$(EXTDIR) --all --target=realclean

 

 #-------------------------------------------------------------------------------

 

@@ -1415,7 +1418,6 @@ doc: $(PERLEXE)
 # so please check that script before making structural changes here

 utils: $(PERLEXE) $(X2P)

 	cd ..\utils && $(MAKE) PERL=$(MINIPERL)

-	copy ..\vms\perlvms.pod	..\pod\perlvms.pod

 	copy ..\README.aix      ..\pod\perlaix.pod

 	copy ..\README.amiga    ..\pod\perlamiga.pod

 	copy ..\README.apollo   ..\pod\perlapollo.pod

@@ -1428,6 +1430,7 @@ utils: $(PERLEXE) $(X2P)
 	copy ..\README.dos      ..\pod\perldos.pod

 	copy ..\README.epoc     ..\pod\perlepoc.pod

 	copy ..\README.freebsd  ..\pod\perlfreebsd.pod

+	copy ..\README.haiku    ..\pod\perlhaiku.pod

 	copy ..\README.hpux     ..\pod\perlhpux.pod

 	copy ..\README.hurd     ..\pod\perlhurd.pod

 	copy ..\README.irix     ..\pod\perlirix.pod

@@ -1453,13 +1456,15 @@ utils: $(PERLEXE) $(X2P)
 	copy ..\README.tw       ..\pod\perltw.pod

 	copy ..\README.uts      ..\pod\perluts.pod

 	copy ..\README.vmesa    ..\pod\perlvmesa.pod

-	copy ..\README.vms      ..\pod\perlvms.pod

 	copy ..\README.vos      ..\pod\perlvos.pod

 	copy ..\README.win32    ..\pod\perlwin32.pod

-	copy ..\pod\perl5100delta.pod ..\pod\perldelta.pod

+	copy ..\pod\perl5101delta.pod ..\pod\perldelta.pod

 	cd ..\pod && $(MAKE) -f ..\win32\pod.mak converters

 	cd ..\lib && $(PERLEXE) lib_pm.PL

 	$(PERLEXE) $(PL2BAT) $(UTILS)

+	$(PERLEXE) ..\autodoc.pl ..

+	$(PERLEXE) ..\pod\perlmodlib.pl -q

+	$(PERLEXE) ..\pod\buildtoc --build-toc -q

 

 # Note that the pod cleanup in this next section is parsed (and regenerated

 # by pod/buildtoc so please check that script before making changes here

@@ -1505,6 +1510,10 @@ distclean: realclean
 	-if exist $(LIBDIR)\Encode rmdir /s /q $(LIBDIR)\Encode

 	-if exist $(LIBDIR)\Filter\Util rmdir /s /q $(LIBDIR)\Filter\Util

 	-if exist $(LIBDIR)\Hash rmdir /s /q $(LIBDIR)\Hash

+	-if exist $(LIBDIR)\App rmdir /s /q $(LIBDIR)\App

+	-if exist $(LIBDIR)\Module\Pluggable rmdir /s /q $(LIBDIR)\Module\Pluggable

+	-if exist $(LIBDIR)\TAP rmdir /s /q $(LIBDIR)\TAP

+	-if exist $(LIBDIR)\mro rmdir /s /q $(LIBDIR)\mro

 	-if exist $(LIBDIR)\IO\Compress rmdir /s /q $(LIBDIR)\IO\Compress

 	-if exist $(LIBDIR)\IO\Socket rmdir /s /q $(LIBDIR)\IO\Socket

 	-if exist $(LIBDIR)\IO\Uncompress rmdir /s /q $(LIBDIR)\IO\Uncompress

@@ -1516,20 +1525,20 @@ distclean: realclean
 	-if exist $(LIBDIR)\threads rmdir /s /q $(LIBDIR)\threads

 	-if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS

 	-if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API

-	-cd $(PODDIR) && del /f *.html *.bat checkpods \

-	    perlaix.pod perlamiga.pod perlapollo.pod perlbeos.pod \

-	    perlbs2000.pod perlce.pod perlcn.pod perlcygwin.pod \

-	    perldelta.pod perldgux.pod perldos.pod perlepoc.pod \

-	    perlfreebsd.pod perlhpux.pod perlhurd.pod perlirix.pod \

-	    perljp.pod perlko.pod perllinux.pod perlmachten.pod \

-	    perlmacos.pod perlmacosx.pod perlmint.pod perlmpeix.pod \

-	    perlnetware.pod perlopenbsd.pod perlos2.pod perlos390.pod \

-	    perlos400.pod perlplan9.pod perlqnx.pod perlriscos.pod \

-	    perlsolaris.pod perlsymbian.pod perltru64.pod perltw.pod \

-	    perluts.pod perlvmesa.pod perlvms.pod perlvms.pod perlvos.pod \

-	    perlwin32.pod \

+	-cd $(PODDIR) && del /f *.html *.bat podchecker \

+	    perlaix.pod perlamiga.pod perlapi.pod perlapollo.pod \

+	    perlbeos.pod perlbs2000.pod perlce.pod perlcn.pod \

+	    perlcygwin.pod perldelta.pod perldgux.pod perldos.pod \

+	    perlepoc.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \

+	    perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \

+	    perllinux.pod perlmachten.pod perlmacos.pod perlmacosx.pod \

+	    perlmint.pod perlmodlib.pod perlmpeix.pod perlnetware.pod \

+	    perlopenbsd.pod perlos2.pod perlos390.pod perlos400.pod \

+	    perlplan9.pod perlqnx.pod perlriscos.pod perlsolaris.pod \

+	    perlsymbian.pod perltoc.pod perltru64.pod perltw.pod \

+	    perluts.pod perlvmesa.pod perlvos.pod perlwin32.pod \

 	    pod2html pod2latex pod2man pod2text pod2usage \

-	    podchecker podselect

+	    podselect

 	-cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \

 	    perldoc perlivp dprofpp libnetcfg enc2xs piconv cpan *.bat \

 	    xsubpp instmodsh prove ptar ptardiff cpanp-run-perl cpanp cpan2dist shasum corelist config_data

@@ -1537,6 +1546,7 @@ distclean: realclean
 	-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new \

 	    perlmainst.c

 	-del /f $(CONFIGPM)

+	-del /f ..\lib\Config_git.pl

 	-del /f bin\*.bat

 	-del /f perllibst.h

 	-del /f $(PERLEXE_ICO) perl.base

@@ -1547,6 +1557,7 @@ distclean: realclean
 	-if exist pod2htmd.tmp del pod2htmd.tmp

 	-if exist pod2htmi.tmp del pod2htmi.tmp

 	-if exist $(HTMLDIR) rmdir /s /q $(HTMLDIR)

+	-del /f ..\t\test_state

 

 install : all installbare installhtml

 

@@ -1635,6 +1646,7 @@ _clean :
 	-@erase perlmainst$(o)

 	-@erase config.w32

 	-@erase /f config.h

+	-@erase /f ..\git_version.h

 	-@erase $(GLOBEXE)

 	-@erase $(PERLEXE)

 	-@erase $(WPERLEXE)

diff --git a/gnu/usr.bin/perl/win32/perllib.c b/gnu/usr.bin/perl/win32/perllib.c
index da8e13d965f..ff212102f61 100644
--- a/gnu/usr.bin/perl/win32/perllib.c
+++ b/gnu/usr.bin/perl/win32/perllib.c
@@ -1,5 +1,9 @@
 /*
- * "The Road goes ever on and on, down from the door where it began."
+ *      The Road goes ever on and on
+ *          Down from the door where it began.
+ *
+ *     [Bilbo on p.35 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
+ *     [Frodo on p.73 of _The Lord of the Rings_, I/iii: "Three Is Company"]
  */
 #define PERLIO_NOT_STDIO 0
 #include "EXTERN.h"
diff --git a/gnu/usr.bin/perl/win32/pod.mak b/gnu/usr.bin/perl/win32/pod.mak
index e74cc0dab7e..3c94557fcb9 100644
--- a/gnu/usr.bin/perl/win32/pod.mak
+++ b/gnu/usr.bin/perl/win32/pod.mak
@@ -1,4 +1,4 @@
-CONVERTERS = pod2html pod2latex pod2man pod2text checkpods \
+CONVERTERS = pod2html pod2latex pod2man pod2text \
 		pod2usage podchecker podselect
 
 HTMLROOT = /	# Change this to fix cross-references in HTML
@@ -19,6 +19,7 @@ POD = \
 	perl5004delta.pod	\
 	perl5005delta.pod	\
 	perl5100delta.pod	\
+	perl5101delta.pod	\
 	perl561delta.pod	\
 	perl56delta.pod	\
 	perl570delta.pod	\
@@ -33,6 +34,7 @@ POD = \
 	perl586delta.pod	\
 	perl587delta.pod	\
 	perl588delta.pod	\
+	perl589delta.pod	\
 	perl58delta.pod	\
 	perl590delta.pod	\
 	perl591delta.pod	\
@@ -92,6 +94,7 @@ POD = \
 	perlmodinstall.pod	\
 	perlmodlib.pod	\
 	perlmodstyle.pod	\
+	perlmroapi.pod	\
 	perlnewmod.pod	\
 	perlnumber.pod	\
 	perlobj.pod	\
@@ -99,6 +102,7 @@ POD = \
 	perlopentut.pod	\
 	perlothrtut.pod	\
 	perlpacktut.pod	\
+	perlperf.pod	\
 	perlpod.pod	\
 	perlpodspec.pod	\
 	perlport.pod	\
@@ -110,6 +114,7 @@ POD = \
 	perlref.pod	\
 	perlreftut.pod	\
 	perlreguts.pod	\
+	perlrepository.pod	\
 	perlrequick.pod	\
 	perlreref.pod	\
 	perlretut.pod	\
@@ -131,6 +136,7 @@ POD = \
 	perlunitut.pod	\
 	perlutil.pod	\
 	perlvar.pod	\
+	perlvms.pod	\
 	perlxs.pod	\
 	perlxstut.pod	
 
@@ -139,6 +145,7 @@ MAN = \
 	perl5004delta.man	\
 	perl5005delta.man	\
 	perl5100delta.man	\
+	perl5101delta.man	\
 	perl561delta.man	\
 	perl56delta.man	\
 	perl570delta.man	\
@@ -153,6 +160,7 @@ MAN = \
 	perl586delta.man	\
 	perl587delta.man	\
 	perl588delta.man	\
+	perl589delta.man	\
 	perl58delta.man	\
 	perl590delta.man	\
 	perl591delta.man	\
@@ -212,6 +220,7 @@ MAN = \
 	perlmodinstall.man	\
 	perlmodlib.man	\
 	perlmodstyle.man	\
+	perlmroapi.man	\
 	perlnewmod.man	\
 	perlnumber.man	\
 	perlobj.man	\
@@ -219,6 +228,7 @@ MAN = \
 	perlopentut.man	\
 	perlothrtut.man	\
 	perlpacktut.man	\
+	perlperf.man	\
 	perlpod.man	\
 	perlpodspec.man	\
 	perlport.man	\
@@ -230,6 +240,7 @@ MAN = \
 	perlref.man	\
 	perlreftut.man	\
 	perlreguts.man	\
+	perlrepository.man	\
 	perlrequick.man	\
 	perlreref.man	\
 	perlretut.man	\
@@ -251,6 +262,7 @@ MAN = \
 	perlunitut.man	\
 	perlutil.man	\
 	perlvar.man	\
+	perlvms.man	\
 	perlxs.man	\
 	perlxstut.man	
 
@@ -259,6 +271,7 @@ HTML = \
 	perl5004delta.html	\
 	perl5005delta.html	\
 	perl5100delta.html	\
+	perl5101delta.html	\
 	perl561delta.html	\
 	perl56delta.html	\
 	perl570delta.html	\
@@ -273,6 +286,7 @@ HTML = \
 	perl586delta.html	\
 	perl587delta.html	\
 	perl588delta.html	\
+	perl589delta.html	\
 	perl58delta.html	\
 	perl590delta.html	\
 	perl591delta.html	\
@@ -332,6 +346,7 @@ HTML = \
 	perlmodinstall.html	\
 	perlmodlib.html	\
 	perlmodstyle.html	\
+	perlmroapi.html	\
 	perlnewmod.html	\
 	perlnumber.html	\
 	perlobj.html	\
@@ -339,6 +354,7 @@ HTML = \
 	perlopentut.html	\
 	perlothrtut.html	\
 	perlpacktut.html	\
+	perlperf.html	\
 	perlpod.html	\
 	perlpodspec.html	\
 	perlport.html	\
@@ -350,6 +366,7 @@ HTML = \
 	perlref.html	\
 	perlreftut.html	\
 	perlreguts.html	\
+	perlrepository.html	\
 	perlrequick.html	\
 	perlreref.html	\
 	perlretut.html	\
@@ -370,6 +387,7 @@ HTML = \
 	perlunitut.html	\
 	perlutil.html	\
 	perlvar.html	\
+	perlvms.html	\
 	perlxs.html	\
 	perlxstut.html	
 # not perltoc.html
@@ -379,6 +397,7 @@ TEX = \
 	perl5004delta.tex	\
 	perl5005delta.tex	\
 	perl5100delta.tex	\
+	perl5101delta.tex	\
 	perl561delta.tex	\
 	perl56delta.tex	\
 	perl570delta.tex	\
@@ -393,6 +412,7 @@ TEX = \
 	perl586delta.tex	\
 	perl587delta.tex	\
 	perl588delta.tex	\
+	perl589delta.tex	\
 	perl58delta.tex	\
 	perl590delta.tex	\
 	perl591delta.tex	\
@@ -452,6 +472,7 @@ TEX = \
 	perlmodinstall.tex	\
 	perlmodlib.tex	\
 	perlmodstyle.tex	\
+	perlmroapi.tex	\
 	perlnewmod.tex	\
 	perlnumber.tex	\
 	perlobj.tex	\
@@ -459,6 +480,7 @@ TEX = \
 	perlopentut.tex	\
 	perlothrtut.tex	\
 	perlpacktut.tex	\
+	perlperf.tex	\
 	perlpod.tex	\
 	perlpodspec.tex	\
 	perlport.tex	\
@@ -470,6 +492,7 @@ TEX = \
 	perlref.tex	\
 	perlreftut.tex	\
 	perlreguts.tex	\
+	perlrepository.tex	\
 	perlrequick.tex	\
 	perlreref.tex	\
 	perlretut.tex	\
@@ -491,6 +514,7 @@ TEX = \
 	perlunitut.tex	\
 	perlutil.tex	\
 	perlvar.tex	\
+	perlvms.tex	\
 	perlxs.tex	\
 	perlxstut.tex	
 
@@ -541,9 +565,9 @@ realclean:	clean
 
 distclean:	realclean
 
-check:	checkpods
+check:	podchecker
 	@echo "checking..."; \
-	$(PERL) -I../lib checkpods $(POD)
+	$(PERL) -I../lib podchecker $(POD)
 
 # Dependencies.
 pod2latex:	pod2latex.PL ../lib/Config.pm
@@ -558,9 +582,6 @@ pod2man:	pod2man.PL ../lib/Config.pm
 pod2text:	pod2text.PL ../lib/Config.pm
 	$(PERL) -I ../lib pod2text.PL
 
-checkpods:	checkpods.PL ../lib/Config.pm
-	$(PERL) -I ../lib checkpods.PL
-
 pod2usage:	pod2usage.PL ../lib/Config.pm
 	$(PERL) -I ../lib pod2usage.PL
 
diff --git a/gnu/usr.bin/perl/win32/win32.c b/gnu/usr.bin/perl/win32/win32.c
index 55ab70e6678..748e1132755 100644
--- a/gnu/usr.bin/perl/win32/win32.c
+++ b/gnu/usr.bin/perl/win32/win32.c
@@ -129,6 +129,8 @@ static long		find_pid(int pid);
 static char *		qualified_path(const char *cmd);
 static char *		win32_get_xlib(const char *pl, const char *xlib,
 				       const char *libname);
+static LRESULT  win32_process_message(HWND hwnd, UINT msg,
+                       WPARAM wParam, LPARAM lParam);
 
 #ifdef USE_ITHREADS
 static void		remove_dead_pseudo_process(long child);
@@ -223,12 +225,24 @@ set_w32_module_name(void)
         WCHAR fullname[MAX_PATH];
         char *ansi;
 
+        DWORD (__stdcall *pfnGetLongPathNameW)(LPCWSTR, LPWSTR, DWORD) =
+            (DWORD (__stdcall *)(LPCWSTR, LPWSTR, DWORD))
+            GetProcAddress(GetModuleHandle("kernel32.dll"), "GetLongPathNameW");
+
         GetModuleFileNameW(module, modulename, sizeof(modulename)/sizeof(WCHAR));
 
         /* Make sure we get an absolute pathname in case the module was loaded
          * explicitly by LoadLibrary() with a relative path. */
         GetFullPathNameW(modulename, sizeof(fullname)/sizeof(WCHAR), fullname, NULL);
 
+        /* Make sure we start with the long path name of the module because we
+         * later scan for pathname components to match "5.xx" to locate
+         * compatible sitelib directories, and the short pathname might mangle
+         * this path segment (e.g. by removing the dot on NTFS to something
+         * like "5xx~1.yy") */
+        if (pfnGetLongPathNameW)
+            pfnGetLongPathNameW(fullname, fullname, sizeof(fullname)/sizeof(WCHAR));
+
         /* remove \\?\ prefix */
         if (memcmp(fullname, L"\\\\?\\", 4*sizeof(WCHAR)) == 0)
             memmove(fullname, fullname+4, (wcslen(fullname+4)+1)*sizeof(WCHAR));
@@ -268,7 +282,7 @@ get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
     HKEY handle;
     DWORD type;
     const char *subkey = "Software\\Perl";
-    char *str = Nullch;
+    char *str = NULL;
     long retval;
 
     retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
@@ -366,7 +380,7 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
 	return SvPVX(*prev_pathp);
     }
 
-    return Nullch;
+    return NULL;
 }
 
 char *
@@ -375,7 +389,7 @@ win32_get_privlib(const char *pl)
     dTHX;
     char *stdlib = "lib";
     char buffer[MAX_PATH+1];
-    SV *sv = Nullsv;
+    SV *sv = NULL;
 
     /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || "";  */
     sprintf(buffer, "%s-%s", stdlib, pl);
@@ -383,7 +397,7 @@ win32_get_privlib(const char *pl)
 	(void)get_regstr(stdlib, &sv);
 
     /* $stdlib .= ";$EMD/../../lib" */
-    return get_emd_part(&sv, stdlib, ARCHNAME, "bin", Nullch);
+    return get_emd_part(&sv, stdlib, ARCHNAME, "bin", NULL);
 }
 
 static char *
@@ -392,8 +406,8 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname)
     dTHX;
     char regstr[40];
     char pathstr[MAX_PATH+1];
-    SV *sv1 = Nullsv;
-    SV *sv2 = Nullsv;
+    SV *sv1 = NULL;
+    SV *sv2 = NULL;
 
     /* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */
     sprintf(regstr, "%s-%s", xlib, pl);
@@ -402,7 +416,7 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname)
     /* $xlib .=
      * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib";  */
     sprintf(pathstr, "%s/%s/lib", libname, pl);
-    (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch);
+    (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, NULL);
 
     /* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
     (void)get_regstr(xlib, &sv2);
@@ -410,10 +424,10 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname)
     /* $xlib .=
      * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib";  */
     sprintf(pathstr, "%s/lib", libname);
-    (void)get_emd_part(&sv2, pathstr, ARCHNAME, "bin", pl, Nullch);
+    (void)get_emd_part(&sv2, pathstr, ARCHNAME, "bin", pl, NULL);
 
     if (!sv1 && !sv2)
-	return Nullch;
+	return NULL;
     if (!sv1)
 	return SvPVX(sv2);
     if (!sv2)
@@ -549,7 +563,7 @@ win32_getpid(void)
 static long
 tokenize(const char *str, char **dest, char ***destv)
 {
-    char *retstart = Nullch;
+    char *retstart = NULL;
     char **retvstart = 0;
     int items = -1;
     if (str) {
@@ -584,7 +598,7 @@ tokenize(const char *str, char **dest, char ***destv)
 		++items;
 	    ret++;
 	}
-	retvstart[items] = Nullch;
+	retvstart[items] = NULL;
 	*ret++ = '\0';
 	*ret = '\0';
     }
@@ -623,6 +637,8 @@ Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp)
     int flag = P_WAIT;
     int index = 0;
 
+    PERL_ARGS_ASSERT_DO_ASPAWN;
+
     if (sp <= mark)
 	return -1;
 
@@ -661,8 +677,7 @@ Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp)
     }
 
     if (flag == P_NOWAIT) {
-	if (IsWin95())
-	    PL_statusvalue = -1;	/* >16bits hint for pp_system() */
+	PL_statusvalue = -1;	/* >16bits hint for pp_system() */
     }
     else {
 	if (status < 0) {
@@ -728,7 +743,7 @@ do_spawn2(pTHX_ const char *cmd, int exectype)
 	    if (*s)
 		*s++ = '\0';
 	}
-	*a = Nullch;
+	*a = NULL;
 	if (argv[0]) {
 	    switch (exectype) {
 	    case EXECF_SPAWN:
@@ -757,7 +772,7 @@ do_spawn2(pTHX_ const char *cmd, int exectype)
 	while (++i < w32_perlshell_items)
 	    argv[i] = w32_perlshell_vec[i];
 	argv[i++] = (char *)cmd;
-	argv[i] = Nullch;
+	argv[i] = NULL;
 	switch (exectype) {
 	case EXECF_SPAWN:
 	    status = win32_spawnvp(P_WAIT, argv[0],
@@ -775,8 +790,7 @@ do_spawn2(pTHX_ const char *cmd, int exectype)
 	Safefree(argv);
     }
     if (exectype == EXECF_SPAWN_NOWAIT) {
-	if (IsWin95())
-	    PL_statusvalue = -1;	/* >16bits hint for pp_system() */
+	PL_statusvalue = -1;	/* >16bits hint for pp_system() */
     }
     else {
 	if (status < 0) {
@@ -796,18 +810,24 @@ do_spawn2(pTHX_ const char *cmd, int exectype)
 int
 Perl_do_spawn(pTHX_ char *cmd)
 {
+    PERL_ARGS_ASSERT_DO_SPAWN;
+
     return do_spawn2(aTHX_ cmd, EXECF_SPAWN);
 }
 
 int
 Perl_do_spawn_nowait(pTHX_ char *cmd)
 {
+    PERL_ARGS_ASSERT_DO_SPAWN_NOWAIT;
+
     return do_spawn2(aTHX_ cmd, EXECF_SPAWN_NOWAIT);
 }
 
 bool
 Perl_do_exec(pTHX_ const char *cmd)
 {
+    PERL_ARGS_ASSERT_DO_EXEC;
+
     do_spawn2(aTHX_ cmd, EXECF_EXEC);
     return FALSE;
 }
@@ -1500,9 +1520,22 @@ win32_stat(const char *path, Stat_t *sbuf)
             errno = ENOTDIR;
             return -1;
         }
+	if (S_ISDIR(sbuf->st_mode)) {
+	    /* Ensure the "write" bit is switched off in the mode for
+	     * directories with the read-only attribute set. Borland (at least)
+	     * switches it on for directories, which is technically correct
+	     * (directories are indeed always writable unless denied by DACLs),
+	     * but we want stat() and -w to reflect the state of the read-only
+	     * attribute for symmetry with chmod(). */
+	    DWORD r = GetFileAttributesA(path);
+	    if (r != 0xffffffff && (r & FILE_ATTRIBUTE_READONLY)) {
+		sbuf->st_mode &= ~S_IWRITE;
+	    }
+	}
 #ifdef __BORLANDC__
-	if (S_ISDIR(sbuf->st_mode))
-	    sbuf->st_mode |= S_IWRITE | S_IEXEC;
+	if (S_ISDIR(sbuf->st_mode)) {
+	    sbuf->st_mode |= S_IEXEC;
+	}
 	else if (S_ISREG(sbuf->st_mode)) {
 	    int perms;
 	    if (l >= 4 && path[l-4] == '.') {
@@ -1550,7 +1583,7 @@ win32_longpath(char *path)
     char *start = path;
     char sep;
     if (!path)
-	return Nullch;
+	return NULL;
 
     /* drive prefix */
     if (isALPHA(path[0]) && path[1] == ':') {
@@ -1614,14 +1647,14 @@ win32_longpath(char *path)
 	    else {
 		FindClose(fhand);
 		errno = ERANGE;
-		return Nullch;
+		return NULL;
 	    }
 	}
 	else {
 	    /* failed a step, just return without side effects */
 	    /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/
 	    errno = EINVAL;
-	    return Nullch;
+	    return NULL;
 	}
     }
     strcpy(path,tmpbuf);
@@ -1629,7 +1662,7 @@ win32_longpath(char *path)
 }
 
 static void
-out_of_memory()
+out_of_memory(void)
 {
     if (PL_curinterp) {
         dTHX;
@@ -1698,7 +1731,7 @@ win32_getenv(const char *name)
 {
     dTHX;
     DWORD needlen;
-    SV *curitem = Nullsv;
+    SV *curitem = NULL;
 
     needlen = GetEnvironmentVariableA(name,NULL,0);
     if (needlen != 0) {
@@ -1719,7 +1752,7 @@ win32_getenv(const char *name)
     if (curitem && SvCUR(curitem))
 	return SvPVX(curitem);
 
-    return Nullch;
+    return NULL;
 }
 
 DllExport int
@@ -1739,9 +1772,11 @@ win32_putenv(const char *name)
              * Has these advantages over putenv() & co.:
              *  * enables us to store a truly empty value in the
              *    environment (like in UNIX).
-             *  * we don't have to deal with RTL globals, bugs and leaks.
+             *  * we don't have to deal with RTL globals, bugs and leaks
+             *    (specifically, see http://support.microsoft.com/kb/235601).
              *  * Much faster.
-             * Why you may want to enable USE_WIN32_RTL_ENV:
+             * Why you may want to use the RTL environment handling
+             * (previously enabled by USE_WIN32_RTL_ENV):
              *  * environ[] and RTL functions will not reflect changes,
              *    which might be an issue if extensions want to access
              *    the env. via RTL.  This cuts both ways, since RTL will
@@ -2082,68 +2117,47 @@ win32_async_check(pTHX)
     MSG msg;
     HWND hwnd = w32_message_hwnd;
 
+    /* Reset w32_poll_count before doing anything else, incase we dispatch
+     * messages that end up calling back into perl */
     w32_poll_count = 0;
 
-    if (hwnd == INVALID_HANDLE_VALUE) {
-        /* Call PeekMessage() to mark all pending messages in the queue as "old".
-         * This is necessary when we are being called by win32_msgwait() to
-         * make sure MsgWaitForMultipleObjects() stops reporting the same waiting
-         * message over and over.  An example how this can happen is when
-         * Perl is calling win32_waitpid() inside a GUI application and the GUI
-         * is generating messages before the process terminated.
-         */
-        PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE|PM_NOYIELD);
-        if (PL_sig_pending)
-            despatch_signals();
-        return 1;
-    }
-
-    /* Passing PeekMessage -1 as HWND (2nd arg) only get PostThreadMessage() messages
-     * and ignores window messages - should co-exist better with windows apps e.g. Tk
-     */
-    if (hwnd == NULL)
-        hwnd = (HWND)-1;
-
-    while (PeekMessage(&msg, hwnd, WM_TIMER,    WM_TIMER,    PM_REMOVE|PM_NOYIELD) ||
-           PeekMessage(&msg, hwnd, WM_USER_MIN, WM_USER_MAX, PM_REMOVE|PM_NOYIELD))
-    {
-	switch (msg.message) {
-#ifdef USE_ITHREADS
-        case WM_USER_MESSAGE: {
-            int child = find_pseudo_pid(msg.wParam);
-            if (child >= 0)
-                w32_pseudo_child_message_hwnds[child] = (HWND)msg.lParam;
-            break;
-        }
-#endif
-
-	case WM_USER_KILL: {
-            /* We use WM_USER to fake kill() with other signals */
-	    int sig = msg.wParam;
-	    if (do_raise(aTHX_ sig))
-                sig_terminate(aTHX_ sig);
-	    break;
-	}
-
-	case WM_TIMER: {
-	    /* alarm() is a one-shot but SetTimer() repeats so kill it */
-	    if (w32_timerid && w32_timerid==msg.wParam) {
-	    	KillTimer(w32_message_hwnd, w32_timerid);
-	    	w32_timerid=0;
+    if (hwnd != INVALID_HANDLE_VALUE) {
+        /* Passing PeekMessage -1 as HWND (2nd arg) only gets PostThreadMessage() messages
+        * and ignores window messages - should co-exist better with windows apps e.g. Tk
+        */
+        if (hwnd == NULL)
+            hwnd = (HWND)-1;
+
+        while (PeekMessage(&msg, hwnd, WM_TIMER,    WM_TIMER,    PM_REMOVE|PM_NOYIELD) ||
+               PeekMessage(&msg, hwnd, WM_USER_MIN, WM_USER_MAX, PM_REMOVE|PM_NOYIELD))
+        {
+            /* re-post a WM_QUIT message (we'll mark it as read later) */
+            if(msg.message == WM_QUIT) {
+                PostQuitMessage((int)msg.wParam);
+                break;
+            }
 
-                /* Now fake a call to signal handler */
-                if (do_raise(aTHX_ 14))
-                    sig_terminate(aTHX_ 14);
+            if(!CallMsgFilter(&msg, MSGF_USER))
+            {
+                TranslateMessage(&msg);
+                DispatchMessage(&msg);
             }
-	    break;
-	}
-        } /* switch */
+        }
     }
 
+    /* Call PeekMessage() to mark all pending messages in the queue as "old".
+     * This is necessary when we are being called by win32_msgwait() to
+     * make sure MsgWaitForMultipleObjects() stops reporting the same waiting
+     * message over and over.  An example how this can happen is when
+     * Perl is calling win32_waitpid() inside a GUI application and the GUI
+     * is generating messages before the process terminated.
+     */
+    PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE|PM_NOYIELD);
+
     /* Above or other stuff may have set a signal flag */
-    if (PL_sig_pending) {
-	despatch_signals();
-    }
+    if (PL_sig_pending)
+        despatch_signals();
+    
     return 1;
 }
 
@@ -2159,7 +2173,7 @@ win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD result
 	timeout += ticks;
     }
     while (1) {
-	DWORD result = MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks, QS_POSTMESSAGE|QS_TIMER);
+	DWORD result = MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks, QS_POSTMESSAGE|QS_TIMER|QS_SENDMESSAGE);
 	if (resultp)
 	   *resultp = result;
 	if (result == WAIT_TIMEOUT) {
@@ -2390,7 +2404,7 @@ win32_crypt(const char *txt, const char *salt)
     return des_fcrypt(txt, salt, w32_crypt_buffer);
 #else
     Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia.");
-    return Nullch;
+    return NULL;
 #endif
 }
 
@@ -2563,7 +2577,7 @@ win32_stdin(void)
 }
 
 DllExport FILE *
-win32_stdout()
+win32_stdout(void)
 {
     return (stdout);
 }
@@ -2945,7 +2959,7 @@ win32_fstat(int fd, Stat_t *sbufptr)
 
     if (GetFileInformationByHandle((HANDLE)_get_osfhandle(fd), &bhfi)) {
 #if defined(WIN64) || defined(USE_LARGE_FILES)    
-        sbufptr->st_size = (bhfi.nFileSizeHigh << 32) + bhfi.nFileSizeLow ;
+        sbufptr->st_size = ((__int64)bhfi.nFileSizeHigh << 32) | bhfi.nFileSizeLow ;
 #endif
         sbufptr->st_mode &= 0xFE00;
         if (bhfi.dwFileAttributes & FILE_ATTRIBUTE_READONLY)
@@ -3269,7 +3283,7 @@ win32_rename(const char *oname, const char *newname)
 	int retval = 0;
 	char szTmpName[MAX_PATH+1];
 	char dname[MAX_PATH+1];
-	char *endname = Nullch;
+	char *endname = NULL;
 	STRLEN tmplen = 0;
 	DWORD from_attr, to_attr;
 
@@ -3328,7 +3342,7 @@ win32_rename(const char *oname, const char *newname)
 	retval = rename(szOldName, szNewName);
 
 	/* if we created a temporary file before ... */
-	if (endname != Nullch) {
+	if (endname != NULL) {
 	    /* ...and rename succeeded, delete temporary file/directory */
 	    if (retval == 0)
 		DeleteFile(szTmpName);
@@ -3910,7 +3924,7 @@ qualified_path(const char *cmd)
     int has_slash = 0;
 
     if (!cmd)
-	return Nullch;
+	return NULL;
     fullcmd = (char*)cmd;
     while (*fullcmd) {
 	if (*fullcmd == '/' || *fullcmd == '\\')
@@ -3984,7 +3998,7 @@ qualified_path(const char *cmd)
     }
 
     Safefree(fullcmd);
-    return Nullch;
+    return NULL;
 }
 
 /* The following are just place holders.
@@ -4071,7 +4085,7 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
     PROCESS_INFORMATION ProcessInformation;
     DWORD create = 0;
     char *cmd;
-    char *fullcmd = Nullch;
+    char *fullcmd = NULL;
     char *cname = (char *)cmdname;
     STRLEN clen = 0;
 
@@ -4846,9 +4860,132 @@ win32_signal(int sig, Sighandler_t subcode)
     }
 }
 
+/* The PerlMessageWindowClass's WindowProc */
+LRESULT CALLBACK
+win32_message_window_proc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
+{
+    return win32_process_message(hwnd, msg, wParam, lParam) ?
+        0 : DefWindowProc(hwnd, msg, wParam, lParam);
+}
+
+/* we use a message filter hook to process thread messages, passing any
+ * messages that we don't process on to the rest of the hook chain
+ * Anyone else writing a message loop that wants to play nicely with perl
+ * should do
+ *   CallMsgFilter(&msg, MSGF_***);
+ * between their GetMessage and DispatchMessage calls.  */
+LRESULT CALLBACK
+win32_message_filter_proc(int code, WPARAM wParam, LPARAM lParam) {
+    LPMSG pmsg = (LPMSG)lParam;
+
+    /* we'll process it if code says we're allowed, and it's a thread message */
+    if (code >= 0 && pmsg->hwnd == NULL
+            && win32_process_message(pmsg->hwnd, pmsg->message,
+                                     pmsg->wParam, pmsg->lParam))
+    {
+            return TRUE;
+    }
+
+    /* XXX: MSDN says that hhk is ignored, but we should really use the
+     * return value from SetWindowsHookEx() in win32_create_message_window().  */
+    return CallNextHookEx(NULL, code, wParam, lParam);
+}
+
+/* The real message handler. Can be called with
+ * hwnd == NULL to process our thread messages. Returns TRUE for any messages
+ * that it processes */
+static LRESULT
+win32_process_message(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
+{
+    /* BEWARE. The context retrieved using dTHX; is the context of the
+     * 'parent' thread during the CreateWindow() phase - i.e. for all messages
+     * up to and including WM_CREATE.  If it ever happens that you need the
+     * 'child' context before this, then it needs to be passed into
+     * win32_create_message_window(), and passed to the WM_NCCREATE handler
+     * from the lparam of CreateWindow().  It could then be stored/retrieved
+     * using [GS]etWindowLongPtr(... GWLP_USERDATA ...), possibly eliminating
+     * the dTHX calls here. */
+    /* XXX For now it is assumed that the overhead of the dTHX; for what
+     * are relativley infrequent code-paths, is better than the added
+     * complexity of getting the correct context passed into
+     * win32_create_message_window() */
+
+    switch(msg) {
+
+#ifdef USE_ITHREADS
+        case WM_USER_MESSAGE: {
+            long child = find_pseudo_pid((int)wParam);
+            if (child >= 0) {
+                dTHX;
+                w32_pseudo_child_message_hwnds[child] = (HWND)lParam;
+                return 1;
+            }
+            break;
+        }
+#endif
+
+        case WM_USER_KILL: {
+            dTHX;
+            /* We use WM_USER_KILL to fake kill() with other signals */
+            int sig = (int)wParam;
+            if (do_raise(aTHX_ sig))
+                sig_terminate(aTHX_ sig);
+
+            return 1;
+        }
+
+        case WM_TIMER: {
+            dTHX;
+            /* alarm() is a one-shot but SetTimer() repeats so kill it */
+            if (w32_timerid && w32_timerid==(UINT)wParam) {
+                KillTimer(w32_message_hwnd, w32_timerid);
+                w32_timerid=0;
+
+                /* Now fake a call to signal handler */
+                if (do_raise(aTHX_ 14))
+                    sig_terminate(aTHX_ 14);
+
+                return 1;
+            }
+            break;
+        }
+
+        default:
+            break;
+
+    } /* switch */
+
+    /* Above or other stuff may have set a signal flag, and we may not have
+     * been called from win32_async_check() (e.g. some other GUI's message
+     * loop.  BUT DON'T dispatch signals here: If someone has set a SIGALRM
+     * handler that die's, and the message loop that calls here is wrapped
+     * in an eval, then you may well end up with orphaned windows - signals
+     * are dispatched by win32_async_check() */
+
+    return 0;
+}
+
+void
+win32_create_message_window_class(void)
+{
+    /* create the window class for "message only" windows */
+    WNDCLASS wc;
+
+    Zero(&wc, 1, wc);
+    wc.lpfnWndProc = win32_message_window_proc;
+    wc.hInstance = (HINSTANCE)GetModuleHandle(NULL);
+    wc.lpszClassName = "PerlMessageWindowClass";
+
+    /* second and subsequent calls will fail, but class
+     * will already be registered */
+    RegisterClass(&wc);
+}
+
 HWND
-win32_create_message_window()
+win32_create_message_window(void)
 {
+    HWND hwnd = NULL;
+
     /* "message-only" windows have been implemented in Windows 2000 and later.
      * On earlier versions we'll continue to post messages to a specific
      * thread and use hwnd==NULL.  This is brittle when either an embedding
@@ -4857,10 +4994,30 @@ win32_create_message_window()
      * "right" place with DispatchMessage() anymore, as there is no WindowProc
      * if there is no window handle.
      */
-    if (!IsWin2000())
-        return NULL;
+    /* Using HWND_MESSAGE appears to work under Win98, despite MSDN
+     * documentation to the contrary, however, there is some evidence that
+     * there may be problems with the implementation on Win98. As it is not
+     * officially supported we take the cautious route and stick with thread
+     * messages (hwnd == NULL) on platforms prior to Win2k.
+     */
+    if (IsWin2000()) {
+        win32_create_message_window_class();
+
+        hwnd = CreateWindow("PerlMessageWindowClass", "PerlMessageWindow",
+                0, 0, 0, 0, 0, HWND_MESSAGE, NULL, NULL, NULL);
+    }
 
-    return CreateWindow("Static", "", 0, 0, 0, 0, 0, HWND_MESSAGE, 0, 0, NULL);
+    /* If we din't create a window for any reason, then we'll use thread
+     * messages for our signalling, so we install a hook which
+     * is called by CallMsgFilter in win32_async_check(), or any other
+     * modal loop (e.g. Win32::MsgBox or any other GUI extention, or anything
+     * that use OLE, etc. */
+    if(!hwnd) {
+        SetWindowsHookEx(WH_MSGFILTER, win32_message_filter_proc,
+                NULL, GetCurrentThreadId());
+    }
+  
+    return hwnd;
 }
 
 #ifdef HAVE_INTERP_INTERN
@@ -4886,7 +5043,7 @@ Perl_sys_intern_init(pTHX)
 {
     int i;
 
-    w32_perlshell_tokens	= Nullch;
+    w32_perlshell_tokens	= NULL;
     w32_perlshell_vec		= (char**)NULL;
     w32_perlshell_items		= 0;
     w32_fdpid			= newAV();
@@ -4956,7 +5113,9 @@ Perl_sys_intern_clear(pTHX)
 void
 Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
 {
-    dst->perlshell_tokens	= Nullch;
+    PERL_ARGS_ASSERT_SYS_INTERN_DUP;
+
+    dst->perlshell_tokens	= NULL;
     dst->perlshell_vec		= (char**)NULL;
     dst->perlshell_items	= 0;
     dst->fdpid			= newAV();
diff --git a/gnu/usr.bin/perl/win32/win32io.c b/gnu/usr.bin/perl/win32/win32io.c
index 5ba46a71d37..a3981c000a8 100644
--- a/gnu/usr.bin/perl/win32/win32io.c
+++ b/gnu/usr.bin/perl/win32/win32io.c
@@ -256,7 +256,11 @@ PerlIOWin32_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
  static const DWORD where[3] = { FILE_BEGIN, FILE_CURRENT, FILE_END };
  PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
- DWORD high = (sizeof(offset) > sizeof(DWORD)) ? (DWORD)(offset >> 32) : 0;
+#if Off_t_size >= 8
+ DWORD high = (DWORD)(offset >> 32);
+#else
+ DWORD high = 0;
+#endif
  DWORD low  = (DWORD) offset;
  DWORD res  = SetFilePointer(s->h,(LONG)low,(LONG *)&high,where[whence]);
  if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR)
@@ -277,7 +281,11 @@ PerlIOWin32_tell(pTHX_ PerlIO *f)
  DWORD res  = SetFilePointer(s->h,0,(LONG *)&high,FILE_CURRENT);
  if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR)
   {
+#if Off_t_size >= 8
    return ((Off_t) high << 32) | res;
+#else
+   return res;
+#endif
   }
  return (Off_t) -1;
 }
diff --git a/gnu/usr.bin/perl/win32/win32sck.c b/gnu/usr.bin/perl/win32/win32sck.c
index 26bef5ed24a..77981689070 100644
--- a/gnu/usr.bin/perl/win32/win32sck.c
+++ b/gnu/usr.bin/perl/win32/win32sck.c
@@ -259,9 +259,8 @@ win32_select(int nfds, Perl_fd_set* rd, Perl_fd_set* wr, Perl_fd_set* ex, const
 {
     int r;
 #ifdef USE_SOCKETS_AS_HANDLES
-    Perl_fd_set dummy;
     int i, fd, save_errno = errno;
-    FD_SET nrd, nwr, nex, *prd, *pwr, *pex;
+    FD_SET nrd, nwr, nex;
 
     /* winsock seems incapable of dealing with all three null fd_sets,
      * so do the (millisecond) sleep as a special case
@@ -275,45 +274,45 @@ win32_select(int nfds, Perl_fd_set* rd, Perl_fd_set* wr, Perl_fd_set* ex, const
 	return 0;
     }
     StartSockets();
-    PERL_FD_ZERO(&dummy);
-    if (!rd)
-	rd = &dummy, prd = NULL;
-    else
-	prd = &nrd;
-    if (!wr)
-	wr = &dummy, pwr = NULL;
-    else
-	pwr = &nwr;
-    if (!ex)
-	ex = &dummy, pex = NULL;
-    else
-	pex = &nex;
 
     FD_ZERO(&nrd);
     FD_ZERO(&nwr);
     FD_ZERO(&nex);
     for (i = 0; i < nfds; i++) {
-	fd = TO_SOCKET(i);
-	if (PERL_FD_ISSET(i,rd))
+	if (rd && PERL_FD_ISSET(i,rd)) {
+	    fd = TO_SOCKET(i);
 	    FD_SET((unsigned)fd, &nrd);
-	if (PERL_FD_ISSET(i,wr))
+	}
+	if (wr && PERL_FD_ISSET(i,wr)) {
+	    fd = TO_SOCKET(i);
 	    FD_SET((unsigned)fd, &nwr);
-	if (PERL_FD_ISSET(i,ex))
+	}
+	if (ex && PERL_FD_ISSET(i,ex)) {
+	    fd = TO_SOCKET(i);
 	    FD_SET((unsigned)fd, &nex);
+	}
     }
 
     errno = save_errno;
-    SOCKET_TEST_ERROR(r = select(nfds, prd, pwr, pex, timeout));
+    SOCKET_TEST_ERROR(r = select(nfds, &nrd, &nwr, &nex, timeout));
     save_errno = errno;
 
     for (i = 0; i < nfds; i++) {
-	fd = TO_SOCKET(i);
-	if (PERL_FD_ISSET(i,rd) && !FD_ISSET(fd, &nrd))
-	    PERL_FD_CLR(i,rd);
-	if (PERL_FD_ISSET(i,wr) && !FD_ISSET(fd, &nwr))
-	    PERL_FD_CLR(i,wr);
-	if (PERL_FD_ISSET(i,ex) && !FD_ISSET(fd, &nex))
-	    PERL_FD_CLR(i,ex);
+	if (rd && PERL_FD_ISSET(i,rd)) {
+	    fd = TO_SOCKET(i);
+	    if (!FD_ISSET(fd, &nrd))
+		PERL_FD_CLR(i,rd);
+	}
+	if (wr && PERL_FD_ISSET(i,wr)) {
+	    fd = TO_SOCKET(i);
+	    if (!FD_ISSET(fd, &nwr))
+		PERL_FD_CLR(i,wr);
+	}
+	if (ex && PERL_FD_ISSET(i,ex)) {
+	    fd = TO_SOCKET(i);
+	    if (!FD_ISSET(fd, &nex))
+		PERL_FD_CLR(i,ex);
+	}
     }
     errno = save_errno;
 #else
diff --git a/gnu/usr.bin/perl/x2p/Makefile.SH b/gnu/usr.bin/perl/x2p/Makefile.SH
index b4c305894c3..ba56c49e7ba 100644
--- a/gnu/usr.bin/perl/x2p/Makefile.SH
+++ b/gnu/usr.bin/perl/x2p/Makefile.SH
@@ -124,6 +124,9 @@ run_byacc:	FORCE
 	    -e 's/^yynewerror://' \
 	    -e 's/^    goto yynewerror;//' \
 	    -e 's|^static char yysccsid\(.*\)|/* static char yysccsid\1 */|' \
+	    -e 's/^\(char \*yyname\[\]\)/const \1/' \
+	    -e 's/^\(char \*yyrule\[\]\)/const \1/' \
+	    -e 's/^\(    register\) \(char \*yys;\)/\1 const \2/' \
 	    < y.tab.c > a2p.c
 
 FORCE:
diff --git a/gnu/usr.bin/perl/x2p/a2p.c b/gnu/usr.bin/perl/x2p/a2p.c
index 20e322765d4..4186cdf19bb 100644
--- a/gnu/usr.bin/perl/x2p/a2p.c
+++ b/gnu/usr.bin/perl/x2p/a2p.c
@@ -1984,7 +1984,7 @@ short yycheck[] = {                                      41,
 #endif
 #define YYMAXTOKEN 306
 #if YYDEBUG
-char *yyname[] = {
+const char *yyname[] = {
 "end-of-file",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,"'%'",0,0,"'('","')'","'*'","'+'","','","'-'",0,"'/'",0,0,0,0,0,0,0,0,0,0,
 "':'","';'","'<'",0,"'>'","'?'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
@@ -1999,7 +1999,7 @@ char *yyname[] = {
 "DELETE","ASGNOP","OROR","ANDAND","NUMBER","VAR","SUBSTR","INDEX","MATCHOP",
 "RELOP","OR","STRING","UMINUS","NOT","INCR","DECR","FIELD","VFIELD","SVFIELD",
 };
-char *yyrule[] = {
+const char *yyrule[] = {
 "$accept : program",
 "program : junk hunks",
 "begin : BEGIN '{' maybe states '}' junk",
@@ -2193,7 +2193,7 @@ yyparse(void)
 {
     register int yym, yyn, yystate;
 #if YYDEBUG
-    register char *yys;
+    register const char *yys;
 
     if ((yys = getenv("YYDEBUG")))
     {
diff --git a/gnu/usr.bin/perl/x2p/a2p.h b/gnu/usr.bin/perl/x2p/a2p.h
index db09edddfac..6b6004c2da5 100644
--- a/gnu/usr.bin/perl/x2p/a2p.h
+++ b/gnu/usr.bin/perl/x2p/a2p.h
@@ -151,15 +151,18 @@ char *strcpy(), *strcat();
 #endif
 #endif /* ! STANDARD_C */
 
+#ifdef __cplusplus
+#  define PERL_EXPORT_C extern "C"
+#else
+#  define PERL_EXPORT_C extern
+#endif
+
 #ifdef VMS
 #  include "handy.h"
 #else 
 #  include "../handy.h"
 #endif
 
-#undef Nullfp
-#define Nullfp Null(FILE*)
-
 #define Nullop 0
 
 #define OPROG		1
@@ -252,7 +255,7 @@ char *strcpy(), *strcat();
 #define OSTAR		88
 
 #ifdef DOINIT
-char *opname[] = {
+const char *opname[] = {
     "0",
     "PROG",
     "JUNK",
@@ -345,7 +348,7 @@ char *opname[] = {
     "89"
 };
 #else
-extern char *opname[];
+extern const char *opname[];
 #endif
 
 EXT int mop INIT(1);
@@ -370,8 +373,8 @@ typedef struct htbl HASH;
 
 /* A string is TRUE if not "" or "0". */
 #define True(val) (tmps = (val), (*tmps && !(*tmps == '0' && !tmps[1])))
-EXT char *Yes INIT("1");
-EXT char *No INIT("");
+EXT const char *Yes INIT("1");
+EXT const char *No INIT("");
 
 #define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
 EXT STR *Str;
@@ -397,8 +400,8 @@ void putone ( void );
 int rememberargs ( int arg );
 char * scannum ( char *s );
 char * scanpat ( char *s );
-int string ( char *ptr, int len );
-void yyerror ( char *s );
+int string ( const char *ptr, int len );
+void yyerror ( const char *s );
 int yylex ( void );
 
 EXT int line INIT(0);
@@ -407,7 +410,7 @@ EXT FILE *rsfp;
 EXT char buf[2048];
 EXT char *bufptr INIT(buf);
 
-EXT STR *linestr INIT(Nullstr);
+EXT STR *linestr INIT(NULL);
 
 EXT char tokenbuf[2048];
 EXT int expectterm INIT(TRUE);
@@ -423,7 +426,7 @@ extern int yydebug;
 # endif
 #endif
 
-EXT STR *freestrroot INIT(Nullstr);
+EXT STR *freestrroot INIT(NULL);
 
 EXT STR str_no;
 EXT STR str_yes;
@@ -447,7 +450,7 @@ EXT bool saw_altinput INIT(FALSE);
 EXT bool nomemok INIT(FALSE);
 
 EXT char const_FS INIT(0);
-EXT char *namelist INIT(Nullch);
+EXT char *namelist INIT(NULL);
 EXT char fswitch INIT(0);
 EXT bool old_awk INIT(0);
 
diff --git a/gnu/usr.bin/perl/x2p/a2py.c b/gnu/usr.bin/perl/x2p/a2py.c
index df0a55cb214..84fdc487370 100644
--- a/gnu/usr.bin/perl/x2p/a2py.c
+++ b/gnu/usr.bin/perl/x2p/a2py.c
@@ -18,8 +18,8 @@
 #endif
 #include "util.h"
 
-char *filename;
-char *myname;
+const char *filename;
+const char *myname;
 
 int checkers = 0;
 
@@ -59,7 +59,7 @@ usage()
 #endif
 
 int
-main(register int argc, register char **argv, register char **env)
+main(register int argc, register const char **argv, register const char **env)
 {
     register STR *str;
     int i;
@@ -117,7 +117,7 @@ main(register int argc, register char **argv, register char **env)
 
     /* open script */
 
-    if (argv[0] == Nullch) {
+    if (argv[0] == NULL) {
 #if defined(OS2) || defined(WIN32) || defined(NETWARE)
 	if ( isatty(fileno(stdin)) )
 	    usage();
@@ -126,14 +126,13 @@ main(register int argc, register char **argv, register char **env)
     }
     filename = savestr(argv[0]);
 
-    filename = savestr(argv[0]);
     if (strEQ(filename,"-"))
 	argv[0] = "";
     if (!*argv[0])
 	rsfp = stdin;
     else
 	rsfp = fopen(argv[0],"r");
-    if (rsfp == Nullfp)
+    if (rsfp == NULL)
 	fatal("Awk script \"%s\" doesn't seem to exist.\n",filename);
 
     /* init tokener */
@@ -254,10 +253,10 @@ yylex(void)
 	if (!rsfp)
 	    RETURN(0);
 	line++;
-	if ((s = str_gets(linestr, rsfp)) == Nullch) {
+	if ((s = str_gets(linestr, rsfp)) == NULL) {
 	    if (rsfp != stdin)
 		fclose(rsfp);
-	    rsfp = Nullfp;
+	    rsfp = NULL;
 	    s = str_get(linestr);
 	    RETURN(0);
 	}
@@ -562,7 +561,7 @@ yylex(void)
 	else if (strEQ(d,"function"))
 	    XTERM(FUNCTION);
 	if (strEQ(d,"FILENAME"))
-	    d = "ARGV";
+	    ID("ARGV");
 	if (strEQ(d,"foreach"))
 	    *d = toUPPER(*d);
 	else if (strEQ(d,"format"))
@@ -666,14 +665,14 @@ yylex(void)
 	SNARFWORD;
 	if (strEQ(d,"ORS")) {
 	    saw_ORS = TRUE;
-	    d = "\\";
+	    ID("\\");
 	}
 	if (strEQ(d,"OFS")) {
 	    saw_OFS = TRUE;
-	    d = ",";
+	    ID(",");
 	}
 	if (strEQ(d,"OFMT")) {
-	    d = "#";
+	    ID("#");
 	}
 	if (strEQ(d,"open"))
 	    *d = toUPPER(*d);
@@ -701,8 +700,8 @@ yylex(void)
     case 'r': case 'R':
 	SNARFWORD;
 	if (strEQ(d,"RS")) {
-	    d = "/";
 	    saw_RS = TRUE;
+	    ID("/");
 	}
 	if (strEQ(d,"rand")) {
 	    yylval = ORAND;
@@ -743,7 +742,7 @@ yylex(void)
 	    XTERM(FUN1);
 	}
 	if (strEQ(d,"SUBSEP")) {
-	    d = ";";
+	    ID(";");
 	}
 	if (strEQ(d,"sin")) {
 	    yylval = OSIN;
@@ -878,7 +877,7 @@ scanpat(register char *s)
 }
 
 void
-yyerror(char *s)
+yyerror(const char *s)
 {
     fprintf(stderr,"%s in file %s at line %d\n",
       s,filename,line);
@@ -921,7 +920,7 @@ scannum(register char *s)
 }
 
 int
-string(char *ptr, int len)
+string(const char *ptr, int len)
 {
     int retval = mop;
 
diff --git a/gnu/usr.bin/perl/x2p/find2perl.PL b/gnu/usr.bin/perl/x2p/find2perl.PL
index 5add931397a..e9275d0c5c5 100644
--- a/gnu/usr.bin/perl/x2p/find2perl.PL
+++ b/gnu/usr.bin/perl/x2p/find2perl.PL
@@ -42,20 +42,6 @@ use vars qw/$statdone/;
 use File::Spec::Functions 'curdir';
 my $startperl = "#! $perlpath -w";
 
-#
-# Modified September 26, 1993 to provide proper handling of years after 1999
-#   Tom Link <tml+@pitt.edu>
-#   University of Pittsburgh
-#
-# Modified April 7, 1998 with nasty hacks to implement the troublesome -follow
-#  Billy Constantine <wdconsta@cs.adelaide.edu.au> <billy@smug.adelaide.edu.au>
-#  University of Adelaide, Adelaide, South Australia
-#
-# Modified 1999-06-10, 1999-07-07 to migrate to cleaner perl5 usage
-#   Ken Pizzini <ken@halcyon.com>
-#
-# Modified 2000-01-28 to use the 'follow' option of File::Find
-
 sub tab ();
 sub n ($$);
 sub fileglob_to_re ($);
@@ -921,7 +907,7 @@ Predicates which take a numeric argument N can come in three forms:
 
 =head1 SEE ALSO
 
-find
+find, File::Find.
 
 =cut
 !NO!SUBS!
diff --git a/gnu/usr.bin/perl/x2p/hash.c b/gnu/usr.bin/perl/x2p/hash.c
index 8c218b69e5f..9cc50f8dba1 100644
--- a/gnu/usr.bin/perl/x2p/hash.c
+++ b/gnu/usr.bin/perl/x2p/hash.c
@@ -25,7 +25,7 @@ hfetch(register HASH *tb, char *key)
     register HENT *entry;
 
     if (!tb)
-	return Nullstr;
+	return NULL;
     for (s=key,		i=0,	hash = 0;
       /* while */ *s;
 	 s++,		i++,	hash *= 5) {
@@ -39,7 +39,7 @@ hfetch(register HASH *tb, char *key)
 	    continue;
 	return entry->hent_val;
     }
-    return Nullstr;
+    return NULL;
 }
 
 bool
@@ -144,6 +144,6 @@ int
 hiterinit(register HASH *tb)
 {
     tb->tbl_riter = -1;
-    tb->tbl_eiter = Null(HENT*);
+    tb->tbl_eiter = (HENT*)NULL;
     return tb->tbl_fill;
 }
diff --git a/gnu/usr.bin/perl/x2p/str.c b/gnu/usr.bin/perl/x2p/str.c
index 0b1c9401677..58798c011fc 100644
--- a/gnu/usr.bin/perl/x2p/str.c
+++ b/gnu/usr.bin/perl/x2p/str.c
@@ -25,7 +25,7 @@ str_2ptr(register STR *str)
     register char *s;
 
     if (!str)
-	return "";
+	return (char *)"";	/* probably safe - won't be written to */
     GROWSTR(&(str->str_ptr), &(str->str_len), 24);
     s = str->str_ptr;
     if (str->str_nok) {
@@ -56,7 +56,7 @@ str_sset(STR *dstr, register STR *sstr)
 }
 
 void
-str_nset(register STR *str, register char *ptr, register int len)
+str_nset(register STR *str, register const char *ptr, register int len)
 {
     GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
     memcpy(str->str_ptr,ptr,len);
@@ -67,7 +67,7 @@ str_nset(register STR *str, register char *ptr, register int len)
 }
 
 void
-str_set(register STR *str, register char *ptr)
+str_set(register STR *str, register const char *ptr)
 {
     register int len;
 
@@ -82,7 +82,7 @@ str_set(register STR *str, register char *ptr)
 }
 
 void
-str_ncat(register STR *str, register char *ptr, register int len)
+str_ncat(register STR *str, register const char *ptr, register int len)
 {
     if (!(str->str_pok))
 	str_2ptr(str);
@@ -104,7 +104,7 @@ str_scat(STR *dstr, register STR *sstr)
 }
 
 void
-str_cat(register STR *str, register char *ptr)
+str_cat(register STR *str, register const char *ptr)
 {
     register int len;
 
@@ -185,7 +185,7 @@ str_gets(register STR *str, register FILE *fp)
      * buffer, so we getc() it back out and stuff it in the buffer.
      */
     i = getc(fp);
-    if (i == EOF) return Nullch;
+    if (i == EOF) return NULL;
     *(--((*fp)->_ptr)) = (unsigned char) i;
     (*fp)->_cnt++;
 #endif
@@ -239,18 +239,18 @@ thats_all_folks:
 
     static char buf[4192];
 
-    if (fgets(buf, sizeof buf, fp) != Nullch)
+    if (fgets(buf, sizeof buf, fp) != NULL)
 	str_set(str, buf);
     else
 	str_set(str, No);
 
 #endif /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */
 
-    return str->str_cur ? str->str_ptr : Nullch;
+    return str->str_cur ? str->str_ptr : NULL;
 }
 
 STR *
-str_make(char *s)
+str_make(const char *s)
 {
     register STR *str = str_new(0);
 
diff --git a/gnu/usr.bin/perl/x2p/str.h b/gnu/usr.bin/perl/x2p/str.h
index f5b590b9e91..7fc8e1e3b44 100644
--- a/gnu/usr.bin/perl/x2p/str.h
+++ b/gnu/usr.bin/perl/x2p/str.h
@@ -19,8 +19,6 @@ struct string {
     char	str_nok;	/* state of str_nval */
 };
 
-#define Nullstr Null(STR*)
-
 /* the following macro updates any magic values this str is associated with */
 
 #define STABSET(x) (x->str_link.str_magic && stabset(x->str_link.str_magic,x))
@@ -29,15 +27,15 @@ EXT STR **tmps_list;
 EXT long tmps_max INIT(-1);
 
 char * str_2ptr ( STR *str );
-void str_cat ( STR *str, char *ptr );
+void str_cat ( STR *str, const char *ptr );
 void str_free ( STR *str );
 char * str_gets ( STR *str, FILE *fp );
 int str_len ( STR *str );
-STR * str_make ( char *s );
-void str_ncat ( STR *str, char *ptr, int len );
+STR * str_make ( const char *s );
+void str_ncat ( STR *str, const char *ptr, int len );
 STR * str_new ( int len );
-void str_nset ( STR *str, char *ptr, int len );
+void str_nset ( STR *str, const char *ptr, int len );
 void str_numset ( STR *str, double num );
 void str_scat ( STR *dstr, STR *sstr );
-void str_set ( STR *str, char *ptr );
+void str_set ( STR *str, const char *ptr );
 void str_sset ( STR *dstr, STR *sstr );
diff --git a/gnu/usr.bin/perl/x2p/util.c b/gnu/usr.bin/perl/x2p/util.c
index 6994e873f75..464dd8f5e96 100644
--- a/gnu/usr.bin/perl/x2p/util.c
+++ b/gnu/usr.bin/perl/x2p/util.c
@@ -32,7 +32,7 @@ safemalloc(MEM_SIZE size)
 	fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",(unsigned long)ptr,
     	    	an++,(long)size);
 #endif
-    if (ptr != Nullch)
+    if (ptr != NULL)
 	return ptr;
     else {
 	fputs(nomem,stdout) FLUSH;
@@ -57,7 +57,7 @@ saferealloc(Malloc_t where, MEM_SIZE size)
 	fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",(unsigned long)ptr,an++,(long)size);
     }
 #endif
-    if (ptr != Nullch)
+    if (ptr != NULL)
 	return ptr;
     else {
 	fputs(nomem,stdout) FLUSH;
@@ -119,27 +119,28 @@ cpy2(register char *to, register char *from, register int delim)
 /* return ptr to little string in big string, NULL if not found */
 
 char *
-instr(char *big, char *little)
+instr(char *big, const char *little)
 {
-    register char *t, *s, *x;
+    register char *t, *x;
+    register const char *s;
 
     for (t = big; *t; t++) {
 	for (x=t,s=little; *s; x++,s++) {
 	    if (!*x)
-		return Nullch;
+		return NULL;
 	    if (*s != *x)
 		break;
 	}
 	if (!*s)
 	    return t;
     }
-    return Nullch;
+    return NULL;
 }
 
 /* copy a string to a safe spot */
 
 char *
-savestr(char *str)
+savestr(const char *str)
 {
     register char * const newaddr = (char *) safemalloc((MEM_SIZE)(strlen(str)+1));
 
diff --git a/gnu/usr.bin/perl/x2p/util.h b/gnu/usr.bin/perl/x2p/util.h
index 74341c2959d..3330a60957e 100644
--- a/gnu/usr.bin/perl/x2p/util.h
+++ b/gnu/usr.bin/perl/x2p/util.h
@@ -21,8 +21,8 @@
 char * cpy2 ( char *to, char *from, int delim );
 char * cpytill ( char *to, char *from, int delim );
 void growstr ( char **strptr, int *curlen, int newlen );
-char * instr ( char *big, char *little );
-char * savestr ( char *str );
+char * instr ( char *big, const char *little );
+char * savestr ( const char *str );
 void fatal ( const char *pat, ... );
 void warn  ( const char *pat, ... );
 int prewalk ( int numit, int level, int node, int *numericptr );
diff --git a/gnu/usr.bin/perl/x2p/walk.c b/gnu/usr.bin/perl/x2p/walk.c
index de1263fc16b..ef754c59dfd 100644
--- a/gnu/usr.bin/perl/x2p/walk.c
+++ b/gnu/usr.bin/perl/x2p/walk.c
@@ -19,11 +19,11 @@ bool saw_FNR = FALSE;
 bool saw_argv0 = FALSE;
 bool saw_fh = FALSE;
 int maxtmp = 0;
-char *lparen;
-char *rparen;
-char *limit;
+const char *lparen;
+const char *rparen;
+const char *limit;
 STR *subs;
-STR *curargs = Nullstr;
+STR *curargs = NULL;
 
 static void addsemi ( STR *str );
 static void emit_split ( STR *str, int level );
@@ -36,7 +36,7 @@ STR * walk ( int useval, int level, int node, int *numericptr, int minprec );
 #ifdef NETWARE
 char *savestr(char *str);
 char *cpytill(register char *to, register char *from, register int delim);
-char *instr(char *big, char *little);
+char *instr(char *big, const char *little);
 #endif
 
 STR *
@@ -741,10 +741,10 @@ sub Pick {\n\
 	str_cat(curargs,",");
 	tmp2str=walk(1,level,ops[node+5].ival,&numarg,P_MIN);
 	str_free(curargs);
-	curargs = Nullstr;
+	curargs = NULL;
 	level--;
 	subretnum |= numarg;
-	s = Nullch;
+	s = NULL;
 	t = tmp2str->str_ptr;
 	while ((t = instr(t,"return ")))
 	    s = t++;
@@ -838,7 +838,9 @@ sub Pick {\n\
 	len = type >> 8;
 	type &= 255;
 	tmp3str = str_new(0);
-	if (type == OSTR) {
+	{
+	  const char *s;
+	  if (type == OSTR) {
 	    tmp2str=walk(1,level,ops[ops[node+2].ival+1].ival,&numarg,P_MIN);
 	    for (t = tmp2str->str_ptr, d=tokenbuf; *t; d++,t++) {
 		if (*t == '&')
@@ -849,18 +851,19 @@ sub Pick {\n\
 	    }
 	    *d = '\0';
 	    str_set(tmp2str,tokenbuf);
-	    s = (char *) (gsub ? "/g" : "/");
-	}
-	else {
+	    s = (gsub ? "/g" : "/");
+	  }
+	  else {
 	    tmp2str=walk(1,level,ops[node+2].ival,&numarg,P_MIN);
 	    str_set(tmp3str,"($s_ = '\"'.(");
 	    str_scat(tmp3str,tmp2str);
 	    str_cat(tmp3str,").'\"') =~ s/&/\\$&/g, ");
 	    str_set(tmp2str,"eval $s_");
-	    s = (char *) (gsub ? "/ge" : "/e");
+	    s = (gsub ? "/ge" : "/e");
 	    i++;
+	  }
+	  str_cat(tmp2str,s);
 	}
-	str_cat(tmp2str,s);
 	type = ops[ops[node+1].ival].ival;
 	len = type >> 8;
 	type &= 255;
@@ -909,8 +912,9 @@ sub Pick {\n\
 	break;
     case OSTR:
 	tmpstr = walk(1,level,ops[node+1].ival,&numarg,P_MIN);
-	s = "'";
-	for (t = tmpstr->str_ptr, d=tokenbuf; *t; d++,t++) {
+	{
+	  const char *s = "'";
+	  for (t = tmpstr->str_ptr, d=tokenbuf; *t; d++,t++) {
 	    if (*t == '\'')
 		s = "\"";
 	    else if (*t == '\\') {
@@ -924,13 +928,14 @@ sub Pick {\n\
 		}
 	    }
 	    *d = *t + 128;
+	  }
+	  *d = '\0';
+	  str = str_new(0);
+	  str_set(str,s);
+	  str_cat(str,tokenbuf);
+	  str_free(tmpstr);
+	  str_cat(str,s);
 	}
-	*d = '\0';
-	str = str_new(0);
-	str_set(str,s);
-	str_cat(str,tokenbuf);
-	str_free(tmpstr);
-	str_cat(str,s);
 	break;
     case ODEFINED:
 	prec = P_UNI;
@@ -1208,7 +1213,7 @@ sub Pick {\n\
 	}
 	tmpstr = walk(1+(type==OPRINT),level,ops[node+1].ival,&numarg,P_MIN);
 	if (!*tmpstr->str_ptr && lval_field) {
-	    t = (char*)(saw_OFS ? "$," : "' '");
+	    const char *t = (saw_OFS ? "$," : "' '");
 	    if (split_to_array) {
 		sprintf(tokenbuf,"join(%s,@Fld)",t);
 		str_cat(tmpstr,tokenbuf);
@@ -1284,7 +1289,7 @@ sub Pick {\n\
 	    tmpstr = str_new(0);
 	if (!tmpstr->str_ptr || !*tmpstr->str_ptr) {
 	    if (lval_field) {
-		t = (char*)(saw_OFS ? "$," : "' '");
+		const char *t = (saw_OFS ? "$," : "' '");
 		if (split_to_array) {
 		    sprintf(tokenbuf,"join(%s,@Fld)",t);
 		    str_cat(tmpstr,tokenbuf);
@@ -1511,7 +1516,7 @@ sub Pick {\n\
 	    }
 	}
 	else {
-	    str = Nullstr;
+	    str = NULL;
 	}
 	break;
     }