perl5.005_03

20 files changed, 2049 insertions, 0 deletions

diff --git a/gnu/usr.bin/perl/t/lib/cgi-form.t b/gnu/usr.bin/perl/t/lib/cgi-form.t
new file mode 100644
index 00000000000..86df161b02e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/cgi-form.t
@@ -0,0 +1,81 @@
+#!./perl
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+BEGIN {$| = 1; print "1..17\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use CGI (':standard','-no_debug');
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# Set up a CGI environment
+$ENV{REQUEST_METHOD}='GET';
+$ENV{QUERY_STRING}  ='game=chess&game=checkers&weather=dull';
+$ENV{PATH_INFO}     ='/somewhere/else';
+$ENV{PATH_TRANSLATED} ='/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME}   ='/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT} = 8080;
+$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
+
+test(2,start_form(-action=>'foobar',-method=>GET) eq 
+     qq(<FORM METHOD="GET" ACTION="foobar" ENCTYPE="application/x-www-form-urlencoded">\n),
+     "start_form()");
+
+test(3,submit() eq qq(<INPUT TYPE="submit" NAME=".submit">),"submit()");
+test(4,submit(-name=>'foo',-value=>'bar') eq qq(<INPUT TYPE="submit" NAME="foo" VALUE="bar">),"submit(-name,-value)");
+test(5,submit({-name=>'foo',-value=>'bar'}) eq qq(<INPUT TYPE="submit" NAME="foo" VALUE="bar">),"submit({-name,-value})");
+test(6,textfield(-name=>'weather') eq qq(<INPUT TYPE="text" NAME="weather" VALUE="dull">),"textfield({-name})");
+test(7,textfield(-name=>'weather',-value=>'nice') eq qq(<INPUT TYPE="text" NAME="weather" VALUE="dull">),"textfield({-name,-value})");
+test(8,textfield(-name=>'weather',-value=>'nice',-override=>1) eq qq(<INPUT TYPE="text" NAME="weather" VALUE="nice">),
+     "textfield({-name,-value,-override})");
+test(9,checkbox(-name=>'weather',-value=>'nice') eq qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="nice">weather\n),
+     "checkbox()");
+test(10,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast') eq 
+     qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="nice">forecast\n),
+     "checkbox()");
+test(11,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast',-checked=>1,-override=>1) eq 
+     qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="nice" CHECKED>forecast\n),
+     "checkbox()");
+test(12,checkbox(-name=>'weather',-value=>'dull',-label=>'forecast') eq 
+     qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="dull" CHECKED>forecast\n),
+     "checkbox()");
+
+test(13,radio_group(-name=>'game') eq 
+     qq(<INPUT TYPE="radio" NAME="game" VALUE="chess" CHECKED>chess <INPUT TYPE="radio" NAME="game" VALUE="checkers">checkers),
+     'radio_group()');
+test(14,radio_group(-name=>'game',-labels=>{'chess'=>'ping pong'}) eq 
+     qq(<INPUT TYPE="radio" NAME="game" VALUE="chess" CHECKED>ping pong <INPUT TYPE="radio" NAME="game" VALUE="checkers">checkers),
+     'radio_group()');
+
+test(15, checkbox_group(-name=>'game',-Values=>[qw/checkers chess cribbage/]) eq 
+     qq(<INPUT TYPE="checkbox" NAME="game" VALUE="checkers" CHECKED>checkers <INPUT TYPE="checkbox" NAME="game" VALUE="chess" CHECKED>chess <INPUT TYPE="checkbox" NAME="game" VALUE="cribbage">cribbage),
+     'checkbox_group()');
+
+test(16, checkbox_group(-name=>'game',-Values=>[qw/checkers chess cribbage/],-Defaults=>['cribbage'],-override=>1) eq 
+     qq(<INPUT TYPE="checkbox" NAME="game" VALUE="checkers">checkers <INPUT TYPE="checkbox" NAME="game" VALUE="chess">chess <INPUT TYPE="checkbox" NAME="game" VALUE="cribbage" CHECKED>cribbage),
+     'checkbox_group()');
+
+test(17, popup_menu(-name=>'game',-Values=>[qw/checkers chess cribbage/],-Default=>'cribbage',-override=>1) eq <<END,'checkbox_group()');
+<SELECT NAME="game">
+<OPTION  VALUE="checkers">checkers
+<OPTION  VALUE="chess">chess
+<OPTION SELECTED VALUE="cribbage">cribbage
+</SELECT>
+END
+
diff --git a/gnu/usr.bin/perl/t/lib/cgi-function.t b/gnu/usr.bin/perl/t/lib/cgi-function.t
new file mode 100644
index 00000000000..ad8b968161d
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/cgi-function.t
@@ -0,0 +1,85 @@
+#!./perl
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+BEGIN {$| = 1; print "1..24\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Config;
+use CGI (':standard','keywords');
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# Set up a CGI environment
+$ENV{REQUEST_METHOD}='GET';
+$ENV{QUERY_STRING}  ='game=chess&game=checkers&weather=dull';
+$ENV{PATH_INFO}     ='/somewhere/else';
+$ENV{PATH_TRANSLATED} ='/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME}   ='/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT} = 8080;
+$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
+$ENV{HTTP_LOVE} = 'true';
+
+test(2,request_method() eq 'GET',"CGI::request_method()");
+test(3,query_string() eq 'game=chess&game=checkers&weather=dull',"CGI::query_string()");
+test(4,param() == 2,"CGI::param()");
+test(5,join(' ',sort {$a cmp $b} param()) eq 'game weather',"CGI::param()");
+test(6,param('game') eq 'chess',"CGI::param()");
+test(7,param('weather') eq 'dull',"CGI::param()");
+test(8,join(' ',param('game')) eq 'chess checkers',"CGI::param()");
+test(9,param(-name=>'foo',-value=>'bar'),'CGI::param() put');
+test(10,param(-name=>'foo') eq 'bar','CGI::param() get');
+test(11,query_string() eq 'game=chess&game=checkers&weather=dull&foo=bar',"CGI::query_string() redux");
+test(12,http('love') eq 'true',"CGI::http()");
+test(13,script_name() eq '/cgi-bin/foo.cgi',"CGI::script_name()");
+test(14,url() eq 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()");
+test(15,self_url() eq 
+     'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess&game=checkers&weather=dull&foo=bar',
+     "CGI::url()");
+test(16,url(-absolute=>1) eq '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)');
+test(17,url(-relative=>1) eq 'foo.cgi','CGI::url(-relative=>1)');
+test(18,url(-relative=>1,-path=>1) eq 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)');
+test(19,url(-relative=>1,-path=>1,-query=>1) eq 
+     'foo.cgi/somewhere/else?game=chess&game=checkers&weather=dull&foo=bar',
+     'CGI::url(-relative=>1,-path=>1,-query=>1)');
+Delete('foo');
+test(20,!param('foo'),'CGI::delete()');
+
+CGI::_reset_globals();
+$ENV{QUERY_STRING}='mary+had+a+little+lamb';
+test(21,join(' ',keywords()) eq 'mary had a little lamb','CGI::keywords');
+test(22,join(' ',param('keywords')) eq 'mary had a little lamb','CGI::keywords');
+
+if (!$Config{d_fork} or $^O eq 'MSWin32' or $^O eq 'VMS') {
+    for (23,24) { print "ok $_ # Skipped: fork n/a\n" }
+}
+else {
+    CGI::_reset_globals;
+    $test_string = 'game=soccer&game=baseball&weather=nice';
+    $ENV{REQUEST_METHOD}='POST';
+    $ENV{CONTENT_LENGTH}=length($test_string);
+    $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
+    if (open(CHILD,"|-")) {  # cparent
+	print CHILD $test_string;
+	close CHILD;
+	exit 0;
+    }
+    # at this point, we're in a new (child) process
+    test(23,param('weather') eq 'nice',"CGI::param() from POST");
+    test(24,url_param('big_balls') eq 'basketball',"CGI::url_param()");
+}
diff --git a/gnu/usr.bin/perl/t/lib/cgi-html.t b/gnu/usr.bin/perl/t/lib/cgi-html.t
new file mode 100644
index 00000000000..6a7ff1ecf5c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/cgi-html.t
@@ -0,0 +1,69 @@
+#!./perl
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+BEGIN {$| = 1; print "1..20\n"; }
+BEGIN {$eol = $^O eq 'VMS' ? "\n" : "\cM\cJ";
+       $eol = "\r\n" if $^O eq 'os390'; }
+END {print "not ok 1\n" unless $loaded;}
+use CGI (':standard','-no_debug','*h3','start_table');
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# all the automatic tags
+test(2,h1() eq '<H1>',"single tag");
+test(3,h1('fred') eq '<H1>fred</H1>',"open/close tag");
+test(4,h1('fred','agnes','maura') eq '<H1>fred agnes maura</H1>',"open/close tag multiple");
+test(5,h1({-align=>'CENTER'},'fred') eq '<H1 ALIGN="CENTER">fred</H1>',"open/close tag with attribute");
+test(6,h1({-align=>undef},'fred') eq '<H1 ALIGN>fred</H1>',"open/close tag with orphan attribute");
+test(7,h1({-align=>'CENTER'},['fred','agnes']) eq 
+     '<H1 ALIGN="CENTER">fred</H1> <H1 ALIGN="CENTER">agnes</H1>',
+     "distributive tag with attribute");
+{
+    local($") = '-'; 
+    test(8,h1('fred','agnes','maura') eq '<H1>fred-agnes-maura</H1>',"open/close tag \$\" interpolation");
+}
+test(9,header() eq "Content-Type: text/html${eol}${eol}","header()");
+test(10,header(-type=>'image/gif') eq "Content-Type: image/gif${eol}${eol}","header()");
+test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks${eol}Content-Type: image/gif${eol}${eol}","header()");
+test(12,header(-nph=>1) eq "HTTP/1.0 200 OK${eol}Content-Type: text/html${eol}${eol}","header()");
+test(13,start_html() ."\n" eq <<END,"start_html()");
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<HTML><HEAD><TITLE>Untitled Document</TITLE>
+</HEAD><BODY>
+END
+    ;
+test(14,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR") ."\n" eq <<END,"start_html()");
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 3.2//FR">
+<HTML><HEAD><TITLE>Untitled Document</TITLE>
+</HEAD><BODY>
+END
+    ;
+test(15,start_html(-Title=>'The world of foo') ."\n" eq <<END,"start_html()");
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<HTML><HEAD><TITLE>The world of foo</TITLE>
+</HEAD><BODY>
+END
+    ;
+test(16,($cookie=cookie(-name=>'fred',-value=>['chocolate','chip'],-path=>'/')) eq 
+     'fred=chocolate&chip; path=/',"cookie()");
+test(17,header(-Cookie=>$cookie) =~ m!^Set-Cookie: fred=chocolate&chip\; path=/${eol}Date:.*${eol}Content-Type: text/html${eol}${eol}!s,
+     "header(-cookie)");
+test(18,start_h3 eq '<H3>');
+test(19,end_h3 eq '</H3>');
+test(20,start_table({-border=>undef}) eq '<TABLE BORDER>');
diff --git a/gnu/usr.bin/perl/t/lib/cgi-request.t b/gnu/usr.bin/perl/t/lib/cgi-request.t
new file mode 100644
index 00000000000..8c70c40350b
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/cgi-request.t
@@ -0,0 +1,93 @@
+#!./perl
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+BEGIN {$| = 1; print "1..31\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Config;
+use CGI ();
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# Set up a CGI environment
+$ENV{REQUEST_METHOD}='GET';
+$ENV{QUERY_STRING}  ='game=chess&game=checkers&weather=dull';
+$ENV{PATH_INFO}     ='/somewhere/else';
+$ENV{PATH_TRANSLATED} ='/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME}   ='/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT} = 8080;
+$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
+$ENV{HTTP_LOVE} = 'true';
+
+$q = new CGI;
+test(2,$q,"CGI::new()");
+test(3,$q->request_method eq 'GET',"CGI::request_method()");
+test(4,$q->query_string eq 'game=chess&game=checkers&weather=dull',"CGI::query_string()");
+test(5,$q->param() == 2,"CGI::param()");
+test(6,join(' ',sort $q->param()) eq 'game weather',"CGI::param()");
+test(7,$q->param('game') eq 'chess',"CGI::param()");
+test(8,$q->param('weather') eq 'dull',"CGI::param()");
+test(9,join(' ',$q->param('game')) eq 'chess checkers',"CGI::param()");
+test(10,$q->param(-name=>'foo',-value=>'bar'),'CGI::param() put');
+test(11,$q->param(-name=>'foo') eq 'bar','CGI::param() get');
+test(12,$q->query_string eq 'game=chess&game=checkers&weather=dull&foo=bar',"CGI::query_string() redux");
+test(13,$q->http('love') eq 'true',"CGI::http()");
+test(14,$q->script_name eq '/cgi-bin/foo.cgi',"CGI::script_name()");
+test(15,$q->url eq 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()");
+test(16,$q->self_url eq 
+     'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess&game=checkers&weather=dull&foo=bar',
+     "CGI::url()");
+test(17,$q->url(-absolute=>1) eq '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)');
+test(18,$q->url(-relative=>1) eq 'foo.cgi','CGI::url(-relative=>1)');
+test(19,$q->url(-relative=>1,-path=>1) eq 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)');
+test(20,$q->url(-relative=>1,-path=>1,-query=>1) eq 
+     'foo.cgi/somewhere/else?game=chess&game=checkers&weather=dull&foo=bar',
+     'CGI::url(-relative=>1,-path=>1,-query=>1)');
+$q->delete('foo');
+test(21,!$q->param('foo'),'CGI::delete()');
+
+$q->_reset_globals;
+$ENV{QUERY_STRING}='mary+had+a+little+lamb';
+test(22,$q=new CGI,"CGI::new() redux");
+test(23,join(' ',$q->keywords) eq 'mary had a little lamb','CGI::keywords');
+test(24,join(' ',$q->param('keywords')) eq 'mary had a little lamb','CGI::keywords');
+test(25,$q=new CGI('foo=bar&foo=baz'),"CGI::new() redux");
+test(26,$q->param('foo') eq 'bar','CGI::param() redux');
+test(27,$q=new CGI({'foo'=>'bar','bar'=>'froz'}),"CGI::new() redux 2");
+test(28,$q->param('bar') eq 'froz',"CGI::param() redux 2");
+
+if (!$Config{d_fork} or $^O eq 'MSWin32' or $^O eq 'VMS') {
+    for (29..31) { print "ok $_ # Skipped: fork n/a\n" }
+}
+else {
+    $q->_reset_globals;
+    $test_string = 'game=soccer&game=baseball&weather=nice';
+    $ENV{REQUEST_METHOD}='POST';
+    $ENV{CONTENT_LENGTH}=length($test_string);
+    $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
+    if (open(CHILD,"|-")) {  # cparent
+	print CHILD $test_string;
+	close CHILD;
+	exit 0;
+    }
+    # at this point, we're in a new (child) process
+    test(29,$q=new CGI,"CGI::new() from POST");
+    test(30,$q->param('weather') eq 'nice',"CGI::param() from POST");
+    test(31,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
+}
diff --git a/gnu/usr.bin/perl/t/lib/dumper-ovl.t b/gnu/usr.bin/perl/t/lib/dumper-ovl.t
new file mode 100644
index 00000000000..db4a5d9e752
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dumper-ovl.t
@@ -0,0 +1,30 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+use Data::Dumper;
+
+print "1..1\n";
+
+package Foo;
+use overload '""' => 'as_string';
+
+sub new { bless { foo => "bar" }, shift }
+sub as_string { "%%%%" }
+
+package main;
+
+my $f = Foo->new;
+
+print "#\$f=$f\n";
+
+$_ = Dumper($f);
+s/^/#/mg;
+print $_;
+
+print "not " unless /bar/ && /Foo/;
+print "ok 1\n";
+
diff --git a/gnu/usr.bin/perl/t/lib/dumper.t b/gnu/usr.bin/perl/t/lib/dumper.t
new file mode 100644
index 00000000000..8c8dc4023cc
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dumper.t
@@ -0,0 +1,780 @@
+#!./perl -w
+#
+# testsuite for Data::Dumper
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+use Data::Dumper;
+use Config;
+my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define';
+
+$Data::Dumper::Pad = "#";
+my $TMAX;
+my $XS;
+my $TNUM = 0;
+my $WANT = '';
+
+sub TEST {
+  my $string = shift;
+  my $t = eval $string;
+  ++$TNUM;
+  print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
+	: "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
+
+  ++$TNUM;
+  eval "$t";
+  print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n";
+
+  $t = eval $string;
+  ++$TNUM;
+  print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
+	: "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
+}
+
+if (defined &Data::Dumper::Dumpxs) {
+  print "### XS extension loaded, will run XS tests\n";
+  $TMAX = 162; $XS = 1;
+}
+else {
+  print "### XS extensions not loaded, will NOT run XS tests\n";
+  $TMAX = 81; $XS = 0;
+}
+
+print "1..$TMAX\n";
+
+#############
+#############
+
+@c = ('c');
+$c = \@c;
+$b = {};
+$a = [1, $b, $c];
+$b->{a} = $a;
+$b->{b} = $a->[1];
+$b->{c} = $a->[2];
+
+############# 1
+##
+$WANT = <<'EOT';
+#$a = [
+#       1,
+#       {
+#         'a' => $a,
+#         'b' => $a->[1],
+#         'c' => [
+#                  'c'
+#                ]
+#       },
+#       $a->[1]{'c'}
+#     ];
+#$b = $a->[1];
+#$c = $a->[1]{'c'};
+EOT
+
+TEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]));
+TEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b c)])) if $XS;
+
+
+############# 7
+##
+$WANT = <<'EOT';
+#@a = (
+#       1,
+#       {
+#         'a' => [],
+#         'b' => {},
+#         'c' => [
+#                  'c'
+#                ]
+#       },
+#       []
+#     );
+#$a[1]{'a'} = \@a;
+#$a[1]{'b'} = $a[1];
+#$a[2] = $a[1]{'c'};
+#$b = $a[1];
+EOT
+
+$Data::Dumper::Purity = 1;         # fill in the holes for eval
+TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a
+TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
+
+############# 13
+##
+$WANT = <<'EOT';
+#%b = (
+#       'a' => [
+#                1,
+#                {},
+#                [
+#                  'c'
+#                ]
+#              ],
+#       'b' => {},
+#       'c' => []
+#     );
+#$b{'a'}[1] = \%b;
+#$b{'b'} = \%b;
+#$b{'c'} = $b{'a'}[2];
+#$a = $b{'a'};
+EOT
+
+TEST q(Data::Dumper->Dump([$b, $a], [qw(*b a)])); # print as %b
+TEST q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])) if $XS;
+
+############# 19
+##
+$WANT = <<'EOT';
+#$a = [
+#  1,
+#  {
+#    'a' => [],
+#    'b' => {},
+#    'c' => []
+#  },
+#  []
+#];
+#$a->[1]{'a'} = $a;
+#$a->[1]{'b'} = $a->[1];
+#$a->[1]{'c'} = \@c;
+#$a->[2] = \@c;
+#$b = $a->[1];
+EOT
+
+$Data::Dumper::Indent = 1;
+TEST q(
+       $d = Data::Dumper->new([$a,$b], [qw(a b)]);
+       $d->Seen({'*c' => $c});
+       $d->Dump;
+      );
+if ($XS) {
+  TEST q(
+	 $d = Data::Dumper->new([$a,$b], [qw(a b)]);
+	 $d->Seen({'*c' => $c});
+	 $d->Dumpxs;
+	);
+}
+
+
+############# 25
+##
+$WANT = <<'EOT';
+#$a = [
+#       #0
+#       1,
+#       #1
+#       {
+#         a => $a,
+#         b => $a->[1],
+#         c => [
+#                #0
+#                'c'
+#              ]
+#       },
+#       #2
+#       $a->[1]{c}
+#     ];
+#$b = $a->[1];
+EOT
+
+$d->Indent(3);
+$d->Purity(0)->Quotekeys(0);
+TEST q( $d->Reset; $d->Dump );
+
+TEST q( $d->Reset; $d->Dumpxs ) if $XS;
+
+############# 31
+##
+$WANT = <<'EOT';
+#$VAR1 = [
+#  1,
+#  {
+#    'a' => [],
+#    'b' => {},
+#    'c' => [
+#      'c'
+#    ]
+#  },
+#  []
+#];
+#$VAR1->[1]{'a'} = $VAR1;
+#$VAR1->[1]{'b'} = $VAR1->[1];
+#$VAR1->[2] = $VAR1->[1]{'c'};
+EOT
+
+TEST q(Dumper($a));
+TEST q(Data::Dumper::DumperX($a)) if $XS;
+
+############# 37
+##
+$WANT = <<'EOT';
+#[
+#  1,
+#  {
+#    a => $VAR1,
+#    b => $VAR1->[1],
+#    c => [
+#      'c'
+#    ]
+#  },
+#  $VAR1->[1]{c}
+#]
+EOT
+
+{
+  local $Data::Dumper::Purity = 0;
+  local $Data::Dumper::Quotekeys = 0;
+  local $Data::Dumper::Terse = 1;
+  TEST q(Dumper($a));
+  TEST q(Data::Dumper::DumperX($a)) if $XS;
+}
+
+
+############# 43
+##
+if (!$Is_ebcdic) {
+$WANT = <<'EOT';
+#$VAR1 = {
+#  "abc\0'\efg" => "mno\0"
+#};
+EOT
+}
+else {
+$WANT = <<'EOT';
+#$VAR1 = {
+#  "\201\202\203\340\360'\340\205\206\207" => "\224\225\226\340\360"
+#};
+EOT
+}
+
+$foo = { "abc\000\'\efg" => "mno\000" };
+{
+  local $Data::Dumper::Useqq = 1;
+  TEST q(Dumper($foo));
+}
+
+  $WANT = <<"EOT";
+#\$VAR1 = {
+#  'abc\0\\'\efg' => 'mno\0'
+#};
+EOT
+
+  {
+    local $Data::Dumper::Useqq = 1;
+    TEST q(Data::Dumper::DumperX($foo)) if $XS;   # cheat
+  }
+
+
+
+#############
+#############
+
+{
+  package main;
+  use Data::Dumper;
+  $foo = 5;
+  @foo = (10,\*foo);
+  %foo = (a=>1,b=>\$foo,c=>\@foo);
+  $foo{d} = \%foo;
+  $foo[2] = \%foo;
+
+############# 49
+##
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#*::foo = \5;
+#*::foo = [
+#           #0
+#           10,
+#           #1
+#           '',
+#           #2
+#           {
+#             'a' => 1,
+#             'b' => '',
+#             'c' => [],
+#             'd' => {}
+#           }
+#         ];
+#*::foo{ARRAY}->[1] = $foo;
+#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
+#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
+#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
+#*::foo = *::foo{ARRAY}->[2];
+#@bar = @{*::foo{ARRAY}};
+#%baz = %{*::foo{ARRAY}->[2]};
+EOT
+
+  $Data::Dumper::Purity = 1;
+  $Data::Dumper::Indent = 3;
+  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
+  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
+
+############# 55
+##
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#*::foo = \5;
+#*::foo = [
+#  10,
+#  '',
+#  {
+#    'a' => 1,
+#    'b' => '',
+#    'c' => [],
+#    'd' => {}
+#  }
+#];
+#*::foo{ARRAY}->[1] = $foo;
+#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
+#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
+#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
+#*::foo = *::foo{ARRAY}->[2];
+#$bar = *::foo{ARRAY};
+#$baz = *::foo{ARRAY}->[2];
+EOT
+
+  $Data::Dumper::Indent = 1;
+  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
+  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
+
+############# 61
+##
+  $WANT = <<'EOT';
+#@bar = (
+#  10,
+#  \*::foo,
+#  {}
+#);
+#*::foo = \5;
+#*::foo = \@bar;
+#*::foo = {
+#  'a' => 1,
+#  'b' => '',
+#  'c' => [],
+#  'd' => {}
+#};
+#*::foo{HASH}->{'b'} = *::foo{SCALAR};
+#*::foo{HASH}->{'c'} = \@bar;
+#*::foo{HASH}->{'d'} = *::foo{HASH};
+#$bar[2] = *::foo{HASH};
+#%baz = %{*::foo{HASH}};
+#$foo = $bar[1];
+EOT
+
+  TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo']));
+  TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])) if $XS;
+
+############# 67
+##
+  $WANT = <<'EOT';
+#$bar = [
+#  10,
+#  \*::foo,
+#  {}
+#];
+#*::foo = \5;
+#*::foo = $bar;
+#*::foo = {
+#  'a' => 1,
+#  'b' => '',
+#  'c' => [],
+#  'd' => {}
+#};
+#*::foo{HASH}->{'b'} = *::foo{SCALAR};
+#*::foo{HASH}->{'c'} = $bar;
+#*::foo{HASH}->{'d'} = *::foo{HASH};
+#$bar->[2] = *::foo{HASH};
+#$baz = *::foo{HASH};
+#$foo = $bar->[1];
+EOT
+
+  TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo']));
+  TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])) if $XS;
+
+############# 73
+##
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#@bar = (
+#  10,
+#  $foo,
+#  {
+#    a => 1,
+#    b => \5,
+#    c => \@bar,
+#    d => $bar[2]
+#  }
+#);
+#%baz = %{$bar[2]};
+EOT
+
+  $Data::Dumper::Purity = 0;
+  $Data::Dumper::Quotekeys = 0;
+  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
+  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
+
+############# 79
+##
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#$bar = [
+#  10,
+#  $foo,
+#  {
+#    a => 1,
+#    b => \5,
+#    c => $bar,
+#    d => $bar->[2]
+#  }
+#];
+#$baz = $bar->[2];
+EOT
+
+  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
+  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
+
+}
+
+#############
+#############
+{
+  package main;
+  @dogs = ( 'Fido', 'Wags' );
+  %kennel = (
+            First => \$dogs[0],
+            Second =>  \$dogs[1],
+           );
+  $dogs[2] = \%kennel;
+  $mutts = \%kennel;
+  $mutts = $mutts;         # avoid warning
+  
+############# 85
+##
+if (!$Is_ebcdic) {
+  $WANT = <<'EOT';
+#%kennels = (
+#  First => \'Fido',
+#  Second => \'Wags'
+#);
+#@dogs = (
+#  ${$kennels{First}},
+#  ${$kennels{Second}},
+#  \%kennels
+#);
+#%mutts = %kennels;
+EOT
+}
+else {
+  $WANT = <<'EOT';
+#%kennels = (
+#  Second => \'Wags',
+#  First => \'Fido'
+#);
+#@dogs = (
+#  ${$kennels{First}},
+#  ${$kennels{Second}},
+#  \%kennels
+#);
+#%mutts = %kennels;
+EOT
+}
+
+  TEST q(
+	 $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
+				[qw(*kennels *dogs *mutts)] );
+	 $d->Dump;
+	);
+  if ($XS) {
+    TEST q(
+	   $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
+				  [qw(*kennels *dogs *mutts)] );
+	   $d->Dumpxs;
+	  );
+  }
+  
+############# 91
+##
+  $WANT = <<'EOT';
+#%kennels = %kennels;
+#@dogs = @dogs;
+#%mutts = %kennels;
+EOT
+
+  TEST q($d->Dump);
+  TEST q($d->Dumpxs) if $XS;
+  
+############# 97
+##
+if (!$Is_ebcdic) {
+  $WANT = <<'EOT';
+#%kennels = (
+#  First => \'Fido',
+#  Second => \'Wags'
+#);
+#@dogs = (
+#  ${$kennels{First}},
+#  ${$kennels{Second}},
+#  \%kennels
+#);
+#%mutts = %kennels;
+EOT
+}
+else {
+  $WANT = <<'EOT';
+#%kennels = (
+#  Second => \'Wags',
+#  First => \'Fido'
+#);
+#@dogs = (
+#  ${$kennels{First}},
+#  ${$kennels{Second}},
+#  \%kennels
+#);
+#%mutts = %kennels;
+EOT
+}
+  
+  TEST q($d->Reset; $d->Dump);
+  if ($XS) {
+    TEST q($d->Reset; $d->Dumpxs);
+  }
+
+############# 103
+##
+if (!$Is_ebcdic) {
+ $WANT = <<'EOT';
+#@dogs = (
+#  'Fido',
+#  'Wags',
+#  {
+#    First => \$dogs[0],
+#    Second => \$dogs[1]
+#  }
+#);
+#%kennels = %{$dogs[2]};
+#%mutts = %{$dogs[2]};
+EOT
+}
+else {
+  $WANT = <<'EOT';
+#@dogs = (
+#  'Fido',
+#  'Wags',
+#  {
+#    Second => \$dogs[1],
+#    First => \$dogs[0]
+#  }
+#);
+#%kennels = %{$dogs[2]};
+#%mutts = %{$dogs[2]};
+EOT
+}
+
+  TEST q(
+	 $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
+				[qw(*dogs *kennels *mutts)] );
+	 $d->Dump;
+	);
+  if ($XS) {
+    TEST q(
+	   $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
+				  [qw(*dogs *kennels *mutts)] );
+	   $d->Dumpxs;
+	  );
+  }
+  
+############# 109
+##
+  TEST q($d->Reset->Dump);
+  if ($XS) {
+    TEST q($d->Reset->Dumpxs);
+  }
+
+############# 115
+##
+if (!$Is_ebcdic) {
+  $WANT = <<'EOT';
+#@dogs = (
+#  'Fido',
+#  'Wags',
+#  {
+#    First => \'Fido',
+#    Second => \'Wags'
+#  }
+#);
+#%kennels = (
+#  First => \'Fido',
+#  Second => \'Wags'
+#);
+EOT
+}
+else {
+  $WANT = <<'EOT';
+#@dogs = (
+#  'Fido',
+#  'Wags',
+#  {
+#    Second => \'Wags',
+#    First => \'Fido'
+#  }
+#);
+#%kennels = (
+#  Second => \'Wags',
+#  First => \'Fido'
+#);
+EOT
+}
+
+  TEST q(
+	 $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] );
+	 $d->Deepcopy(1)->Dump;
+	);
+  if ($XS) {
+    TEST q($d->Reset->Dumpxs);
+  }
+  
+}
+
+{
+
+sub z { print "foo\n" }
+$c = [ \&z ];
+
+############# 121
+##
+  $WANT = <<'EOT';
+#$a = $b;
+#$c = [
+#  $b
+#];
+EOT
+
+TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;);
+TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;)
+	if $XS;
+
+############# 127
+##
+  $WANT = <<'EOT';
+#$a = \&b;
+#$c = [
+#  \&b
+#];
+EOT
+
+TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;);
+TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;)
+	if $XS;
+
+############# 133
+##
+  $WANT = <<'EOT';
+#*a = \&b;
+#@c = (
+#  \&b
+#);
+EOT
+
+TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;);
+TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dumpxs;)
+	if $XS;
+
+}
+
+{
+  $a = [];
+  $a->[1] = \$a->[0];
+
+############# 139
+##
+  $WANT = <<'EOT';
+#@a = (
+#  undef,
+#  ''
+#);
+#$a[1] = \$a[0];
+EOT
+
+TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;);
+TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;)
+	if $XS;
+}
+
+{
+  $a = \\\\\'foo';
+  $b = $$$a;
+
+############# 145
+##
+  $WANT = <<'EOT';
+#$a = \\\\\'foo';
+#$b = ${${$a}};
+EOT
+
+TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
+TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
+	if $XS;
+}
+
+{
+  $a = [{ a => \$b }, { b => undef }];
+  $b = [{ c => \$b }, { d => \$a }];
+
+############# 151
+##
+  $WANT = <<'EOT';
+#$a = [
+#  {
+#    a => \[
+#        {
+#          c => ''
+#        },
+#        {
+#          d => \[]
+#        }
+#      ]
+#  },
+#  {
+#    b => undef
+#  }
+#];
+#${$a->[0]{a}}->[0]->{c} = $a->[0]{a};
+#${${$a->[0]{a}}->[1]->{d}} = $a;
+#$b = ${$a->[0]{a}};
+EOT
+
+TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
+TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
+	if $XS;
+}
+
+{
+  $a = [[[[\\\\\'foo']]]];
+  $b = $a->[0][0];
+  $c = $${$b->[0][0]};
+
+############# 157
+##
+  $WANT = <<'EOT';
+#$a = [
+#  [
+#    [
+#      [
+#        \\\\\'foo'
+#      ]
+#    ]
+#  ]
+#];
+#$b = $a->[0][0];
+#$c = ${${$a->[0][0][0][0]}};
+EOT
+
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;);
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;)
+	if $XS;
+}
diff --git a/gnu/usr.bin/perl/t/lib/errno.t b/gnu/usr.bin/perl/t/lib/errno.t
new file mode 100644
index 00000000000..361723f1b22
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/errno.t
@@ -0,0 +1,50 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+	chdir 't' if -d 't';
+	@INC = '../lib' if -d '../lib';
+    }
+}
+
+use Errno;
+
+print "1..5\n";
+
+print "not " unless @Errno::EXPORT_OK;
+print "ok 1\n";
+die unless @Errno::EXPORT_OK;
+
+$err = $Errno::EXPORT_OK[0];
+$num = &{"Errno::$err"};
+
+print "not " unless &{"Errno::$err"} == $num;
+print "ok 2\n";
+
+$! = $num;
+print "not " unless $!{$err};
+print "ok 3\n";
+
+$! = 0;
+print "not " if $!{$err};
+print "ok 4\n";
+
+$s1 = join(",",sort keys(%!));
+$s2 = join(",",sort @Errno::EXPORT_OK);
+
+if($s1 ne $s2) {
+    my @s1 = keys(%!);
+    my @s2 = @Errno::EXPORT_OK;
+    my(%s1,%s2);
+    @s1{@s1} = ();
+    @s2{@s2} = ();
+    delete @s2{@s1};
+    delete @s1{@s2};
+    print "# These are only in \%!\n";
+    print "# ",join(" ",map { "'$_'" } keys %s1),"\n";
+    print "# These are only in \@EXPORT_OK\n";
+    print "# ",join(" ",map { "'$_'" } keys %s2),"\n";
+    print "not ";
+}
+
+print "ok 5\n";
diff --git a/gnu/usr.bin/perl/t/lib/fatal.t b/gnu/usr.bin/perl/t/lib/fatal.t
new file mode 100644
index 00000000000..fb3757f5cda
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/fatal.t
@@ -0,0 +1,27 @@
+#!./perl -w
+
+BEGIN {
+   chdir 't' if -d 't';
+   unshift @INC, '../lib';
+   print "1..9\n";
+}
+
+use strict;
+use Fatal qw(open);
+
+my $i = 1;
+eval { open FOO, '<lkjqweriuapofukndajsdlfjnvcvn' };
+print "not " unless $@ =~ /^Can't open/;
+print "ok $i\n"; ++$i;
+
+my $foo = 'FOO';
+for ('$foo', "'$foo'", "*$foo", "\\*$foo") {
+    eval qq{ open $_, '<$0' };
+    print "not " if $@;
+    print "ok $i\n"; ++$i;
+
+    print "not " unless scalar(<FOO>) =~ m|^#!./perl|;
+    print "not " if $@;
+    print "ok $i\n"; ++$i;
+    close FOO;
+}
diff --git a/gnu/usr.bin/perl/t/lib/fields.t b/gnu/usr.bin/perl/t/lib/fields.t
new file mode 100644
index 00000000000..139e469b5a2
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/fields.t
@@ -0,0 +1,112 @@
+#!./perl -w
+
+my $w;
+
+BEGIN {
+   chdir 't' if -d 't';
+   @INC = '../lib' if -d '../lib';
+   $SIG{__WARN__} = sub {
+       if ($_[0] =~ /^Hides field 'b1' in base class/) {
+           $w++;
+           return;
+       }
+       print $_[0];
+   };
+}
+
+use strict;
+use vars qw($DEBUG);
+
+package B1;
+use fields qw(b1 b2 b3);
+
+package B2;
+use fields '_b1';
+use fields qw(b1 _b2 b2);
+
+sub new { bless [], shift }
+
+package D1;
+use base 'B1';
+use fields qw(d1 d2 d3);
+
+package D2;
+use base 'B1';
+use fields qw(_d1 _d2);
+use fields qw(d1 d2);
+
+package D3;
+use base 'B2';
+use fields qw(b1 d1 _b1 _d1);  # hide b1
+
+package D4;
+use base 'D3';
+use fields qw(_d3 d3);
+
+package M;
+sub m {}
+
+package D5;
+use base qw(M B2);
+
+package Foo::Bar;
+use base 'B1';
+
+package Foo::Bar::Baz;
+use base 'Foo::Bar';
+use fields qw(foo bar baz);
+
+package main;
+
+sub fstr
+{
+   my $h = shift;
+   my @tmp;
+   for my $k (sort {$h->{$a} <=> $h->{$b}} keys %$h) {
+	my $v = $h->{$k};
+        push(@tmp, "$k:$v");
+   }
+   my $str = join(",", @tmp);
+   print "$h => $str\n" if $DEBUG;
+   $str;
+}
+
+my %expect = (
+    B1 => "b1:1,b2:2,b3:3",
+    B2 => "_b1:1,b1:2,_b2:3,b2:4",
+    D1 => "b1:1,b2:2,b3:3,d1:4,d2:5,d3:6",
+    D2 => "b1:1,b2:2,b3:3,_d1:4,_d2:5,d1:6,d2:7",
+    D3 => "b2:4,b1:5,d1:6,_b1:7,_d1:8",
+    D4 => "b2:4,b1:5,d1:6,_d3:9,d3:10",
+    D5 => "b1:2,b2:4",
+    'Foo::Bar::Baz' => 'b1:1,b2:2,b3:3,foo:4,bar:5,baz:6',
+);
+
+print "1..", int(keys %expect)+3, "\n";
+my $testno = 0;
+while (my($class, $exp) = each %expect) {
+   no strict 'refs';
+   my $fstr = fstr(\%{$class."::FIELDS"});
+   print "EXP: $exp\nGOT: $fstr\nnot " unless $fstr eq $exp;
+   print "ok ", ++$testno, "\n";
+}
+
+# Did we get the appropriate amount of warnings?
+print "not " unless $w == 1;
+print "ok ", ++$testno, "\n";
+
+# A simple object creation and AVHV attribute access test
+my B2 $obj1 = D3->new;
+$obj1->{b1} = "B2";
+my D3 $obj2 = $obj1;
+$obj2->{b1} = "D3";
+
+print "not " unless $obj1->[2] eq "B2" && $obj1->[5] eq "D3";
+print "ok ", ++$testno, "\n";
+
+# We should get compile time failures field name typos
+eval q(my D3 $obj3 = $obj2; $obj3->{notthere} = "");
+print "not " unless $@ && $@ =~ /^No such field "notthere"/;
+print "ok ", ++$testno, "\n";
+
+#fields::_dump();
diff --git a/gnu/usr.bin/perl/t/lib/filespec.t b/gnu/usr.bin/perl/t/lib/filespec.t
new file mode 100644
index 00000000000..ca22d3e12ba
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/filespec.t
@@ -0,0 +1,43 @@
+#!./perl
+
+BEGIN {
+    $^O = '';
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..4\n";
+
+use File::Spec;
+
+
+if (File::Spec->catfile('a','b','c') eq 'a/b/c') {
+	print "ok 1\n";
+} else {
+	print "not ok 1\n";
+}
+
+use File::Spec::OS2;
+
+if (File::Spec::OS2->catfile('a','b','c') eq 'a/b/c') {
+	print "ok 2\n";
+} else {
+	print "not ok 2\n";
+}
+
+use File::Spec::Win32;
+
+if (File::Spec::Win32->catfile('a','b','c') eq 'a\b\c') {
+	print "ok 3\n";
+} else {
+	print "not ok 3\n";
+}
+
+use File::Spec::Mac;
+
+if (File::Spec::Mac->catfile('a','b','c') eq 'a:b:c') {
+	print "ok 4\n";
+} else {
+	print "not ok 4\n";
+}
+
diff --git a/gnu/usr.bin/perl/t/lib/h2ph.h b/gnu/usr.bin/perl/t/lib/h2ph.h
new file mode 100644
index 00000000000..cddf0a7d947
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/h2ph.h
@@ -0,0 +1,85 @@
+/* 
+ * Test header file for h2ph
+ * 
+ * Try to test as many constructs as possible
+ * For example, the multi-line comment :)
+ */
+
+/* And here's a single line comment :) */
+
+/* Test #define with no indenting, over multiple lines */
+#define SQUARE(x) \
+((x)*(x))
+
+/* Test #ifndef and parameter interpretation*/
+#ifndef ERROR
+#define ERROR(x) fprintf(stderr, "%s\n", x[2][3][0])
+#endif /* ERROR */
+
+#ifndef _H2PH_H_
+#define _H2PH_H_
+
+/* #ident - doesn't really do anything, but I think it always gets included anyway */
+#ident "$Revision h2ph.h,v 1.0 98/05/04 20:42:14 billy $"
+
+/* Test #undef */
+#undef MAX
+#define MAX(a,b) ((a) > (b) ? (a) : (b))
+
+/* Test #ifdef */
+#ifdef __SOME_UNIMPORTANT_PROPERTY
+#define MIN(a,b) ((a) < (b) ? (a) : (b))
+#endif /* __SOME_UNIMPORTANT_PROPERTY */
+
+/* 
+ * Test #if, #elif, #else, #endif, #warn and #error, and `!'
+ * Also test whitespace between the `#' and the command
+ */
+#if !(defined __SOMETHING_MORE_IMPORTANT)
+#    warn Be careful...
+#elif !(defined __SOMETHING_REALLY_REALLY_IMPORTANT)
+#    error Nup, can't go on /* ' /* stupid font-lock-mode */
+#else /* defined __SOMETHING_MORE_IMPORTANT && defined __SOMETHING_REALLY_REALLY_IMPORTANT */
+#    define EVERYTHING_IS_OK
+#endif
+
+/* Test && and || */
+#undef WHATEVER
+#if (!((defined __SOMETHING_TRIVIAL && defined __SOMETHING_LESS_SO)) \
+     || defined __SOMETHING_OVERPOWERING)
+#    define WHATEVER 6
+#elif !(defined __SOMETHING_TRIVIAL) /* defined __SOMETHING_LESS_SO */
+#    define WHATEVER 7
+#elif !(defined __SOMETHING_LESS_SO) /* defined __SOMETHING_TRIVIAL */
+#    define WHATEVER 8
+#else /* defined __SOMETHING_TRIVIAL && defined __SOMETHING_LESS_SO */
+#    define WHATEVER 1000
+#endif
+
+/* 
+ * Test #include, #import and #include_next
+ * #include_next is difficult to test, it really depends on the actual
+ *  circumstances - for example, `#include_next <limits.h>' on a Linux system
+ *  with `use lib qw(/opt/perl5/lib/site_perl/i586-linux/linux);' or whatever
+ *  your equivalent is...
+ */
+#include <sys/socket.h>
+#import "sys/ioctl.h"
+#include_next <sys/fcntl.h>
+
+/* typedefs should be ignored */
+typedef struct a_struct {
+  int typedefs_should;
+  char be_ignored;
+  long as_well;
+} a_typedef;
+
+/* 
+ * however, typedefs of enums and just plain enums should end up being treated
+ * like a bunch of #defines...
+ */
+
+typedef enum _days_of_week { sun, mon, tue, wed, thu, fri, sat, Sun=0, Mon,
+			     Tue, Wed, Thu, Fri, Sat } days_of_week;
+
+#endif /* _H2PH_H_ */
diff --git a/gnu/usr.bin/perl/t/lib/h2ph.pht b/gnu/usr.bin/perl/t/lib/h2ph.pht
new file mode 100644
index 00000000000..e5b293243ec
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/h2ph.pht
@@ -0,0 +1,71 @@
+require '_h2ph_pre.ph';
+
+unless(defined(&SQUARE)) {
+    sub SQUARE {
+	local($x) = @_;
+	eval q((($x)*($x)));
+    }
+}
+unless(defined(&ERROR)) {
+    eval 'sub ERROR {
+        local($x) = @_;
+	    eval q( &fprintf( &stderr, \\"%s\\\\n\\", $x->[2][3][0]));
+    }' unless defined(&ERROR);
+}
+unless(defined(&_H2PH_H_)) {
+    eval 'sub _H2PH_H_ () {1;}' unless defined(&_H2PH_H_);
+    # "$Revision h2ph.h,v 1.0 98/05/04 20:42:14 billy $"
+    undef(&MAX) if defined(&MAX);
+    eval 'sub MAX {
+        local($a,$b) = @_;
+	    eval q((($a) > ($b) ? ($a) : ($b)));
+    }' unless defined(&MAX);
+    if(defined(&__SOME_UNIMPORTANT_PROPERTY)) {
+	eval 'sub MIN {
+	    local($a,$b) = @_;
+    	    eval q((($a) < ($b) ? ($a) : ($b)));
+	}' unless defined(&MIN);
+    }
+    if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : 0))) {
+    }
+ elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : 0))) {
+	die("Nup\,\ can\'t\ go\ on\ ");
+    } else {
+	eval 'sub EVERYTHING_IS_OK () {1;}' unless defined(&EVERYTHING_IS_OK);
+    }
+    undef(&WHATEVER) if defined(&WHATEVER);
+    if((!((defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : 0)  && defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : 0))) || defined (defined(&__SOMETHING_OVERPOWERING) ? &__SOMETHING_OVERPOWERING : 0))) {
+	eval 'sub WHATEVER () {6;}' unless defined(&WHATEVER);
+    }
+ elsif(!(defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : 0)) ) {
+	eval 'sub WHATEVER () {7;}' unless defined(&WHATEVER);
+    }
+ elsif(!(defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : 0)) ) {
+	eval 'sub WHATEVER () {8;}' unless defined(&WHATEVER);
+    } else {
+	eval 'sub WHATEVER () {1000;}' unless defined(&WHATEVER);
+    }
+    require 'sys/socket.ph';
+    require 'sys/ioctl.ph';
+    eval {
+	my(%INCD) = map { $INC{$_} => 1 } (grep { $_ eq "sys/fcntl.ph" } keys(%INC));
+	my(@REM) = map { "$_/sys/fcntl.ph" } (grep { not exists($INCD{"$_/sys/fcntl.ph"})and -f "$_/sys/fcntl.ph" } @INC);
+	require "$REM[0]" if @REM;
+    };
+    warn($@) if $@;
+    eval("sub sun () { 0; }") unless defined(&sun);
+    eval("sub mon () { 1; }") unless defined(&mon);
+    eval("sub tue () { 2; }") unless defined(&tue);
+    eval("sub wed () { 3; }") unless defined(&wed);
+    eval("sub thu () { 4; }") unless defined(&thu);
+    eval("sub fri () { 5; }") unless defined(&fri);
+    eval("sub sat () { 6; }") unless defined(&sat);
+    eval("sub Sun () { 0; }") unless defined(&Sun);
+    eval("sub Mon () { 1; }") unless defined(&Mon);
+    eval("sub Tue () { 2; }") unless defined(&Tue);
+    eval("sub Wed () { 3; }") unless defined(&Wed);
+    eval("sub Thu () { 4; }") unless defined(&Thu);
+    eval("sub Fri () { 5; }") unless defined(&Fri);
+    eval("sub Sat () { 6; }") unless defined(&Sat);
+}
+1;
diff --git a/gnu/usr.bin/perl/t/lib/h2ph.t b/gnu/usr.bin/perl/t/lib/h2ph.t
new file mode 100644
index 00000000000..1fa7f63536d
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/h2ph.t
@@ -0,0 +1,34 @@
+#!./perl
+
+# quickie tests to see if h2ph actually runs and does more or less what is
+# expected
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..2\n";
+
+# quickly compare two text files
+sub txt_compare {
+    local ($/, $A, $B);
+    for (($A,$B) = @_) { open(_,"<$_") ? $_ = <_> : die "$_ : $!"; close _ }
+    $A cmp $B;
+}
+
+unless(-e '../utils/h2ph') {
+    print("ok 1\nok 2\n");
+    # i'll probably get in trouble for this :)
+} else {
+    # does it run?
+    $ok = system("./perl -I../lib ../utils/h2ph -d. -Q lib/h2ph.h");
+    print(($ok == 0 ? "" : "not "), "ok 1\n");
+    
+    # does it work? well, does it do what we expect? :-)
+    $ok = txt_compare("lib/h2ph.ph", "lib/h2ph.pht");
+    print(($ok == 0 ? "" : "not "), "ok 2\n");
+    
+    # cleanup - should this be in an END block?
+    unlink("lib/h2ph.ph");
+}
diff --git a/gnu/usr.bin/perl/t/lib/ipc_sysv.t b/gnu/usr.bin/perl/t/lib/ipc_sysv.t
new file mode 100644
index 00000000000..30ea48d9994
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/ipc_sysv.t
@@ -0,0 +1,178 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+
+    @INC = '../lib';
+
+    require Config; import Config;
+
+    unless ($Config{'d_msg'} eq 'define' &&
+	    $Config{'d_sem'} eq 'define') {
+	print "1..0\n";
+	exit;
+    }
+}
+
+# These constants are common to all tests.
+# Later the sem* tests will import more for themselves.
+
+use IPC::SysV qw(IPC_PRIVATE IPC_NOWAIT IPC_STAT IPC_RMID
+		 S_IRWXU S_IRWXG S_IRWXO);
+use strict;
+
+print "1..16\n";
+
+my $msg;
+my $sem;
+
+$SIG{__DIE__} = 'cleanup'; # will cleanup $msg and $sem if needed
+
+# FreeBSD is known to throw this if there's no SysV IPC in the kernel.
+$SIG{SYS} = sub {
+    print STDERR <<EOM;
+SIGSYS caught.
+It may be that your kernel does not have SysV IPC configured.
+
+EOM
+    if ($^O eq 'freebsd') {
+	print STDERR <<EOM;
+You must have following options in your kernel:
+
+options         SYSVSHM
+options         SYSVSEM
+options         SYSVMSG
+
+See config(8).
+EOM
+    }
+    exit(1);
+};
+
+if ($Config{'d_msgget'} eq 'define' &&
+    $Config{'d_msgctl'} eq 'define' &&
+    $Config{'d_msgsnd'} eq 'define' &&
+    $Config{'d_msgrcv'} eq 'define') {
+    $msg = msgget(IPC_PRIVATE, S_IRWXU | S_IRWXG | S_IRWXO);
+    # Very first time called after machine is booted value may be 0 
+    die "msgget failed: $!\n" unless defined($msg) && $msg >= 0;
+
+    print "ok 1\n";
+
+    #Putting a message on the queue
+    my $msgtype = 1;
+    my $msgtext = "hello";
+
+    msgsnd($msg,pack("L a*",$msgtype,$msgtext),0) or print "not ";
+    print "ok 2\n";
+
+    my $data;
+    msgctl($msg,IPC_STAT,$data) or print "not ";
+    print "ok 3\n";
+
+    print "not " unless length($data);
+    print "ok 4\n";
+
+    my $msgbuf;
+    msgrcv($msg,$msgbuf,256,0,IPC_NOWAIT) or print "not ";
+    print "ok 5\n";
+
+    my($rmsgtype,$rmsgtext) = unpack("L a*",$msgbuf);
+
+    print "not " unless($rmsgtype == $msgtype && $rmsgtext eq $msgtext);
+    print "ok 6\n";
+} else {
+    for (1..6) {
+	print "ok $_\n"; # fake it
+    }
+}
+
+if($Config{'d_semget'} eq 'define' &&
+   $Config{'d_semctl'} eq 'define') {
+
+    use IPC::SysV qw(IPC_CREAT GETALL SETALL);
+
+    $sem = semget(IPC_PRIVATE, 10, S_IRWXU | S_IRWXG | S_IRWXO | IPC_CREAT);
+    # Very first time called after machine is booted value may be 0 
+    die "semget: $!\n" unless defined($sem) && $sem >= 0;
+
+    print "ok 7\n";
+
+    my $data;
+    semctl($sem,0,IPC_STAT,$data) or print "not ";
+    print "ok 8\n";
+
+    print "not " unless length($data);
+    print "ok 9\n";
+
+    my $template;
+
+    # Find the pack/unpack template capable of handling native C shorts.
+
+    if      ($Config{shortsize} == 2) {
+	$template = "s";
+    } elsif ($Config{shortsize} == 4) {
+	$template = "l";
+    } elsif ($Config{shortsize} == 8) {
+	# Try quad last because not supported everywhere.
+	foreach my $t (qw(i q)) {
+	    # We could trap the unsupported quad template with eval
+	    # but if we get this far we should have quad support anyway.
+	    if (length(pack($t, 0)) == 8) {
+		$template = $t;
+		last;
+	    }
+	}
+    }
+
+    die "$0: cannot pack native shorts\n" unless defined $template;
+
+    $template .= "*";
+
+    my $nsem = 10;
+
+    semctl($sem,0,SETALL,pack($template,(0) x $nsem)) or print "not ";
+    print "ok 10\n";
+
+    $data = "";
+    semctl($sem,0,GETALL,$data) or print "not ";
+    print "ok 11\n";
+
+    print "not " unless length($data) == length(pack($template,(0) x $nsem));
+    print "ok 12\n";
+
+    my @data = unpack($template,$data);
+
+    my $adata = "0" x $nsem;
+
+    print "not " unless @data == $nsem and join("",@data) eq $adata;
+    print "ok 13\n";
+
+    my $poke = 2;
+
+    $data[$poke] = 1;
+    semctl($sem,0,SETALL,pack($template,@data)) or print "not ";
+    print "ok 14\n";
+    
+    $data = "";
+    semctl($sem,0,GETALL,$data) or print "not ";
+    print "ok 15\n";
+
+    @data = unpack($template,$data);
+
+    my $bdata = "0" x $poke . "1" . "0" x ($nsem-$poke-1);
+
+    print "not " unless join("",@data) eq $bdata;
+    print "ok 16\n";
+} else {
+    for (7..16) {
+	print "ok $_\n"; # fake it
+    }
+}
+
+sub cleanup {
+    msgctl($msg,IPC_RMID,0)       if defined $msg;
+    semctl($sem,0,IPC_RMID,undef) if defined $sem;
+}
+
+cleanup;
diff --git a/gnu/usr.bin/perl/t/lib/ph.t b/gnu/usr.bin/perl/t/lib/ph.t
new file mode 100644
index 00000000000..de27dee5e23
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/ph.t
@@ -0,0 +1,96 @@
+#!./perl
+
+# Check for presence and correctness of .ph files; for now,
+# just socket.ph and pals.
+#   -- Kurt Starsinic <kstar@isinet.com>
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# All the constants which Socket.pm tries to make available:
+my @possibly_defined = qw(
+    INADDR_ANY INADDR_LOOPBACK INADDR_NONE AF_802 AF_APPLETALK AF_CCITT
+    AF_CHAOS AF_DATAKIT AF_DECnet AF_DLI AF_ECMA AF_GOSIP AF_HYLINK AF_IMPLINK
+    AF_INET AF_LAT AF_MAX AF_NBS AF_NIT AF_NS AF_OSI AF_OSINET AF_PUP
+    AF_SNA AF_UNIX AF_UNSPEC AF_X25 MSG_DONTROUTE MSG_MAXIOVLEN MSG_OOB
+    MSG_PEEK PF_802 PF_APPLETALK PF_CCITT PF_CHAOS PF_DATAKIT PF_DECnet PF_DLI
+    PF_ECMA PF_GOSIP PF_HYLINK PF_IMPLINK PF_INET PF_LAT PF_MAX PF_NBS PF_NIT
+    PF_NS PF_OSI PF_OSINET PF_PUP PF_SNA PF_UNIX PF_UNSPEC PF_X25 SOCK_DGRAM
+    SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM SOL_SOCKET SOMAXCONN
+    SO_ACCEPTCONN SO_BROADCAST SO_DEBUG SO_DONTLINGER SO_DONTROUTE SO_ERROR
+    SO_KEEPALIVE SO_LINGER SO_OOBINLINE SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO
+    SO_REUSEADDR SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO SO_TYPE SO_USELOOPBACK
+);
+
+
+# The libraries which I'm going to require:
+my @libs = qw(Socket "sys/types.ph" "sys/socket.ph" "netinet/in.ph");
+
+
+# These are defined by Socket.pm even if the C header files don't define them:
+my %ok_to_miss = (
+    INADDR_NONE         => 1,
+    INADDR_LOOPBACK     => 1,
+);
+
+
+my $total_tests = scalar @libs + scalar @possibly_defined;
+my $i           = 0;
+
+print "1..$total_tests\n";
+
+
+foreach (@libs) {
+    $i++;
+
+    if (eval "require $_" ) {
+        print "ok $i\n";
+    } else {
+        print "# Skipping tests; $_ may be missing\n";
+        foreach ($i .. $total_tests) { print "ok $_\n" }
+        exit;
+    }
+}
+
+
+foreach (@possibly_defined) {
+    $i++;
+
+    $pm_val = eval "Socket::$_()";
+    $ph_val = eval "main::$_()";
+
+    if (defined $pm_val and !defined $ph_val) {
+        if ($ok_to_miss{$_}) { print "ok $i\n" }
+        else                 { print "not ok $i\n" }
+        next;
+    } elsif (defined $ph_val and !defined $pm_val) {
+        print "not ok $i\n";
+        next;
+    }
+
+    # Socket.pm converts these to network byte order, so we convert the
+    # socket.ph version to match; note that these cases skip the following
+    # `elsif', which is only applied to _numeric_ values, not literal
+    # bitmasks.
+    if ($_ eq 'INADDR_ANY'
+    or  $_ eq 'INADDR_LOOPBACK'
+    or  $_ eq 'INADDR_NONE') {
+        $ph_val = pack("N*", $ph_val);  # htonl(3) equivalent
+    }
+
+    # Since Socket.pm and socket.ph wave their hands over macros differently,
+    # they could return functionally equivalent bitmaps with different numeric
+    # interpretations (due to sign extension).  The only apparent case of this
+    # is SO_DONTLINGER (only on Solaris, and deprecated, at that):
+    elsif ($pm_val != $ph_val) {
+        $pm_val = oct(sprintf "0x%lx", $pm_val);
+        $ph_val = oct(sprintf "0x%lx", $ph_val);
+    }
+
+    if ($pm_val == $ph_val) { print "ok $i\n" }
+    else                    { print "not ok $i\n" }
+}
+
+
diff --git a/gnu/usr.bin/perl/t/lib/textfill.t b/gnu/usr.bin/perl/t/lib/textfill.t
new file mode 100644
index 00000000000..19add694238
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/textfill.t
@@ -0,0 +1,96 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+@tests = (split(/\nEND\n/s, <<DONE));
+TEST1
+Cyberdog Information
+
+Cyberdog & Netscape in the news
+Important Press Release regarding Cyberdog and Netscape. Check it out! 
+
+Cyberdog Plug-in Support!
+Cyberdog support for Netscape Plug-ins is now available to download! Go
+to the Cyberdog Beta Download page and download it now! 
+
+Cyberdog Book
+Check out Jesse Feiler's way-cool book about Cyberdog. You can find
+details out about the book as well as ordering information at Philmont
+Software Mill site. 
+
+Java!
+Looking to view Java applets in Cyberdog 1.1 Beta 3? Download and install
+the Mac OS Runtime for Java and try it out! 
+
+Cyberdog 1.1 Beta 3
+We hope that Cyberdog and OpenDoc 1.1 will be available within the next
+two weeks. In the meantime, we have released another version of
+Cyberdog, Cyberdog 1.1 Beta 3. This version fixes several bugs that were
+reported to us during out public beta period. You can check out our release
+notes to see what we fixed! 
+END
+    Cyberdog Information
+    Cyberdog & Netscape in the news Important Press Release regarding
+ Cyberdog and Netscape. Check it out! 
+    Cyberdog Plug-in Support! Cyberdog support for Netscape Plug-ins is now
+ available to download! Go to the Cyberdog Beta Download page and download
+ it now! 
+    Cyberdog Book Check out Jesse Feiler's way-cool book about Cyberdog.
+ You can find details out about the book as well as ordering information at
+ Philmont Software Mill site. 
+    Java! Looking to view Java applets in Cyberdog 1.1 Beta 3? Download and
+ install the Mac OS Runtime for Java and try it out! 
+    Cyberdog 1.1 Beta 3 We hope that Cyberdog and OpenDoc 1.1 will be
+ available within the next two weeks. In the meantime, we have released
+ another version of Cyberdog, Cyberdog 1.1 Beta 3. This version fixes
+ several bugs that were reported to us during out public beta period. You
+ can check out our release notes to see what we fixed! 
+END
+DONE
+
+
+$| = 1;
+
+print "1..", @tests/2, "\n";
+
+use Text::Wrap;
+
+$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
+
+$tn = 1;
+while (@tests) {
+	my $in = shift(@tests);
+	my $out = shift(@tests);
+
+	$in =~ s/^TEST(\d+)?\n//;
+
+	my $back = fill('    ', ' ', $in);
+
+	if ($back eq $out) {
+		print "ok $tn\n";
+	} elsif ($rerun) {
+		my $oi = $in;
+		open(F,">#o") and do { print F $back; close(F) };
+		open(F,">#e") and do { print F $out;  close(F) };
+		foreach ($in, $back, $out) {
+			s/\t/^I\t/gs;
+			s/\n/\$\n/gs;
+		}
+		print "------------ input ------------\n";
+		print $in;
+		print "\n------------ output -----------\n";
+		print $back;
+		print "\n------------ expected ---------\n";
+		print $out;
+		print "\n-------------------------------\n";
+		$Text::Wrap::debug = 1;
+		fill('    ', ' ', $oi);
+		exit(1);
+	} else {
+		print "not ok $tn\n";
+	}
+	$tn++;
+}
diff --git a/gnu/usr.bin/perl/t/lib/thread.t b/gnu/usr.bin/perl/t/lib/thread.t
new file mode 100644
index 00000000000..c127d0f28f2
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/thread.t
@@ -0,0 +1,73 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if (! $Config{'usethreads'}) {
+	print "1..0\n";
+	exit 0;
+    }
+
+    # XXX known trouble with global destruction
+    $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+}
+$| = 1;
+print "1..14\n";
+use Thread;
+print "ok 1\n";
+
+sub content
+{
+ print shift;
+ return shift;
+}
+
+# create a thread passing args and immedaietly wait for it.
+my $t = new Thread \&content,("ok 2\n","ok 3\n", 1..1000);
+print $t->join;
+
+# check that lock works ...
+{lock $foo;
+ $t = new Thread sub { lock $foo; print "ok 5\n" };
+ print "ok 4\n";
+}
+$t->join;
+
+sub dorecurse
+{
+ my $val = shift;
+ my $ret;
+ print $val;
+ if (@_)
+  {
+   $ret = Thread->new(\&dorecurse, @_);
+   $ret->join;
+  }
+}
+
+$t = new Thread \&dorecurse, map { "ok $_\n" } 6..10;
+$t->join;
+
+# test that sleep lets other thread run
+$t = new Thread \&dorecurse,"ok 11\n";
+sleep 6;
+print "ok 12\n";
+$t->join;
+
+sub islocked
+{
+ use attrs 'locked';
+ my $val = shift;
+ my $ret;
+ print $val;
+ if (@_)
+  {
+   $ret = Thread->new(\&islocked, shift);
+  }
+ $ret;
+}
+
+$t = Thread->new(\&islocked, "ok 13\n", "ok 14\n");
+$t->join->join;
+
diff --git a/gnu/usr.bin/perl/t/lib/tie-push.t b/gnu/usr.bin/perl/t/lib/tie-push.t
new file mode 100644
index 00000000000..dd718deb145
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/tie-push.t
@@ -0,0 +1,24 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}    
+
+{
+ package Basic;
+ use Tie::Array;
+ @ISA = qw(Tie::Array);
+
+ sub TIEARRAY  { return bless [], shift }
+ sub FETCH     { $_[0]->[$_[1]] }
+ sub STORE     { $_[0]->[$_[1]] = $_[2] }
+ sub FETCHSIZE { scalar(@{$_[0]}) }
+ sub STORESIZE { $#{$_[0]} = $_[1]-1 }
+}
+
+tie @x,Basic;
+tie @get,Basic;
+tie @got,Basic;
+tie @tests,Basic;
+require "../t/op/push.t"
diff --git a/gnu/usr.bin/perl/t/lib/tie-stdarray.t b/gnu/usr.bin/perl/t/lib/tie-stdarray.t
new file mode 100644
index 00000000000..7ca4d76f119
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/tie-stdarray.t
@@ -0,0 +1,12 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Tie::Array;
+tie @foo,Tie::StdArray;
+tie @ary,Tie::StdArray;
+tie @bar,Tie::StdArray;
+require "../t/op/array.t"
diff --git a/gnu/usr.bin/perl/t/lib/tie-stdpush.t b/gnu/usr.bin/perl/t/lib/tie-stdpush.t
new file mode 100644
index 00000000000..34a69472f4c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/tie-stdpush.t
@@ -0,0 +1,10 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Tie::Array;
+tie @x,Tie::StdArray;
+require "../t/op/push.t"