import perl 5.10.0 from CPAN

63 files changed, 9040 insertions, 245 deletions

diff --git a/gnu/usr.bin/perl/t/lib/1_compile.t b/gnu/usr.bin/perl/t/lib/1_compile.t
index ee65b558101..72628c30a79 100644
--- a/gnu/usr.bin/perl/t/lib/1_compile.t
+++ b/gnu/usr.bin/perl/t/lib/1_compile.t
@@ -19,15 +19,11 @@ my @Core_Modules = grep /\S/, <DATA>;
 chomp @Core_Modules;
 
 if (eval { require Socket }) {
-  push @Core_Modules, qw(Net::Domain);
   # Two Net:: modules need the Convert::EBCDIC if in EBDCIC.
   if (ord("A") != 193 || eval { require Convert::EBCDIC }) {
       push @Core_Modules, qw(Net::Cmd Net::POP3);
   }
 }
-if(eval { require B }) {
-  push @Core_Modules, qw(B::C B::CC B::Stackobj);
-}
 
 @Core_Modules = sort @Core_Modules;
 
@@ -73,7 +69,3 @@ sub compile_module {
 # http://www.pobox.com/~schwern/cgi-bin/perl-qa-wiki.cgi?UntestedModules
 # and vice-versa.  The list should only shrink.
 __DATA__
-ByteLoader
-CPAN::FirstTime
-DynaLoader
-Pod::Plainer
diff --git a/gnu/usr.bin/perl/t/lib/Cname.pm b/gnu/usr.bin/perl/t/lib/Cname.pm
new file mode 100644
index 00000000000..d4b8a9ea4dd
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/Cname.pm
@@ -0,0 +1,22 @@
+package Cname;
+our $Evil='A';
+
+sub translator {
+    my $str = shift;
+    if ( $str eq 'EVIL' ) {
+        (my $c=substr("A".$Evil,-1))++;
+        my $r=$Evil;
+        $Evil.=$c;
+        return $r;
+    }
+    if ( $str eq 'EMPTY-STR') {
+       return "";
+    }
+    return $str;
+}
+
+sub import {
+    shift;
+    $^H{charnames} = \&translator;
+}
+1;  
diff --git a/gnu/usr.bin/perl/t/lib/Devel/switchd.pm b/gnu/usr.bin/perl/t/lib/Devel/switchd.pm
index 4a657bef910..e5b062911d2 100644
--- a/gnu/usr.bin/perl/t/lib/Devel/switchd.pm
+++ b/gnu/usr.bin/perl/t/lib/Devel/switchd.pm
@@ -1,6 +1,8 @@
 package Devel::switchd;
 use strict; BEGIN { } # use strict; BEGIN { ... } to incite [perl #21890]
+sub import { print "import<@_>;" }
 package DB;
-sub DB { print join(",", caller), ";" }
+sub DB { print "DB<", join(",", caller), ">;" }
+sub sub { print "sub<$DB::sub>;"; goto &$DB::sub }
 1;
 
diff --git a/gnu/usr.bin/perl/t/lib/Dummy.pm b/gnu/usr.bin/perl/t/lib/Dummy.pm
new file mode 100644
index 00000000000..504330f8b16
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/Dummy.pm
@@ -0,0 +1,4 @@
+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
new file mode 100644
index 00000000000..3368e049957
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/HasSigDie.pm
@@ -0,0 +1,6 @@
+package HasSigDie;
+
+$SIG{__DIE__} = sub { "Die, Bart, Die!" };
+
+1;
+
diff --git a/gnu/usr.bin/perl/t/lib/MakeMaker/Test/Setup/Recurs.pm b/gnu/usr.bin/perl/t/lib/MakeMaker/Test/Setup/Recurs.pm
index c8b73793483..d3585eb9c2e 100644
--- a/gnu/usr.bin/perl/t/lib/MakeMaker/Test/Setup/Recurs.pm
+++ b/gnu/usr.bin/perl/t/lib/MakeMaker/Test/Setup/Recurs.pm
@@ -27,6 +27,14 @@ WriteMakefile(
     VERSION => 1.00,
 );
 END
+
+             # Check if a test failure in a subdir causes make test to fail
+             'Recurs/prj2/t/fail.t'         => <<'END',
+#!/usr/bin/perl -w
+
+print "1..1\n";
+print "not ok 1\n";
+END
             );
 
 sub setup_recurs {
diff --git a/gnu/usr.bin/perl/t/lib/MakeMaker/Test/Setup/XS.pm b/gnu/usr.bin/perl/t/lib/MakeMaker/Test/Setup/XS.pm
new file mode 100644
index 00000000000..195fd56feb0
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/MakeMaker/Test/Setup/XS.pm
@@ -0,0 +1,97 @@
+package MakeMaker::Test::Setup::XS;
+
+@ISA = qw(Exporter);
+require Exporter;
+@EXPORT = qw(setup_xs teardown_xs);
+
+use strict;
+use File::Path;
+use File::Basename;
+use MakeMaker::Test::Utils;
+
+my $Is_VMS = $^O eq 'VMS';
+
+my %Files = (
+             'XS-Test/lib/XS/Test.pm'     => <<'END',
+package XS::Test;
+
+require Exporter;
+require DynaLoader;
+
+$VERSION = 1.01;
+@ISA    = qw(Exporter DynaLoader);
+@EXPORT = qw(is_even);
+
+bootstrap XS::Test $VERSION;
+
+1;
+END
+
+             'XS-Test/Makefile.PL'          => <<'END',
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME          => 'XS::Test',
+    VERSION_FROM  => 'lib/XS/Test.pm',
+);
+END
+
+             'XS-Test/Test.xs'              => <<'END',
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+MODULE = XS::Test       PACKAGE = XS::Test
+
+PROTOTYPES: DISABLE
+
+int
+is_even(input)
+       int     input
+   CODE:
+       RETVAL = (input % 2 == 0);
+   OUTPUT:
+       RETVAL        
+END
+
+             'XS-Test/t/is_even.t'          => <<'END',
+#!/usr/bin/perl -w
+
+use Test::More tests => 3;
+
+use_ok "XS::Test";
+ok !is_even(1);
+ok is_even(2);
+END
+            );
+
+
+sub setup_xs {
+    setup_mm_test_root();
+    chdir 'MM_TEST_ROOT:[t]' if $Is_VMS;
+
+    while(my($file, $text) = each %Files) {
+        # Convert to a relative, native file path.
+        $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file);
+
+        my $dir = dirname($file);
+        mkpath $dir;
+        open(FILE, ">$file") || die "Can't create $file: $!";
+        print FILE $text;
+        close FILE;
+    }
+
+    return 1;
+}
+
+sub teardown_xs { 
+    foreach my $file (keys %Files) {
+        my $dir = dirname($file);
+        if( -e $dir ) {
+            rmtree($dir) || return;
+        }
+    }
+    return 1;
+}
+
+1;
\ No newline at end of file
diff --git a/gnu/usr.bin/perl/t/lib/MakeMaker/Test/Utils.pm b/gnu/usr.bin/perl/t/lib/MakeMaker/Test/Utils.pm
index 0d6afc33aba..fb8162d2cd1 100644
--- a/gnu/usr.bin/perl/t/lib/MakeMaker/Test/Utils.pm
+++ b/gnu/usr.bin/perl/t/lib/MakeMaker/Test/Utils.pm
@@ -251,7 +251,7 @@ would expect to see on a screen.
 sub run {
     my $cmd = shift;
 
-    require ExtUtils::MM;
+    use ExtUtils::MM;
 
     # Unix can handle 2>&1 and OS/2 from 5.005_54 up.
     # This makes our failure diagnostics nicer to read.
@@ -304,7 +304,7 @@ sub have_compiler {
 
     # ExtUtils::CBuilder prints its compilation lines to the screen.
     # Shut it up.
-    require TieOut;
+    use TieOut;
     local *STDOUT = *STDOUT;
     local *STDERR = *STDERR;
 
diff --git a/gnu/usr.bin/perl/t/lib/Math/BigInt/BareCalc.pm b/gnu/usr.bin/perl/t/lib/Math/BigInt/BareCalc.pm
index 3efa525aebf..0bbe861cf8f 100644
--- a/gnu/usr.bin/perl/t/lib/Math/BigInt/BareCalc.pm
+++ b/gnu/usr.bin/perl/t/lib/Math/BigInt/BareCalc.pm
@@ -8,7 +8,7 @@ require Exporter;
 use vars qw/@ISA $VERSION/;
 @ISA = qw(Exporter);
 
-$VERSION = '0.02';
+$VERSION = '0.05';
 
 sub api_version () { 1; }
 
@@ -16,18 +16,18 @@ sub api_version () { 1; }
 
 # uses Calc, but only features the strictly necc. methods.
 
-use Math::BigInt::Calc '0.40';
+use Math::BigInt::Calc '0.51';
 
 BEGIN
   {
   no strict 'refs';
   foreach (qw/	
 	base_len new zero one two ten copy str num add sub mul div mod inc dec
-	acmp len digit zeros
+	acmp alen len digit zeros
 	rsft lsft
 	fac pow gcd log_int sqrt root
 	is_zero is_one is_odd is_even is_one is_two is_ten check
-	as_hex as_bin from_hex from_bin	
+	as_hex as_bin as_oct from_hex from_bin from_oct
 	modpow modinv
 	and xor or
 	/)
diff --git a/gnu/usr.bin/perl/t/lib/Math/BigInt/Scalar.pm b/gnu/usr.bin/perl/t/lib/Math/BigInt/Scalar.pm
index 94fb9b859a6..c20a3e377e3 100644
--- a/gnu/usr.bin/perl/t/lib/Math/BigInt/Scalar.pm
+++ b/gnu/usr.bin/perl/t/lib/Math/BigInt/Scalar.pm
@@ -13,7 +13,7 @@ require Exporter;
 use vars qw/@ISA $VERSION/;
 @ISA = qw(Exporter);
 
-$VERSION = '0.12';
+$VERSION = '0.13';
 
 sub api_version() { 1; }
 
@@ -39,6 +39,11 @@ sub _from_hex
   # not used
   }
 
+sub _from_oct
+  {
+  # not used
+  }
+
 sub _from_bin
   {
   # not used
@@ -157,6 +162,11 @@ sub _as_bin
   sprintf("0b%b",${$_[1]});
   }
 
+sub _as_oct
+  {
+  sprintf("0%o",${$_[1]});
+  }
+
 ##############################################################################
 # actual math code
 
@@ -336,7 +346,7 @@ the same terms as Perl itself.
 
 =head1 AUTHOR
 
-Tels http://bloodgate.com in 2001.
+Tels http://bloodgate.com in 2001 - 2007.
 
 =head1 SEE ALSO
 
diff --git a/gnu/usr.bin/perl/t/lib/Math/BigInt/Subclass.pm b/gnu/usr.bin/perl/t/lib/Math/BigInt/Subclass.pm
index 0cbd15923f8..d45e9e53ade 100644
--- a/gnu/usr.bin/perl/t/lib/Math/BigInt/Subclass.pm
+++ b/gnu/usr.bin/perl/t/lib/Math/BigInt/Subclass.pm
@@ -49,6 +49,11 @@ sub blcm
   Math::BigInt::blcm(@_);
   }
 
+sub as_int
+  {
+  Math::BigInt->new($_[0]);
+  }
+
 BEGIN
   {
   *objectify = \&Math::BigInt::objectify;
diff --git a/gnu/usr.bin/perl/t/lib/common.pl b/gnu/usr.bin/perl/t/lib/common.pl
new file mode 100644
index 00000000000..36d45f3c99a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/common.pl
@@ -0,0 +1,226 @@
+# This code is used by lib/warnings.t and lib/feature.t
+
+BEGIN {
+    require './test.pl';
+}
+
+use Config;
+use File::Path;
+use File::Spec::Functions;
+
+use strict;
+use warnings;
+our $pragma_name;
+
+$| = 1;
+
+my $Is_MacOS = $^O eq 'MacOS';
+my $tmpfile = "tmp0000";
+1 while -e ++$tmpfile;
+END { 1 while unlink $tmpfile }
+
+my @prgs = () ;
+my @w_files = () ;
+
+if (@ARGV)
+  { print "ARGV = [@ARGV]\n" ;
+    if ($Is_MacOS) {
+      @w_files = map { s#^#:lib:$pragma_name:#; $_ } @ARGV
+    } else {
+      @w_files = map { s#^#./lib/$pragma_name/#; $_ } @ARGV
+    }
+  }
+else
+  { @w_files = sort glob(catfile(curdir(), "lib", $pragma_name, "*")) }
+
+my $files = 0;
+foreach my $file (@w_files) {
+
+    next if $file =~ /(~|\.orig|,v)$/;
+    next if $file =~ /perlio$/ && !(find PerlIO::Layer 'perlio');
+    next if -d $file;
+
+    open F, "<$file" or die "Cannot open $file: $!\n" ;
+    my $line = 0;
+    while (<F>) {
+        $line++;
+	last if /^__END__/ ;
+    }
+
+    {
+        local $/ = undef;
+        $files++;
+        @prgs = (@prgs, $file, split "\n########\n", <F>) ;
+    }
+    close F ;
+}
+
+undef $/;
+
+plan tests => (scalar(@prgs)-$files);
+
+for (@prgs){
+    unless (/\n/)
+     {
+      print "# From $_\n";
+      next;
+     }
+    my $switch = "";
+    my @temps = () ;
+    my @temp_path = () ;
+    if (s/^\s*-\w+//){
+        $switch = $&;
+    }
+    my($prog,$expected) = split(/\nEXPECT(?:\n|$)/, $_, 2);
+
+    my ($todo, $todo_reason);
+    $todo = $prog =~ s/^#\s*TODO\s*(.*)\n//m and $todo_reason = $1;
+    # If the TODO reason starts ? then it's taken as a code snippet to evaluate
+    # This provides the flexibility to have conditional TODOs
+    if ($todo_reason && $todo_reason =~ s/^\?//) {
+	my $temp = eval $todo_reason;
+	if ($@) {
+	    die "# In TODO code reason:\n# $todo_reason\n$@";
+	}
+	$todo_reason = $temp;
+    }
+    if ( $prog =~ /--FILE--/) {
+        my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
+	shift @files ;
+	die "Internal error: test $_ didn't split into pairs, got " .
+		scalar(@files) . "[" . join("%%%%", @files) ."]\n"
+	    if @files % 2 ;
+	while (@files > 2) {
+	    my $filename = shift @files ;
+	    my $code = shift @files ;
+    	    push @temps, $filename ;
+    	    if ($filename =~ m#(.*)/#) {
+                mkpath($1);
+                push(@temp_path, $1);
+    	    }
+	    open F, ">$filename" or die "Cannot open $filename: $!\n" ;
+	    print F $code ;
+	    close F or die "Cannot close $filename: $!\n";
+	}
+	shift @files ;
+	$prog = shift @files ;
+    }
+
+    # fix up some paths
+    if ($Is_MacOS) {
+	$prog =~ s|require "./abc(d)?";|require ":abc$1";|g;
+	$prog =~ s|"\."|":"|g;
+    }
+
+    open TEST, ">$tmpfile" or die "Cannot open >$tmpfile: $!";
+    print TEST q{
+        BEGIN {
+            open(STDERR, ">&STDOUT")
+              or die "Can't dup STDOUT->STDERR: $!;";
+        }
+    };
+    print TEST "\n#line 1\n";  # So the line numbers don't get messed up.
+    print TEST $prog,"\n";
+    close TEST or die "Cannot close $tmpfile: $!";
+    my $results = runperl( switches => [$switch], stderr => 1, progfile => $tmpfile );
+    my $status = $?;
+    $results =~ s/\n+$//;
+    # allow expected output to be written as if $prog is on STDIN
+    $results =~ s/tmp\d+/-/g;
+    if ($^O eq 'VMS') {
+        # some tests will trigger VMS messages that won't be expected
+        $results =~ s/\n?%[A-Z]+-[SIWEF]-[A-Z]+,.*//;
+
+        # pipes double these sometimes
+        $results =~ s/\n\n/\n/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;
+    # allow all tests to run when there are leaks
+    $results =~ s/Scalars leaked: \d+\n//g;
+
+    # fix up some paths
+    if ($Is_MacOS) {
+	$results =~ s|:abc\.pm\b|abc.pm|g;
+	$results =~ s|:abc(d)?\b|./abc$1|g;
+    }
+
+    $expected =~ s/\n+$//;
+    my $prefix = ($results =~ s#^PREFIX(\n|$)##) ;
+    # any special options? (OPTIONS foo bar zap)
+    my $option_regex = 0;
+    my $option_random = 0;
+    if ($expected =~ s/^OPTIONS? (.+)\n//) {
+	foreach my $option (split(' ', $1)) {
+	    if ($option eq 'regex') { # allow regular expressions
+		$option_regex = 1;
+	    }
+	    elsif ($option eq 'random') { # all lines match, but in any order
+		$option_random = 1;
+	    }
+	    else {
+		die "$0: Unknown OPTION '$option'\n";
+	    }
+	}
+    }
+    die "$0: can't have OPTION regex and random\n"
+        if $option_regex + $option_random > 1;
+    my $ok = 0;
+    if ($results =~ s/^SKIPPED\n//) {
+	print "$results\n" ;
+	$ok = 1;
+    }
+    elsif ($option_random) {
+        $ok = randomMatch($results, $expected);
+    }
+    elsif ($option_regex) {
+	$ok = $results =~ /^$expected/;
+    }
+    elsif ($prefix) {
+	$ok = $results =~ /^\Q$expected/;
+    }
+    else {
+	$ok = $results eq $expected;
+    }
+ 
+    print_err_line( $switch, $prog, $expected, $results, $todo ) unless $ok;
+
+    our $TODO = $todo ? $todo_reason : 0;
+    ok($ok);
+
+    foreach (@temps)
+	{ unlink $_ if $_ }
+    foreach (@temp_path)
+	{ rmtree $_ if -d $_ }
+}
+
+sub randomMatch
+{
+    my $got = shift ;
+    my $expected = shift;
+
+    my @got = sort split "\n", $got ;
+    my @expected = sort split "\n", $expected ;
+
+   return "@got" eq "@expected";
+
+}
+
+sub print_err_line {
+    my($switch, $prog, $expected, $results, $todo) = @_;
+    my $err_line = "PROG: $switch\n$prog\n" .
+		   "EXPECTED:\n$expected\n" .
+		   "GOT:\n$results\n";
+    if ($todo) {
+	$err_line =~ s/^/# /mg;
+	print $err_line;  # Harness can't filter it out from STDERR.
+    }
+    else {
+	print STDERR $err_line;
+    }
+
+    return 1;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/t/lib/commonsense.t b/gnu/usr.bin/perl/t/lib/commonsense.t
index 6e313073d29..27fd302fb19 100644
--- a/gnu/usr.bin/perl/t/lib/commonsense.t
+++ b/gnu/usr.bin/perl/t/lib/commonsense.t
@@ -3,10 +3,6 @@
 chdir 't' if -d 't';
 @INC = '../lib';
 require Config; import Config;
-if (($Config{'extensions'} !~ /\b(DB|[A-Z]DBM)_File\b/) ){
-  print "Bail out! Perl configured without DB_File or [A-Z]DBM_File\n";
-  exit 0;
-}
 if (($Config{'extensions'} !~ /\bFcntl\b/) ){
   print "Bail out! Perl configured without Fcntl module\n";
   exit 0;
diff --git a/gnu/usr.bin/perl/t/lib/compress/CompTestUtils.pm b/gnu/usr.bin/perl/t/lib/compress/CompTestUtils.pm
new file mode 100644
index 00000000000..1763b0309d8
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/compress/CompTestUtils.pm
@@ -0,0 +1,649 @@
+package CompTestUtils;
+
+package main ;
+
+use strict ;
+use warnings;
+use bytes;
+
+#use lib qw(t t/compress);
+
+use Carp ;
+#use Test::More ; 
+
+
+
+sub title
+{
+    #diag "" ; 
+    ok 1, $_[0] ;
+    #diag "" ;
+}
+
+sub like_eval
+{
+    like $@, @_ ;
+}
+
+{
+    package LexFile ;
+
+    our ($index);
+    $index = '00000';
+    
+    sub new
+    {
+        my $self = shift ;
+        foreach (@_)
+        {
+            # autogenerate the name unless if none supplied
+            $_ = "tst" . $index ++ . ".tmp"
+                unless defined $_;
+        }
+        chmod 0777, @_;
+        for (@_) { 1 while unlink $_ } ;
+        bless [ @_ ], $self ;
+    }
+
+    sub DESTROY
+    {
+        my $self = shift ;
+        chmod 0777, @{ $self } ;
+        for (@$self) { 1 while unlink $_ } ;
+    }
+
+}
+
+{
+    package LexDir ;
+
+    use File::Path;
+    sub new
+    {
+        my $self = shift ;
+        foreach (@_) { rmtree $_ }
+        bless [ @_ ], $self ;
+    }
+
+    sub DESTROY
+    {
+        my $self = shift ;
+        foreach (@$self) { rmtree $_ }
+    }
+}
+sub readFile
+{
+    my $f = shift ;
+
+    my @strings ;
+
+    if (IO::Compress::Base::Common::isaFilehandle($f))
+    {
+        my $pos = tell($f);
+        seek($f, 0,0);
+        @strings = <$f> ;	
+        seek($f, 0, $pos);
+    }
+    else
+    {
+        open (F, "<$f") 
+            or croak "Cannot open $f: $!\n" ;
+        binmode F;
+        @strings = <F> ;	
+        close F ;
+    }
+
+    return @strings if wantarray ;
+    return join "", @strings ;
+}
+
+sub touch
+{
+    foreach (@_) { writeFile($_, '') }
+}
+
+sub writeFile
+{
+    my($filename, @strings) = @_ ;
+    1 while unlink $filename ;
+    open (F, ">$filename") 
+        or croak "Cannot open $filename: $!\n" ;
+    binmode F;
+    foreach (@strings) {
+        no warnings ;
+        print F $_ ;
+    }
+    close F ;
+}
+
+sub GZreadFile
+{
+    my ($filename) = shift ;
+
+    my ($uncomp) = "" ;
+    my $line = "" ;
+    my $fil = gzopen($filename, "rb") 
+        or croak "Cannopt open '$filename': $Compress::Zlib::gzerrno" ;
+
+    $uncomp .= $line 
+        while $fil->gzread($line) > 0;
+
+    $fil->gzclose ;
+    return $uncomp ;
+}
+
+sub hexDump
+{
+    my $d = shift ;
+
+    if (IO::Compress::Base::Common::isaFilehandle($d))
+    {
+        $d = readFile($d);
+    }
+    elsif (IO::Compress::Base::Common::isaFilename($d))
+    {
+        $d = readFile($d);
+    }
+    else
+    {
+        $d = $$d ;
+    }
+
+    my $offset = 0 ;
+
+    $d = '' unless defined $d ;
+    #while (read(STDIN, $data, 16)) {
+    while (my $data = substr($d, 0, 16)) {
+        substr($d, 0, 16) = '' ;
+        printf "# %8.8lx    ", $offset;
+        $offset += 16;
+
+        my @array = unpack('C*', $data);
+        foreach (@array) {
+            printf('%2.2x ', $_);
+        }
+        print "   " x (16 - @array)
+            if @array < 16 ;
+        $data =~ tr/\0-\37\177-\377/./;
+        print "  $data\n";
+    }
+
+}
+
+sub readHeaderInfo
+{
+    my $name = shift ;
+    my %opts = @_ ;
+
+    my $string = <<EOM;
+some text
+EOM
+
+    ok my $x = new IO::Compress::Gzip $name, %opts 
+        or diag "GzipError is $IO::Compress::Gzip::GzipError" ;
+    ok $x->write($string) ;
+    ok $x->close ;
+
+    #is GZreadFile($name), $string ;
+
+    ok my $gunz = new IO::Uncompress::Gunzip $name, Strict => 0
+        or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ;
+    ok my $hdr = $gunz->getHeaderInfo();
+    my $uncomp ;
+    ok $gunz->read($uncomp) ;
+    ok $uncomp eq $string;
+    ok $gunz->close ;
+
+    return $hdr ;
+}
+
+sub cmpFile
+{
+    my ($filename, $uue) = @_ ;
+    return readFile($filename) eq unpack("u", $uue) ;
+}
+
+sub uncompressBuffer
+{
+    my $compWith = shift ;
+    my $buffer = shift ;
+
+    my %mapping = ( 'IO::Compress::Gzip'                     => 'IO::Uncompress::Gunzip',
+                    'IO::Compress::Gzip::gzip'               => 'IO::Uncompress::Gunzip',
+                    'IO::Compress::Deflate'                  => 'IO::Uncompress::Inflate',
+                    'IO::Compress::Deflate::deflate'         => 'IO::Uncompress::Inflate',
+                    'IO::Compress::RawDeflate'               => 'IO::Uncompress::RawInflate',
+                    'IO::Compress::RawDeflate::rawdeflate'   => 'IO::Uncompress::RawInflate',
+                    'IO::Compress::Bzip2'                    => 'IO::Uncompress::Bunzip2',
+                    'IO::Compress::Bzip2::bzip2'             => 'IO::Uncompress::Bunzip2',
+                    'IO::Compress::Zip'                      => 'IO::Uncompress::Unzip',
+                    'IO::Compress::Zip::zip'                 => 'IO::Uncompress::Unzip',
+                    'IO::Compress::Lzop'                     => 'IO::Uncompress::UnLzop',
+                    'IO::Compress::Lzop::lzop'               => 'IO::Uncompress::UnLzop',
+                    'IO::Compress::Lzf'                      => 'IO::Uncompress::UnLzf' ,
+                    'IO::Compress::Lzf::lzf'                 => 'IO::Uncompress::UnLzf',
+                    'IO::Compress::DummyComp'                => 'IO::Uncompress::DummyUncomp',
+                    'IO::Compress::DummyComp::dummycomp'     => 'IO::Uncompress::DummyUncomp',
+                );
+
+    my $out ;
+    my $obj = $mapping{$compWith}->new( \$buffer, -Append => 1);
+    1 while $obj->read($out) > 0 ;
+    return $out ;
+
+}
+
+my %ErrorMap = (    'IO::Compress::Gzip'                => \$IO::Compress::Gzip::GzipError,
+                    'IO::Compress::Gzip::gzip'          => \$IO::Compress::Gzip::GzipError,
+                    'IO::Uncompress::Gunzip'            => \$IO::Uncompress::Gunzip::GunzipError,
+                    'IO::Uncompress::Gunzip::gunzip'    => \$IO::Uncompress::Gunzip::GunzipError,
+                    'IO::Uncompress::Inflate'           => \$IO::Uncompress::Inflate::InflateError,
+                    'IO::Uncompress::Inflate::inflate'  => \$IO::Uncompress::Inflate::InflateError,
+                    'IO::Compress::Deflate'             => \$IO::Compress::Deflate::DeflateError,
+                    'IO::Compress::Deflate::deflate'    => \$IO::Compress::Deflate::DeflateError,
+                    'IO::Uncompress::RawInflate'        => \$IO::Uncompress::RawInflate::RawInflateError,
+                    'IO::Uncompress::RawInflate::rawinflate'  => \$IO::Uncompress::RawInflate::RawInflateError,
+                    'IO::Uncompress::AnyInflate'        => \$IO::Uncompress::AnyInflate::AnyInflateError,
+                    'IO::Uncompress::AnyInflate::anyinflate'  => \$IO::Uncompress::AnyInflate::AnyInflateError,
+                    'IO::Uncompress::AnyUncompress'        => \$IO::Uncompress::AnyUncompress::AnyUncompressError,
+                    'IO::Uncompress::AnyUncompress::anyUncompress'  => \$IO::Uncompress::AnyUncompress::AnyUncompressError,
+                    'IO::Compress::RawDeflate'          => \$IO::Compress::RawDeflate::RawDeflateError,
+                    'IO::Compress::RawDeflate::rawdeflate'  => \$IO::Compress::RawDeflate::RawDeflateError,
+                    'IO::Compress::Bzip2'               => \$IO::Compress::Bzip2::Bzip2Error,
+                    'IO::Compress::Bzip2::bzip2'        => \$IO::Compress::Bzip2::Bzip2Error,
+                    'IO::Uncompress::Bunzip2'           => \$IO::Uncompress::Bunzip2::Bunzip2Error,
+                    'IO::Uncompress::Bunzip2::bunzip2'  => \$IO::Uncompress::Bunzip2::Bunzip2Error,
+                    'IO::Compress::Zip'                 => \$IO::Compress::Zip::ZipError,
+                    'IO::Compress::Zip::zip'            => \$IO::Compress::Zip::ZipError,
+                    'IO::Uncompress::Unzip'             => \$IO::Uncompress::Unzip::UnzipError,
+                    'IO::Uncompress::Unzip::unzip'      => \$IO::Uncompress::Unzip::UnzipError,
+                    'IO::Compress::Lzop'                => \$IO::Compress::Lzop::LzopError,
+                    'IO::Compress::Lzop::lzop'          => \$IO::Compress::Lzop::LzopError,
+                    'IO::Uncompress::UnLzop'            => \$IO::Uncompress::UnLzop::UnLzopError,
+                    'IO::Uncompress::UnLzop::unlzop'    => \$IO::Uncompress::UnLzop::UnLzopError,
+                    'IO::Compress::Lzf'                 => \$IO::Compress::Lzf::LzfError,
+                    'IO::Compress::Lzf::lzf'            => \$IO::Compress::Lzf::LzfError,
+                    'IO::Uncompress::UnLzf'             => \$IO::Uncompress::UnLzf::UnLzfError,
+                    'IO::Uncompress::UnLzf::unlzf'      => \$IO::Uncompress::UnLzf::UnLzfError,
+
+                    'IO::Compress::DummyComp'           => \$IO::Compress::DummyComp::DummyCompError,
+                    'IO::Compress::DummyComp::dummycomp'=> \$IO::Compress::DummyComp::DummyCompError,
+                    'IO::Uncompress::DummyUncomp'       => \$IO::Uncompress::DummyUncomp::DummyUncompError,
+                    'IO::Uncompress::DummyUncomp::dummyuncomp' => \$IO::Uncompress::DummyUncomp::DummyUncompError,
+               );
+
+my %TopFuncMap = (  'IO::Compress::Gzip'          => 'IO::Compress::Gzip::gzip',
+                    'IO::Uncompress::Gunzip'      => 'IO::Uncompress::Gunzip::gunzip',
+
+                    'IO::Compress::Deflate'       => 'IO::Compress::Deflate::deflate',
+                    'IO::Uncompress::Inflate'     => 'IO::Uncompress::Inflate::inflate',
+
+                    'IO::Compress::RawDeflate'    => 'IO::Compress::RawDeflate::rawdeflate',
+                    'IO::Uncompress::RawInflate'  => 'IO::Uncompress::RawInflate::rawinflate',
+
+                    'IO::Uncompress::AnyInflate'  => 'IO::Uncompress::AnyInflate::anyinflate',
+                    'IO::Uncompress::AnyUncompress'  => 'IO::Uncompress::AnyUncompress::anyuncompress',
+
+                    'IO::Compress::Bzip2'         => 'IO::Compress::Bzip2::bzip2',
+                    'IO::Uncompress::Bunzip2'     => 'IO::Uncompress::Bunzip2::bunzip2',
+
+                    'IO::Compress::Zip'           => 'IO::Compress::Zip::zip',
+                    'IO::Uncompress::Unzip'       => 'IO::Uncompress::Unzip::unzip',
+                    'IO::Compress::Lzop'          => 'IO::Compress::Lzop::lzop',
+                    'IO::Uncompress::UnLzop'      => 'IO::Uncompress::UnLzop::unlzop',
+                    'IO::Compress::Lzf'           => 'IO::Compress::Lzf::lzf',
+                    'IO::Uncompress::UnLzf'       => 'IO::Uncompress::UnLzf::unlzf',
+                    'IO::Compress::DummyComp'     => 'IO::Compress::DummyComp::dummyuncomp',
+                    'IO::Uncompress::DummyUncomp' => 'IO::Uncompress::DummyUncomp::dummyuncomp',
+                 );
+
+   %TopFuncMap = map { ($_              => $TopFuncMap{$_}, 
+                        $TopFuncMap{$_} => $TopFuncMap{$_}) } 
+                 keys %TopFuncMap ;
+
+ #%TopFuncMap = map { ($_              => \&{ $TopFuncMap{$_} ) } 
+                 #keys %TopFuncMap ;
+
+
+my %inverse  = ( 'IO::Compress::Gzip'                    => 'IO::Uncompress::Gunzip',
+                 'IO::Compress::Gzip::gzip'              => 'IO::Uncompress::Gunzip::gunzip',
+                 'IO::Compress::Deflate'                 => 'IO::Uncompress::Inflate',
+                 'IO::Compress::Deflate::deflate'        => 'IO::Uncompress::Inflate::inflate',
+                 'IO::Compress::RawDeflate'              => 'IO::Uncompress::RawInflate',
+                 'IO::Compress::RawDeflate::rawdeflate'  => 'IO::Uncompress::RawInflate::rawinflate',
+                 'IO::Compress::Bzip2::bzip2'            => 'IO::Uncompress::Bunzip2::bunzip2',
+                 'IO::Compress::Bzip2'                   => 'IO::Uncompress::Bunzip2',
+                 'IO::Compress::Zip::zip'                => 'IO::Uncompress::Unzip::unzip',
+                 'IO::Compress::Zip'                     => 'IO::Uncompress::Unzip',
+                 'IO::Compress::Lzop::lzop'              => 'IO::Uncompress::UnLzop::unlzop',
+                 'IO::Compress::Lzop'                    => 'IO::Uncompress::UnLzop',
+                 'IO::Compress::Lzf::lzf'                => 'IO::Uncompress::UnLzf::unlzf',
+                 'IO::Compress::Lzf'                     => 'IO::Uncompress::UnLzf',
+                 'IO::Compress::DummyComp::dummycomp'    => 'IO::Uncompress::DummyUncomp::dummyuncomp',
+                 'IO::Compress::DummyComp'               => 'IO::Uncompress::DummyUncomp',
+             );
+
+%inverse  = map { ($_ => $inverse{$_}, $inverse{$_} => $_) } keys %inverse;
+
+sub getInverse
+{
+    my $class = shift ;
+
+    return $inverse{$class} ;
+}
+
+sub getErrorRef
+{
+    my $class = shift ;
+
+    return $ErrorMap{$class} ;
+}
+
+sub getTopFuncRef
+{
+    my $class = shift ;
+
+    return \&{ $TopFuncMap{$class} } ;
+}
+
+sub getTopFuncName
+{
+    my $class = shift ;
+
+    return $TopFuncMap{$class}  ;
+}
+
+sub compressBuffer
+{
+    my $compWith = shift ;
+    my $buffer = shift ;
+
+    my %mapping = ( 'IO::Uncompress::Gunzip'                  => 'IO::Compress::Gzip',
+                    'IO::Uncompress::Gunzip::gunzip'          => 'IO::Compress::Gzip',
+                    'IO::Uncompress::Inflate'                 => 'IO::Compress::Deflate',
+                    'IO::Uncompress::Inflate::inflate'        => 'IO::Compress::Deflate',
+                    'IO::Uncompress::RawInflate'              => 'IO::Compress::RawDeflate',
+                    'IO::Uncompress::RawInflate::rawinflate'  => 'IO::Compress::RawDeflate',
+                    'IO::Uncompress::Bunzip2'                 => 'IO::Compress::Bzip2',
+                    'IO::Uncompress::Bunzip2::bunzip2'        => 'IO::Compress::Bzip2',
+                    'IO::Uncompress::Unzip'                   => 'IO::Compress::Zip',
+                    'IO::Uncompress::Unzip::unzip'            => 'IO::Compress::Zip',
+                    'IO::Uncompress::UnLzop'                  => 'IO::Compress::Lzop',
+                    'IO::Uncompress::UnLzop::unlzop'          => 'IO::Compress::Lzop',
+                    'IO::Uncompress::UnLzp'                   => 'IO::Compress::Lzf',
+                    'IO::Uncompress::UnLzf::unlzf'            => 'IO::Compress::Lzf',
+                    'IO::Uncompress::AnyInflate'              => 'IO::Compress::Gzip',
+                    'IO::Uncompress::AnyInflate::anyinflate'  => 'IO::Compress::Gzip',
+                    'IO::Uncompress::AnyUncompress'           => 'IO::Compress::Gzip',
+                    'IO::Uncompress::AnyUncompress::anyuncompress'  => 'IO::Compress::Gzip',
+                    'IO::Uncompress::DummyUncomp'             => 'IO::Compress::DummyComp',
+                    'IO::Uncompress::DummyUncomp::dummyuncomp'=> 'IO::Compress::DummyComp',
+                );
+
+    my $out ;
+    my $obj = $mapping{$compWith}->new( \$out);
+    $obj->write($buffer) ;
+    $obj->close();
+    return $out ;
+}
+
+our ($AnyUncompressError);
+BEGIN
+{
+    eval ' use IO::Uncompress::AnyUncompress qw($AnyUncompressError); ';
+}
+
+sub anyUncompress
+{
+    my $buffer = shift ;
+    my $already = shift;
+
+    my @opts = ();
+    if (ref $buffer && ref $buffer eq 'ARRAY')
+    {
+        @opts = @$buffer;
+        $buffer = shift @opts;
+    }
+
+    if (ref $buffer)
+    {
+        croak "buffer is undef" unless defined $$buffer;
+        croak "buffer is empty" unless length $$buffer;
+
+    }
+
+
+    my $data ;
+    if (IO::Compress::Base::Common::isaFilehandle($buffer))
+    {
+        $data = readFile($buffer);
+    }
+    elsif (IO::Compress::Base::Common::isaFilename($buffer))
+    {
+        $data = readFile($buffer);
+    }
+    else
+    {
+        $data = $$buffer ;
+    }
+
+    if (defined $already && length $already)
+    {
+
+        my $got = substr($data, 0, length($already));
+        substr($data, 0, length($already)) = '';
+
+        is $got, $already, '  Already OK' ;
+    }
+
+    my $out = '';
+    my $o = new IO::Uncompress::AnyUncompress \$data, 
+                    Append => 1, 
+                    Transparent => 0, 
+                    RawInflate => 1,
+                    @opts
+        or croak "Cannot open buffer/file: $AnyUncompressError" ;
+
+    1 while $o->read($out) > 0 ;
+
+    croak "Error uncompressing -- " . $o->error()
+        if $o->error() ;
+
+    return $out ;
+
+}
+
+sub getHeaders
+{
+    my $buffer = shift ;
+    my $already = shift;
+
+    my @opts = ();
+    if (ref $buffer && ref $buffer eq 'ARRAY')
+    {
+        @opts = @$buffer;
+        $buffer = shift @opts;
+    }
+
+    if (ref $buffer)
+    {
+        croak "buffer is undef" unless defined $$buffer;
+        croak "buffer is empty" unless length $$buffer;
+
+    }
+
+
+    my $data ;
+    if (IO::Compress::Base::Common::isaFilehandle($buffer))
+    {
+        $data = readFile($buffer);
+    }
+    elsif (IO::Compress::Base::Common::isaFilename($buffer))
+    {
+        $data = readFile($buffer);
+    }
+    else
+    {
+        $data = $$buffer ;
+    }
+
+    if (defined $already && length $already)
+    {
+
+        my $got = substr($data, 0, length($already));
+        substr($data, 0, length($already)) = '';
+
+        is $got, $already, '  Already OK' ;
+    }
+
+    my $out = '';
+    my $o = new IO::Uncompress::AnyUncompress \$data, 
+                MultiStream => 1, 
+                Append => 1, 
+                Transparent => 0, 
+                RawInflate => 1,
+                @opts
+        or croak "Cannot open buffer/file: $AnyUncompressError" ;
+
+    1 while $o->read($out) > 0 ;
+
+    croak "Error uncompressing -- " . $o->error()
+        if $o->error() ;
+
+    return ($o->getHeaderInfo()) ;
+
+}
+
+sub mkComplete
+{
+    my $class = shift ;
+    my $data = shift;
+    my $Error = getErrorRef($class);
+
+    my $buffer ;
+    my %params = ();
+
+    if ($class eq 'IO::Compress::Gzip') {
+        %params = (
+            Name       => "My name",
+            Comment    => "a comment",
+            ExtraField => ['ab' => "extra"],
+            HeaderCRC  => 1);
+    }
+    elsif ($class eq 'IO::Compress::Zip'){
+        %params = (
+            Name              => "My name",
+            Comment           => "a comment",
+            ZipComment        => "last comment",
+            exTime            => [100, 200, 300],
+            ExtraFieldLocal   => ["ab" => "extra1"],
+            ExtraFieldCentral => ["cd" => "extra2"],
+        );
+    }
+
+    my $z = new $class( \$buffer, %params)
+        or croak "Cannot create $class object: $$Error";
+    $z->write($data);
+    $z->close();
+
+    my $unc = getInverse($class);
+    anyUncompress(\$buffer) eq $data
+        or die "bad bad bad";
+    my $u = new $unc( \$buffer);
+    my $info = $u->getHeaderInfo() ;
+
+
+    return wantarray ? ($info, $buffer) : $buffer ;
+}
+
+sub mkErr
+{
+    my $string = shift ;
+    my ($dummy, $file, $line) = caller ;
+    -- $line ;
+
+    $file = quotemeta($file);
+
+    return "/$string\\s+at $file line $line/" if $] >= 5.006 ;
+    return "/$string\\s+at /" ;
+}
+
+sub mkEvalErr
+{
+    my $string = shift ;
+
+    return "/$string\\s+at \\(eval /" if $] > 5.006 ;
+    return "/$string\\s+at /" ;
+}
+
+sub dumpObj
+{
+    my $obj = shift ;
+
+    my ($dummy, $file, $line) = caller ;
+
+    if (@_)
+    {
+        print "#\n# dumpOBJ from $file line $line @_\n" ;
+    }
+    else
+    {
+        print "#\n# dumpOBJ from $file line $line \n" ;
+    }
+
+    my $max = 0 ;;
+    foreach my $k (keys %{ *$obj })
+    {
+        $max = length $k if length $k > $max ;
+    }
+
+    foreach my $k (sort keys %{ *$obj })
+    {
+        my $v = $obj->{$k} ;
+        $v = '-undef-' unless defined $v;
+        my $pad = ' ' x ($max - length($k) + 2) ;
+        print "# $k$pad: [$v]\n";
+    }
+    print "#\n" ;
+}
+
+
+sub getMultiValues
+{
+    my $class = shift ;
+
+    return (0,0) if $class =~ /lzf/i;
+    return (1,0);
+}
+
+
+sub gotScalarUtilXS
+{
+    eval ' use Scalar::Util "dualvar" ';
+    return $@ ? 0 : 1 ;
+}
+
+package CompTestUtils;
+
+1;
+__END__
+	t/Test/Builder.pm
+	t/Test/More.pm
+	t/Test/Simple.pm
+	t/compress/CompTestUtils.pm
+	t/compress/any.pl
+	t/compress/anyunc.pl
+	t/compress/destroy.pl
+	t/compress/generic.pl
+	t/compress/merge.pl
+	t/compress/multi.pl
+	t/compress/newtied.pl
+	t/compress/oneshot.pl
+	t/compress/prime.pl
+	t/compress/tied.pl
+	t/compress/truncate.pl
+	t/compress/zlib-generic.plParsing config.in...
+Building Zlib enabled
+Auto Detect Gzip OS Code..
+Setting Gzip OS Code to 3 [Unix/Default]
+Looks Good.
diff --git a/gnu/usr.bin/perl/t/lib/compress/any.pl b/gnu/usr.bin/perl/t/lib/compress/any.pl
new file mode 100644
index 00000000000..d95766b0a9a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/compress/any.pl
@@ -0,0 +1,98 @@
+
+use lib 't';
+ 
+use strict;
+use warnings;
+use bytes;
+
+use Test::More ;
+use CompTestUtils;
+
+BEGIN {
+    # use Test::NoWarnings, if available
+    my $extra = 0 ;
+    $extra = 1
+        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
+
+    plan tests => 48 + $extra ;
+
+}
+
+sub run
+{
+    my $CompressClass   = identify();
+    my $AnyClass        = getClass();
+    my $UncompressClass = getInverse($CompressClass);
+    my $Error           = getErrorRef($CompressClass);
+    my $UnError         = getErrorRef($UncompressClass);
+
+    my $AnyConstruct = "IO::Uncompress::${AnyClass}" ;
+    no strict 'refs';
+    my $AnyError = \${ "IO::Uncompress::${AnyClass}::${AnyClass}Error" };
+
+    for my $trans ( 0, 1 )
+    {
+        for my $file ( 0, 1 )
+        {
+            title "$AnyClass(Transparent => $trans, File=>$file) with $CompressClass" ;
+            my $string = "some text" x 100 ;
+
+            my $buffer ;
+            my $x = new $CompressClass(\$buffer) ;
+            ok $x, "  create $CompressClass object" ;
+            ok $x->write($string), "  write to object" ;
+            ok $x->close, "  close ok" ;
+
+            my $lex = new LexFile my $output;
+            my $input ;
+
+            if ($file) {
+                writeFile($output, $buffer);
+                $input = $output;
+            }
+            else {
+                $input = \$buffer;
+            }
+
+            {
+                my $unc = new $AnyConstruct $input, Transparent => $trans,
+                                           RawInflate => 1,
+                                           Append => 1  ;
+
+                ok $unc, "  Created $AnyClass object" 
+                    or print "# $$AnyError\n";
+                my $uncomp ;
+                1 while  $unc->read($uncomp) > 0 ;
+                #ok $unc->read($uncomp) > 0 
+                #    or print "# $$AnyError\n";
+                my $y;
+                is $unc->read($y, 1), 0, "  at eof" ;
+                ok $unc->eof(), "  at eof" ;
+                #ok $unc->type eq $Type;
+
+                is $uncomp, $string, "  expected output" ;
+            }
+
+            {
+                my $unc = new $AnyConstruct $input, Transparent => $trans,
+                                           RawInflate => 1,
+                                           Append => 1  ;
+
+                ok $unc, "  Created $AnyClass object" 
+                    or print "# $$AnyError\n";
+                my $uncomp ;
+                1 while  $unc->read($uncomp, 100) > 0 ;
+                #ok $unc->read($uncomp) > 0 
+                #    or print "# $$AnyError\n";
+                my $y;
+                is $unc->read($y, 1), 0, "  at eof" ;
+                ok $unc->eof(), "  at eof" ;
+                #ok $unc->type eq $Type;
+
+                is $uncomp, $string, "  expected output" ;
+            }
+        }
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/t/lib/compress/anyunc.pl b/gnu/usr.bin/perl/t/lib/compress/anyunc.pl
new file mode 100644
index 00000000000..2860e2571c7
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/compress/anyunc.pl
@@ -0,0 +1,93 @@
+
+use lib 't';
+ 
+use strict;
+use warnings;
+use bytes;
+
+use Test::More ;
+use CompTestUtils;
+
+BEGIN {
+    # use Test::NoWarnings, if available
+    my $extra = 0 ;
+    $extra = 1
+        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
+
+    plan tests => 36 + $extra ;
+}
+
+sub run
+{
+    my $CompressClass   = identify();
+    my $AnyClass        = getClass();
+    my $UncompressClass = getInverse($CompressClass);
+    my $Error           = getErrorRef($CompressClass);
+    my $UnError         = getErrorRef($UncompressClass);
+
+    my $AnyConstruct = "IO::Uncompress::${AnyClass}" ;
+    no strict refs;
+    my $AnyError = \${ "IO::Uncompress::${AnyClass}::${AnyClass}Error" };
+
+    for my $trans ( 0, 1 )
+    {
+        for my $file ( 0, 1 )
+        {
+            title "$AnyClass(Transparent => $trans, File=>$file) with $CompressClass" ;
+            my $string = "some text" x 100 ;
+
+            my $buffer ;
+            my $x = new $CompressClass(\$buffer) ;
+            ok $x, "  create $CompressClass object" ;
+            ok $x->write($string), "  write to object" ;
+            ok $x->close, "  close ok" ;
+
+            my $lex = new LexFile my $output;
+            my $input ;
+
+            if ($file) {
+                writeFile($output, $buffer);
+                $input = $output;
+            }
+            else {
+                $input = \$buffer;
+            }
+
+            {
+                my $unc = new $AnyConstruct $input, Transparent => $trans
+                                                    Append => 1  ;
+
+                ok $unc, "  Created $AnyClass object" 
+                    or print "# $$AnyError\n";
+                my $uncomp ;
+                1 while $unc->read($uncomp) > 0 ;
+                #ok $unc->read($uncomp) > 0 
+                #    or print "# $$AnyError\n";
+                my $y;
+                is $unc->read($y, 1), 0, "  at eof" ;
+                ok $unc->eof(), "  at eof" ;
+                #ok $unc->type eq $Type;
+
+                is $uncomp, $string, "  expected output" ;
+            }
+
+            {
+                my $unc = new $AnyConstruct $input, Transparent => $trans,
+                                                     Append =>1  ;
+
+                ok $unc, "  Created $AnyClass object" 
+                    or print "# $$AnyError\n";
+                my $uncomp ;
+                1 while $unc->read($uncomp, 10) > 0 ;
+                my $y;
+                is $unc->read($y, 1), 0, "  at eof" ;
+                ok $unc->eof(), "  at eof" ;
+                #ok $unc->type eq $Type;
+
+                is $uncomp, $string, "  expected output" ;
+            }
+        }
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/t/lib/compress/destroy.pl b/gnu/usr.bin/perl/t/lib/compress/destroy.pl
new file mode 100644
index 00000000000..9107b15096a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/compress/destroy.pl
@@ -0,0 +1,78 @@
+
+use lib 't';
+use strict;
+use warnings;
+use bytes;
+
+use Test::More ;
+use CompTestUtils;
+
+BEGIN
+{
+    plan(skip_all => "Destroy not supported in Perl $]")
+        if $] == 5.008 || ( $] >= 5.005 && $] < 5.006) ;
+
+    # use Test::NoWarnings, if available
+    my $extra = 0 ;
+    $extra = 1
+        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
+
+    plan tests => 7 + $extra ;
+
+    use_ok('IO::File') ;
+}
+
+sub run
+{
+
+    my $CompressClass   = identify();
+    my $UncompressClass = getInverse($CompressClass);
+    my $Error           = getErrorRef($CompressClass);
+    my $UnError         = getErrorRef($UncompressClass);
+
+    title "Testing $CompressClass";
+
+    {
+        # Check that the class destructor will call close
+
+        my $lex = new LexFile my $name ;
+
+        my $hello = <<EOM ;
+hello world
+this is a test
+EOM
+
+
+        {
+          ok my $x = new $CompressClass $name, -AutoClose => 1  ;
+
+          ok $x->write($hello) ;
+        }
+
+        is anyUncompress($name), $hello ;
+    }
+
+    {
+        # Tied filehandle destructor
+
+
+        my $lex = new LexFile my $name ;
+
+        my $hello = <<EOM ;
+hello world
+this is a test
+EOM
+
+        my $fh = new IO::File "> $name" ;
+
+        {
+          ok my $x = new $CompressClass $fh, -AutoClose => 1  ;
+
+          $x->write($hello) ;
+        }
+
+        ok anyUncompress($name) eq $hello ;
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/t/lib/compress/encode.pl b/gnu/usr.bin/perl/t/lib/compress/encode.pl
new file mode 100644
index 00000000000..142bd08e596
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/compress/encode.pl
@@ -0,0 +1,123 @@
+
+use strict;
+use warnings;
+use bytes;
+
+use Test::More ;
+use CompTestUtils;
+
+BEGIN 
+{ 
+    plan skip_all => "Encode is not available"
+        if $] < 5.006 ;
+
+    eval { require Encode; Encode->import(); };
+
+    plan skip_all => "Encode is not available"
+        if $@ ;
+    
+    # use Test::NoWarnings, if available
+    my $extra = 0 ;
+
+    my $st = eval { require Test::NoWarnings ;  import Test::NoWarnings; 1; };
+    $extra = 1
+        if $st ;
+
+    plan(tests => 7 + $extra) ;
+}
+
+sub run
+{
+    my $CompressClass   = identify();
+    my $UncompressClass = getInverse($CompressClass);
+    my $Error           = getErrorRef($CompressClass);
+    my $UnError         = getErrorRef($UncompressClass);
+
+
+    my $string = "\x{df}\x{100}"; 
+    my $encString = Encode::encode_utf8($string);
+    my $buffer = $encString;
+
+    #for my $from ( qw(filename filehandle buffer) )
+    {
+#        my $input ;
+#        my $lex = new LexFile my $name ;
+#
+#        
+#        if ($from eq 'buffer')
+#          { $input = \$buffer }
+#        elsif ($from eq 'filename')
+#        {
+#            $input = $name ;
+#            writeFile($name, $buffer);
+#        }
+#        elsif ($from eq 'filehandle')
+#        {
+#            $input = new IO::File "<$name" ;
+#        }
+
+        for my $to ( qw(filehandle buffer))
+        {
+            title "OO Mode: To $to, Encode by hand";
+
+            my $lex2 = new LexFile my $name2 ;
+            my $output;
+            my $buffer;
+
+            if ($to eq 'buffer')
+              { $output = \$buffer }
+            elsif ($to eq 'filename')
+            {
+                $output = $name2 ;
+            }
+            elsif ($to eq 'filehandle')
+            {
+                $output = new IO::File ">$name2" ;
+            }
+
+
+            my $out ;
+            my $cs = new $CompressClass($output, AutoClose =>1);
+            $cs->print($encString);
+            $cs->close();
+
+            my $input;
+            if ($to eq 'buffer')
+              { $input = \$buffer }
+            else 
+            {
+                $input = $name2 ;
+            }
+
+            my $ucs = new $UncompressClass($input, Append => 1);
+            my $got;
+            1 while $ucs->read($got) > 0 ;
+            my $decode = Encode::decode_utf8($got);
+
+
+            is $string, $decode, "  Expected output";
+
+
+        }
+    }
+
+    {
+        title "Catch wide characters";
+
+        my $out;
+        my $cs = new $CompressClass(\$out);
+        my $a = "a\xFF\x{100}";
+        eval { $cs->syswrite($a) };
+        like($@, qr/Wide character in ${CompressClass}::write/, 
+                 "  wide characters in ${CompressClass}::write");
+        eval { syswrite($cs, $a) };
+        like($@, qr/Wide character in ${CompressClass}::write/, 
+                 "  wide characters in ${CompressClass}::write");
+    }
+
+}
+
+
+ 
+1;
+
diff --git a/gnu/usr.bin/perl/t/lib/compress/generic.pl b/gnu/usr.bin/perl/t/lib/compress/generic.pl
new file mode 100644
index 00000000000..51b45fc74ba
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/compress/generic.pl
@@ -0,0 +1,1604 @@
+
+use strict;
+use warnings;
+use bytes;
+
+use Test::More ;
+use CompTestUtils;
+
+use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
+
+our ($UncompressClass);
+BEGIN 
+{ 
+    # use Test::NoWarnings, if available
+    my $extra = 0 ;
+
+    my $st = eval { require Test::NoWarnings ;  import Test::NoWarnings; 1; };
+    $extra = 1
+        if $st ;
+
+    plan(tests => 670 + $extra) ;
+}
+
+sub myGZreadFile
+{
+    my $filename = shift ;
+    my $init = shift ;
+
+
+    my $fil = new $UncompressClass $filename,
+                                    -Strict   => 0,
+                                    -Append   => 1
+                                    ;
+
+    my $data = '';
+    $data = $init if defined $init ;
+    1 while $fil->read($data) > 0;
+
+    $fil->close ;
+    return $data ;
+}
+
+sub run
+{
+    my $CompressClass   = identify();
+    $UncompressClass = getInverse($CompressClass);
+    my $Error           = getErrorRef($CompressClass);
+    my $UnError         = getErrorRef($UncompressClass);
+
+    {
+
+        title "Testing $CompressClass Errors";
+
+        # Buffer not writable
+        eval qq[\$a = new $CompressClass(\\1) ;] ;
+        like $@, mkEvalErr("^$CompressClass: output buffer is read-only") ;
+            
+        my($out, $gz);
+        $out = "" ;
+        eval qq[\$a = new $CompressClass ] . '$out ;' ;
+        like $@, mkEvalErr("^$CompressClass: output filename is undef or null string");
+            
+        $out = undef ;
+        eval qq[\$a = new $CompressClass \$out ;] ;
+        like $@, mkEvalErr("^$CompressClass: output filename is undef or null string");
+            
+        my $x ;
+        $gz = new $CompressClass(\$x); 
+
+        foreach my $name (qw(read readline getc))
+        {
+            eval " \$gz->$name() " ;
+            like $@, mkEvalErr("^$name Not Available: File opened only for output");
+        }
+
+        eval ' $gz->write({})' ;
+        like $@, mkEvalErr("^${CompressClass}::write: not a scalar reference");
+        #like $@, mkEvalErr("^${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref");
+
+        eval ' $gz->syswrite("abc", 1, 5)' ;
+        like $@, mkEvalErr("^${CompressClass}::write: offset outside string");
+
+        eval ' $gz->syswrite("abc", 1, -4)' ;
+        like $@, mkEvalErr("^${CompressClass}::write: offset outside string");
+    }
+
+
+    {
+        title "Testing $UncompressClass Errors";
+
+        my $out = "" ;
+        eval qq[\$a = new $UncompressClass \$out ;] ;
+        like $@, mkEvalErr("^$UncompressClass: input filename is undef or null string");
+        $out = undef ;
+        eval qq[\$a = new $UncompressClass \$out ;] ;
+        like $@, mkEvalErr("^$UncompressClass: input filename is undef or null string");
+
+        my $lex = new LexFile my $name ;
+
+        ok ! -e $name, "  $name does not exist";
+        
+        eval qq[\$a = new $UncompressClass "$name" ;] ;
+        is $$UnError, "input file '$name' does not exist";
+
+        my $gc ;
+        my $guz = new $CompressClass(\$gc); 
+        $guz->write("abc") ;
+        $guz->close();
+
+        my $x ;
+        my $gz = new $UncompressClass(\$gc); 
+
+        foreach my $name (qw(print printf write))
+        {
+            eval " \$gz->$name() " ;
+            like $@, mkEvalErr("^$name Not Available: File opened only for intput");
+        }
+
+    }
+
+    {
+        title "Testing $CompressClass and $UncompressClass";
+
+        {
+            my ($a, $x, @x) = ("","","") ;
+
+            # Buffer not a scalar reference
+            eval qq[\$a = new $CompressClass \\\@x ;] ;
+            like $@, mkEvalErr("^$CompressClass: output parameter not a filename, filehandle or scalar ref");
+                
+            # Buffer not a scalar reference
+            eval qq[\$a = new $UncompressClass \\\@x ;] ;
+            like $@, mkEvalErr("^$UncompressClass: input parameter not a filename, filehandle, array ref or scalar ref");
+        }
+            
+        foreach my $Type ( $CompressClass, $UncompressClass)
+        {
+            # Check error handling with IO::Compress::Deflate and IO::Uncompress::Inflate
+
+            my ($a, $x, @x) = ("","","") ;
+
+            # Odd number of parameters
+            eval qq[\$a = new $Type "abc", -Output ] ;
+            like $@, mkEvalErr("^$Type: Expected even number of parameters, got 1");
+
+            # Unknown parameter
+            eval qq[\$a = new $Type  "anc", -Fred => 123 ;] ;
+            like $@, mkEvalErr("^$Type: unknown key value\\(s\\) Fred");
+
+            # no in or out param
+            eval qq[\$a = new $Type ;] ;
+            like $@, mkEvalErr("^$Type: Missing (Input|Output) parameter");
+
+        }    
+
+
+        {
+            # write a very simple compressed file 
+            # and read back 
+            #========================================
+
+
+            my $lex = new LexFile my $name ;
+            #my $name = "/tmp/try.lzf";
+
+            my $hello = <<EOM ;
+hello world
+this is a test
+EOM
+
+            {
+              my $x ;
+              ok $x = new $CompressClass $name  ;
+              is $x->autoflush(1), 0, "autoflush";
+              is $x->autoflush(1), 1, "autoflush";
+              ok $x->opened(), "opened";
+
+              ok $x->write($hello), "write" ;
+              ok $x->flush(), "flush";
+              ok $x->close, "close" ;
+              ok ! $x->opened(), "! opened";
+            }
+
+            {
+              my $uncomp;
+              ok my $x = new $UncompressClass $name, -Append => 1  ;
+              ok $x->opened(), "opened";
+
+              my $len ;
+              1 while ($len = $x->read($uncomp)) > 0 ;
+
+              is $len, 0, "read returned 0"
+                or diag $$UnError ;
+
+              ok $x->close ;
+              is $uncomp, $hello ;
+              ok !$x->opened(), "! opened";
+            }
+        }
+
+        {
+            # write a very simple compressed file 
+            # and read back 
+            #========================================
+
+
+            my $lex = new LexFile my $name ;
+
+            my $hello = <<EOM ;
+hello world
+this is a test
+EOM
+
+            {
+              my $x ;
+              ok $x = new $CompressClass $name  ;
+
+              is $x->write(''), 0, "Write empty string is ok";
+              is $x->write(undef), 0, "Write undef is ok";
+              ok $x->write($hello), "Write ok" ;
+              ok $x->close, "Close ok" ;
+            }
+
+            {
+              my $uncomp;
+              my $x = new $UncompressClass $name  ;
+              ok $x, "creates $UncompressClass $name"  ;
+
+              my $data = '';
+              $data .= $uncomp while $x->read($uncomp) > 0 ;
+
+              ok $x->close, "close ok" ;
+              is $data, $hello, "expected output" ;
+            }
+        }
+
+
+        {
+            # write a very simple file with using an IO filehandle
+            # and read back 
+            #========================================
+
+
+            my $lex = new LexFile my $name ;
+
+            my $hello = <<EOM ;
+hello world
+this is a test
+EOM
+
+            {
+              my $fh = new IO::File ">$name" ;
+              ok $fh, "opened file $name ok";
+              my $x = new $CompressClass $fh  ;
+              ok $x, " created $CompressClass $fh"  ;
+
+              is $x->fileno(), fileno($fh), "fileno match" ;
+              is $x->write(''), 0, "Write empty string is ok";
+              is $x->write(undef), 0, "Write undef is ok";
+              ok $x->write($hello), "write ok" ;
+              ok $x->flush(), "flush";
+              ok $x->close,"close" ;
+              $fh->close() ;
+            }
+
+            my $uncomp;
+            {
+              my $x ;
+              ok my $fh1 = new IO::File "<$name" ;
+              ok $x = new $UncompressClass $fh1, -Append => 1  ;
+              ok $x->fileno() == fileno $fh1 ;
+
+              1 while $x->read($uncomp) > 0 ;
+
+              ok $x->close ;
+            }
+
+            ok $hello eq $uncomp ;
+        }
+
+        {
+            # write a very simple file with using a glob filehandle
+            # and read back 
+            #========================================
+
+
+            my $lex = new LexFile my $name ;
+            #my $name  = "/tmp/fred";
+
+            my $hello = <<EOM ;
+hello world
+this is a test
+EOM
+
+            {
+              title "$CompressClass: Input from typeglob filehandle";  
+              ok open FH, ">$name" ;
+     
+              my $x = new $CompressClass *FH  ;
+              ok $x, "  create $CompressClass"  ;
+
+              is $x->fileno(), fileno(*FH), "  fileno" ;
+              is $x->write(''), 0, "  Write empty string is ok";
+              is $x->write(undef), 0, "  Write undef is ok";
+              ok $x->write($hello), "  Write ok" ;
+              ok $x->flush(), "  Flush";
+              ok $x->close, "  Close" ;
+              close FH;
+            }
+
+
+            my $uncomp;
+            {
+              title "$UncompressClass: Input from typeglob filehandle, append output";  
+              my $x ;
+              ok open FH, "<$name" ;
+              ok $x = new $UncompressClass *FH, -Append => 1, Transparent => 0
+                or diag $$UnError ;
+              is $x->fileno(), fileno FH, "  fileno ok" ;
+
+              1 while $x->read($uncomp) > 0 ;
+
+              ok $x->close, "  close" ;
+            }
+            #exit;
+
+            is $uncomp, $hello, "  expected output" ;
+        }
+
+        {
+            my $lex = new LexFile my $name ;
+            #my $name = "/tmp/fred";
+
+            my $hello = <<EOM ;
+hello world
+this is a test
+EOM
+
+            {
+              title "Outout to stdout via '-'" ;
+
+              open(SAVEOUT, ">&STDOUT");
+              my $dummy = fileno SAVEOUT;
+              open STDOUT, ">$name" ;
+     
+              my $x = new $CompressClass '-'  ;
+              $x->write($hello);
+              $x->close;
+
+              open(STDOUT, ">&SAVEOUT");
+
+              ok 1, "  wrote to stdout" ;
+            }
+            is myGZreadFile($name), $hello, "  wrote OK";
+            #hexDump($name);
+
+            {
+              title "Input from stdin via filename '-'";  
+
+              my $x ;
+              my $uncomp ;
+              my $stdinFileno = fileno(STDIN);
+              # open below doesn't return 1 sometines on XP
+                 open(SAVEIN, "<&STDIN");
+              ok open(STDIN, "<$name"), "  redirect STDIN";
+              my $dummy = fileno SAVEIN;
+              $x = new $UncompressClass '-', Append => 1, Transparent => 0
+                    or diag $$UnError ;
+              ok $x, "  created object" ;
+              is $x->fileno(), $stdinFileno, "  fileno ok" ;
+
+              1 while $x->read($uncomp) > 0 ;
+
+              ok $x->close, "  close" ;
+                 open(STDIN, "<&SAVEIN");
+              is $uncomp, $hello, "  expected output" ;
+            }
+        }
+
+        {
+            # write a compressed file to memory 
+            # and read back 
+            #========================================
+
+            #my $name = "test.gz" ;
+            my $lex = new LexFile my $name ;
+
+            my $hello = <<EOM ;
+hello world
+this is a test
+EOM
+
+            my $buffer ;
+            {
+              my $x ;
+              ok $x = new $CompressClass(\$buffer) ;
+          
+              ok ! defined $x->autoflush(1) ;
+              ok ! defined $x->autoflush(1) ;
+              ok ! defined $x->fileno() ;
+              is $x->write(''), 0, "Write empty string is ok";
+              is $x->write(undef), 0, "Write undef is ok";
+              ok $x->write($hello) ;
+              ok $x->flush();
+              ok $x->close ;
+          
+              writeFile($name, $buffer) ;
+              #is anyUncompress(\$buffer), $hello, "  any ok";
+            }
+
+            my $keep = $buffer ;
+            my $uncomp;
+            {
+              my $x ;
+              ok $x = new $UncompressClass(\$buffer, Append => 1)  ;
+
+              ok ! defined $x->autoflush(1) ;
+              ok ! defined $x->autoflush(1) ;
+              ok ! defined $x->fileno() ;
+              1 while $x->read($uncomp) > 0  ;
+
+              ok $x->close ;
+            }
+
+            is $uncomp, $hello ;
+            ok $buffer eq $keep ;
+        }
+
+        if ($CompressClass ne 'RawDeflate')
+        {
+            # write empty file
+            #========================================
+
+            my $buffer = '';
+            {
+              my $x ;
+              ok $x = new $CompressClass(\$buffer) ;
+              ok $x->close ;
+          
+            }
+
+            my $keep = $buffer ;
+            my $uncomp= '';
+            {
+              my $x ;
+              ok $x = new $UncompressClass(\$buffer, Append => 1)  ;
+
+              1 while $x->read($uncomp) > 0  ;
+
+              ok $x->close ;
+            }
+
+            ok $uncomp eq '' ;
+            ok $buffer eq $keep ;
+
+        }
+
+        {
+            # write a larger file
+            #========================================
+
+
+            my $lex = new LexFile my $name ;
+
+            my $hello = <<EOM ;
+hello world
+this is a test
+EOM
+
+            my $input    = '' ;
+            my $contents = '' ;
+
+            {
+              my $x = new $CompressClass $name  ;
+              ok $x, "  created $CompressClass object";
+
+              ok $x->write($hello), "  write ok" ;
+              $input .= $hello ;
+              ok $x->write("another line"), "  write ok" ;
+              $input .= "another line" ;
+              # all characters
+              foreach (0 .. 255)
+                { $contents .= chr int $_ }
+              # generate a long random string
+              foreach (1 .. 5000)
+                { $contents .= chr int rand 256 }
+
+              ok $x->write($contents), "  write ok" ;
+              $input .= $contents ;
+              ok $x->close, "  close ok" ;
+            }
+
+            ok myGZreadFile($name) eq $input ;
+            my $x =  readFile($name) ;
+            #print "length " . length($x) . " \n";
+        }
+
+        {
+            # embed a compressed file in another file
+            #================================
+
+
+            my $lex = new LexFile my $name ;
+
+            my $hello = <<EOM ;
+hello world
+this is a test
+EOM
+
+            my $header = "header info\n" ;
+            my $trailer = "trailer data\n" ;
+
+            {
+              my $fh ;
+              ok $fh = new IO::File ">$name" ;
+              print $fh $header ;
+              my $x ;
+              ok $x = new $CompressClass $fh,
+                                         -AutoClose => 0   ;
+
+              ok $x->binmode();
+              ok $x->write($hello) ;
+              ok $x->close ;
+              print $fh $trailer ;
+              $fh->close() ;
+            }
+
+            my ($fil, $uncomp) ;
+            my $fh1 ;
+            ok $fh1 = new IO::File "<$name" ;
+            # skip leading junk
+            my $line = <$fh1> ;
+            ok $line eq $header ;
+
+            ok my $x = new $UncompressClass $fh1, Append => 1  ;
+            ok $x->binmode();
+            1 while $x->read($uncomp) > 0 ;
+
+            ok $uncomp eq $hello ;
+            my $rest ;
+            read($fh1, $rest, 5000);
+            is $x->trailingData() . $rest, $trailer ;
+            #print "# [".$x->trailingData() . "][$rest]\n" ;
+            #exit;
+
+        }
+
+        {
+            # embed a compressed file in another buffer
+            #================================
+
+
+            my $hello = <<EOM ;
+hello world
+this is a test
+EOM
+
+            my $trailer = "trailer data" ;
+
+            my $compressed ;
+
+            {
+              ok my $x = new $CompressClass(\$compressed);
+
+              ok $x->write($hello) ;
+              ok $x->close ;
+              $compressed .= $trailer ;
+            }
+
+            my $uncomp;
+            ok my $x = new $UncompressClass(\$compressed, Append => 1)  ;
+            1 while $x->read($uncomp) > 0 ;
+
+            ok $uncomp eq $hello ;
+            is $x->trailingData(), $trailer ;
+
+        }
+
+        {
+            # Write
+            # these tests come almost 100% from IO::String
+
+            my $lex = new LexFile my $name ;
+
+            my $io = $CompressClass->new($name);
+
+            is $io->tell(), 0, " tell returns 0"; ;
+
+            my $heisan = "Heisan\n";
+            $io->print($heisan) ;
+
+            ok ! $io->eof(), "  ! eof";
+
+            is $io->tell(), length($heisan), "  tell is " . length($heisan) ;
+
+            $io->print("a", "b", "c");
+
+            {
+                local($\) = "\n";
+                $io->print("d", "e");
+                local($,) = ",";
+                $io->print("f", "g", "h");
+            }
+
+            {
+                local($\) ;
+                $io->print("D", "E");
+                local($,) = ".";
+                $io->print("F", "G", "H");
+            }
+
+            my $foo = "1234567890";
+            
+            is $io->syswrite($foo, length($foo)), length($foo), "  syswrite ok" ;
+            if ( $] < 5.6 )
+              { is $io->syswrite($foo, length $foo), length $foo, "  syswrite ok" }
+            else
+              { is $io->syswrite($foo), length $foo, "  syswrite ok" }
+            is $io->syswrite($foo, length($foo)), length $foo, "  syswrite ok";
+            is $io->write($foo, length($foo), 5), 5,   " write 5";
+            is $io->write("xxx\n", 100, -1), 1, "  write 1";
+
+            for (1..3) {
+                $io->printf("i(%d)", $_);
+                $io->printf("[%d]\n", $_);
+            }
+            $io->print("\n");
+
+            $io->close ;
+
+            ok $io->eof(), "  eof";
+
+            is myGZreadFile($name), "Heisan\nabcde\nf,g,h\nDEF.G.H" .
+                                    ("1234567890" x 3) . "67890\n" .
+                                        "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n",
+                                        "myGZreadFile ok";
+
+
+        }
+
+        {
+            # Read
+            my $str = <<EOT;
+This is an example
+of a paragraph
+
+
+and a single line.
+
+EOT
+
+            my $lex = new LexFile my $name ;
+
+            my %opts = () ;
+            my $iow = new $CompressClass $name, %opts;
+            is $iow->input_line_number, undef; 
+            $iow->print($str) ;
+            is $iow->input_line_number, undef; 
+            $iow->close ;
+
+            my @tmp;
+            my $buf;
+            {
+                my $io = new $UncompressClass $name ;
+            
+                is $., 0; 
+                is $io->input_line_number, 0; 
+                ok ! $io->eof, "eof";
+                is $io->tell(), 0, "tell 0" ;
+                #my @lines = <$io>;
+                my @lines = $io->getlines();
+                is @lines, 6
+                    or print "# Got " . scalar(@lines) . " lines, expected 6\n" ;
+                is $lines[1], "of a paragraph\n" ;
+                is join('', @lines), $str ;
+                is $., 6; 
+                is $io->input_line_number, 6; 
+                is $io->tell(), length($str) ;
+            
+                ok $io->eof;
+
+                ok ! ( defined($io->getline)  ||
+                          (@tmp = $io->getlines) ||
+                          defined($io->getline)         ||
+                          defined($io->getc)     ||
+                          $io->read($buf, 100)   != 0) ;
+            }
+            
+            
+            {
+                local $/;  # slurp mode
+                my $io = $UncompressClass->new($name);
+                is $., 0; 
+                is $io->input_line_number, 0; 
+                ok ! $io->eof;
+                my @lines = $io->getlines;
+                is $., 1; 
+                is $io->input_line_number, 1; 
+                ok $io->eof;
+                ok @lines == 1 && $lines[0] eq $str;
+            
+                $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my $line = $io->getline();
+                ok $line eq $str;
+                ok $io->eof;
+            }
+            
+            {
+                local $/ = "";  # paragraph mode
+                my $io = $UncompressClass->new($name);
+                is $., 0; 
+                is $io->input_line_number, 0; 
+                ok ! $io->eof;
+                my @lines = $io->getlines();
+                is $., 2; 
+                is $io->input_line_number, 2; 
+                ok $io->eof;
+                ok @lines == 2 
+                    or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
+                ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
+                    or print "# $lines[0]\n";
+                ok $lines[1] eq "and a single line.\n\n";
+            }
+            
+            {
+                # Record mode
+                my $reclen = 7 ;
+                my $expected_records = int(length($str) / $reclen)
+                                        + (length($str) % $reclen ? 1 : 0);
+                local $/ = \$reclen;
+
+                my $io = $UncompressClass->new($name);
+                is $., 0; 
+                is $io->input_line_number, 0; 
+
+                ok ! $io->eof;
+                my @lines = $io->getlines();
+                is $., $expected_records; 
+                is $io->input_line_number, $expected_records; 
+                ok $io->eof;
+                is @lines, $expected_records, 
+                    "Got $expected_records records\n" ;
+                ok $lines[0] eq substr($str, 0, $reclen)
+                    or print "# $lines[0]\n";
+                ok $lines[1] eq substr($str, $reclen, $reclen);
+            }
+
+            {
+                local $/ = "is";
+                my $io = $UncompressClass->new($name);
+                my @lines = ();
+                my $no = 0;
+                my $err = 0;
+                ok ! $io->eof;
+                while (my $a = $io->getline()) {
+                    push(@lines, $a);
+                    $err++ if $. != ++$no;
+                }
+            
+                ok $err == 0 ;
+                ok $io->eof;
+            
+                is $., 3; 
+                is $io->input_line_number, 3; 
+                ok @lines == 3 
+                    or print "# Got " . scalar(@lines) . " lines, expected 3\n" ;
+                ok join("-", @lines) eq
+                                 "This- is- an example\n" .
+                                "of a paragraph\n\n\n" .
+                                "and a single line.\n\n";
+            }
+            
+            
+            # Test read
+            
+            {
+                my $io = $UncompressClass->new($name);
+            
+
+                eval { $io->read(1) } ;
+                like $@, mkErr("buffer parameter is read-only");
+
+                $buf = "abcd";
+                is $io->read($buf, 0), 0, "Requested 0 bytes" ;
+                is $buf, "", "Buffer empty";
+
+                is $io->read($buf, 3), 3 ;
+                is $buf, "Thi";
+            
+                is $io->sysread($buf, 3, 2), 3 ;
+                is $buf, "Ths i"
+                    or print "# [$buf]\n" ;;
+                ok ! $io->eof;
+            
+                $buf = "ab" ;
+                is $io->read($buf, 3, 4), 3 ;
+                is $buf, "ab" . "\x00" x 2 . "s a"
+                    or print "# [$buf]\n" ;;
+                ok ! $io->eof;
+            
+                # read the rest of the file
+                $buf = '';
+                my $remain = length($str) - 9;
+                is $io->read($buf, $remain+1), $remain ;
+                is $buf, substr($str, 9);
+                ok $io->eof;
+
+                $buf = "hello";
+                is $io->read($buf, 10), 0 ;
+                is $buf, "", "Buffer empty";
+                ok $io->eof;
+
+                ok $io->close();
+                $buf = "hello";
+                is $io->read($buf, 10), 0 ;
+                is $buf, "hello", "Buffer not empty";
+                ok $io->eof;
+
+        #        $io->seek(-4, 2);
+        #    
+        #        ok ! $io->eof;
+        #    
+        #        ok read($io, $buf, 20) == 4 ;
+        #        ok $buf eq "e.\n\n";
+        #    
+        #        ok read($io, $buf, 20) == 0 ;
+        #        ok $buf eq "";
+        #   
+        #        ok ! $io->eof;
+            }
+
+        }
+
+        {
+            # Read from non-compressed file
+
+            my $str = <<EOT;
+This is an example
+of a paragraph
+
+
+and a single line.
+
+EOT
+
+            my $lex = new LexFile my $name ;
+
+            writeFile($name, $str);
+            my @tmp;
+            my $buf;
+            {
+                my $io = new $UncompressClass $name, -Transparent => 1 ;
+            
+                ok defined $io;
+                ok ! $io->eof;
+                ok $io->tell() == 0 ;
+                my @lines = $io->getlines();
+                is @lines, 6; 
+                ok $lines[1] eq "of a paragraph\n" ;
+                ok join('', @lines) eq $str ;
+                is $., 6; 
+                is $io->input_line_number, 6; 
+                ok $io->tell() == length($str) ;
+            
+                ok $io->eof;
+
+                ok ! ( defined($io->getline)  ||
+                          (@tmp = $io->getlines) ||
+                          defined($io->getline)         ||
+                          defined($io->getc)     ||
+                          $io->read($buf, 100)   != 0) ;
+            }
+            
+            
+            {
+                local $/;  # slurp mode
+                my $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my @lines = $io->getlines;
+                is $., 1; 
+                is $io->input_line_number, 1; 
+                ok $io->eof;
+                ok @lines == 1 && $lines[0] eq $str;
+            
+                $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my $line = $io->getline;
+                is $., 1; 
+                is $io->input_line_number, 1; 
+                ok $line eq $str;
+                ok $io->eof;
+            }
+            
+            {
+                local $/ = "";  # paragraph mode
+                my $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my @lines = $io->getlines;
+                is $., 2; 
+                is $io->input_line_number, 2; 
+                ok $io->eof;
+                ok @lines == 2 
+                    or print "# exected 2 lines, got " . scalar(@lines) . "\n";
+                ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
+                    or print "# [$lines[0]]\n" ;
+                ok $lines[1] eq "and a single line.\n\n";
+            }
+            
+            {
+                # Record mode
+                my $reclen = 7 ;
+                my $expected_records = int(length($str) / $reclen)
+                                        + (length($str) % $reclen ? 1 : 0);
+                local $/ = \$reclen;
+
+                my $io = $UncompressClass->new($name);
+                is $., 0; 
+                is $io->input_line_number, 0; 
+
+                ok ! $io->eof;
+                my @lines = $io->getlines();
+                is $., $expected_records; 
+                is $io->input_line_number, $expected_records; 
+                ok $io->eof;
+                is @lines, $expected_records, 
+                    "Got $expected_records records\n" ;
+                ok $lines[0] eq substr($str, 0, $reclen)
+                    or print "# $lines[0]\n";
+                ok $lines[1] eq substr($str, $reclen, $reclen);
+            }
+
+            {
+                local $/ = "is";
+                my $io = $UncompressClass->new($name);
+                my @lines = ();
+                my $no = 0;
+                my $err = 0;
+                ok ! $io->eof;
+                while (my $a = $io->getline) {
+                    push(@lines, $a);
+                    $err++ if $. != ++$no;
+                }
+            
+                is $., 3; 
+                is $io->input_line_number, 3; 
+                ok $err == 0 ;
+                ok $io->eof;
+            
+
+                ok @lines == 3 ;
+                ok join("-", @lines) eq
+                                 "This- is- an example\n" .
+                                "of a paragraph\n\n\n" .
+                                "and a single line.\n\n";
+            }
+            
+            
+            # Test Read
+            
+            {
+                my $io = $UncompressClass->new($name);
+            
+                $buf = "abcd";
+                is $io->read($buf, 0), 0, "Requested 0 bytes" ;
+                is $buf, "", "Buffer empty";
+
+                ok $io->read($buf, 3) == 3 ;
+                ok $buf eq "Thi";
+            
+                ok $io->sysread($buf, 3, 2) == 3 ;
+                ok $buf eq "Ths i";
+                ok ! $io->eof;
+            
+                $buf = "ab" ;
+                is $io->read($buf, 3, 4), 3 ;
+                is $buf, "ab" . "\x00" x 2 . "s a"
+                    or print "# [$buf]\n" ;;
+                ok ! $io->eof;
+            
+                # read the rest of the file
+                $buf = '';
+                my $remain = length($str) - 9;
+                is $io->read($buf, $remain), $remain ;
+                is $buf, substr($str, 9);
+                ok $io->eof;
+
+                $buf = "hello";
+                is $io->read($buf, 10), 0 ;
+                is $buf, "", "Buffer empty";
+                ok $io->eof;
+
+                ok $io->close();
+                $buf = "hello";
+                is $io->read($buf, 10), 0 ;
+                is $buf, "hello", "Buffer not empty";
+                ok $io->eof;
+
+        #        $io->seek(-4, 2);
+        #    
+        #        ok ! $io->eof;
+        #    
+        #        ok read($io, $buf, 20) == 4 ;
+        #        ok $buf eq "e.\n\n";
+        #    
+        #        ok read($io, $buf, 20) == 0 ;
+        #        ok $buf eq "";
+        #    
+        #        ok ! $io->eof;
+            }
+
+
+        }
+
+        {
+            # Vary the length parameter in a read
+
+            my $str = <<EOT;
+x
+x
+This is an example
+of a paragraph
+
+
+and a single line.
+
+EOT
+            $str = $str x 100 ;
+
+
+            foreach my $bufsize (1, 3, 512, 4096, length($str)-1, length($str), length($str)+1)
+            {
+                foreach my $trans (0, 1)
+                {
+                    foreach my $append (0, 1)
+                    {
+                        title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ;
+
+                        my $lex = new LexFile my $name ;
+
+                        if ($trans) {
+                            writeFile($name, $str) ;
+                        }
+                        else {
+                            my $iow = new $CompressClass $name;
+                            $iow->print($str) ;
+                            $iow->close ;
+                        }
+
+                        
+                        my $io = $UncompressClass->new($name, 
+                                                       -Append => $append,
+                                                       -Transparent  => $trans);
+                    
+                        my $buf;
+                        
+                        is $io->tell(), 0;
+
+                        if ($append) {
+                            1 while $io->read($buf, $bufsize) > 0;
+                        }
+                        else {
+                            my $tmp ;
+                            $buf .= $tmp while $io->read($tmp, $bufsize) > 0 ;
+                        }
+                        is length $buf, length $str;
+                        ok $buf eq $str ;
+                        ok ! $io->error() ;
+                        ok $io->eof;
+                    }
+                }
+            }
+        }
+
+        foreach my $file (0, 1)
+        {
+            foreach my $trans (0, 1)
+            {
+                title "seek tests - file $file trans $trans" ;
+
+                my $buffer ;
+                my $buff ;
+                my $lex = new LexFile my $name ;
+
+                my $first = "beginning" ;
+                my $last  = "the end" ;
+
+                if ($trans)
+                {
+                    $buffer = $first . "\x00" x 10 . $last;
+                    writeFile($name, $buffer);
+                }
+                else
+                {
+                    my $output ;
+                    if ($file)
+                    {
+                        $output = $name ;
+                    }
+                    else
+                    {
+                        $output = \$buffer;
+                    }
+
+                    my $iow = new $CompressClass $output ;
+                    $iow->print($first) ;
+                    ok $iow->seek(5, SEEK_CUR) ;
+                    ok $iow->tell() == length($first)+5;
+                    ok $iow->seek(0, SEEK_CUR) ;
+                    ok $iow->tell() == length($first)+5;
+                    ok $iow->seek(length($first)+10, SEEK_SET) ;
+                    ok $iow->tell() == length($first)+10;
+
+                    $iow->print($last) ;
+                    $iow->close ;
+                }
+
+                my $input ;
+                if ($file)
+                {
+                    $input = $name ;
+                }
+                else
+                {
+                    $input = \$buffer ;
+                }
+
+                ok myGZreadFile($input) eq $first . "\x00" x 10 . $last ;
+
+                my $io = $UncompressClass->new($input, Strict => 1);
+                ok $io->seek(length($first), SEEK_CUR) 
+                    or diag $$UnError ;
+                ok ! $io->eof;
+                is $io->tell(), length($first);
+
+                ok $io->read($buff, 5) ;
+                is $buff, "\x00" x 5 ;
+                is $io->tell(), length($first) + 5;
+
+                ok $io->seek(0, SEEK_CUR) ;
+                my $here = $io->tell() ;
+                is $here, length($first)+5;
+
+                ok $io->seek($here+5, SEEK_SET) ;
+                is $io->tell(), $here+5 ;
+                ok $io->read($buff, 100) ;
+                ok $buff eq $last ;
+                ok $io->eof;
+            }
+        }
+
+        {
+            title "seek error cases" ;
+
+            my $b ;
+            my $a = new $CompressClass(\$b)  ;
+
+            ok ! $a->error() ;
+            eval { $a->seek(-1, 10) ; };
+            like $@, mkErr("^${CompressClass}::seek: unknown value, 10, for whence parameter");
+
+            eval { $a->seek(-1, SEEK_END) ; };
+            like $@, mkErr("^${CompressClass}::seek: cannot seek backwards");
+
+            $a->write("fred");
+            $a->close ;
+
+
+            my $u = new $UncompressClass(\$b)  ;
+
+            eval { $u->seek(-1, 10) ; };
+            like $@, mkErr("^${UncompressClass}::seek: unknown value, 10, for whence parameter");
+
+            eval { $u->seek(-1, SEEK_END) ; };
+            like $@, mkErr("^${UncompressClass}::seek: SEEK_END not allowed");
+
+            eval { $u->seek(-1, SEEK_CUR) ; };
+            like $@, mkErr("^${UncompressClass}::seek: cannot seek backwards");
+        }
+        
+        foreach my $fb (qw(filename buffer filehandle))
+        {
+            foreach my $append (0, 1)
+            {
+                {
+                    title "$CompressClass -- Append $append, Output to $fb" ;
+
+                    my $lex = new LexFile my $name ;
+
+                    my $already = 'already';
+                    my $buffer = $already;
+                    my $output;
+
+                    if ($fb eq 'buffer')
+                      { $output = \$buffer }
+                    elsif ($fb eq 'filename')
+                    {
+                        $output = $name ;
+                        writeFile($name, $buffer);
+                    }
+                    elsif ($fb eq 'filehandle')
+                    {
+                        $output = new IO::File ">$name" ;
+                        print $output $buffer;
+                    }
+
+                    my $a = new $CompressClass($output, Append => $append)  ;
+                    ok $a, "  Created $CompressClass";
+                    my $string = "appended";
+                    $a->write($string);
+                    $a->close ;
+
+                    my $data ; 
+                    if ($fb eq 'buffer')
+                    {
+                        $data = $buffer;
+                    }
+                    else
+                    {
+                        $output->close
+                            if $fb eq 'filehandle';
+                        $data = readFile($name);
+                    }
+
+                    if ($append || $fb eq 'filehandle')
+                    {
+                        is substr($data, 0, length($already)), $already, "  got prefix";
+                        substr($data, 0, length($already)) = '';
+                    }
+
+
+                    my $uncomp;
+                    my $x = new $UncompressClass(\$data, Append => 1)  ;
+                    ok $x, "  created $UncompressClass";
+
+                    my $len ;
+                    1 while ($len = $x->read($uncomp)) > 0 ;
+
+                    $x->close ;
+                    is $uncomp, $string, '  Got uncompressed data' ;
+                    
+                }
+            }
+        }
+
+        foreach my $type (qw(buffer filename filehandle))
+        {
+            foreach my $good (0, 1)
+            {
+                title "$UncompressClass -- InputLength, read from $type, good data => $good";
+
+                my $compressed ; 
+                my $string = "some data";
+                my $appended = "append";
+
+                if ($good)
+                {
+                    my $c = new $CompressClass(\$compressed);
+                    $c->write($string);
+                    $c->close();
+                }
+                else
+                {
+                    $compressed = $string ;
+                }
+
+                my $comp_len = length $compressed;
+                $compressed .= $appended;
+
+                my $lex = new LexFile my $name ;
+                my $input ;
+                writeFile ($name, $compressed);
+
+                if ($type eq 'buffer')
+                {
+                    $input = \$compressed;
+                }
+                if ($type eq 'filename')
+                {
+                    $input = $name;
+                }
+                elsif ($type eq 'filehandle')
+                {
+                    my $fh = new IO::File "<$name" ;
+                    ok $fh, "opened file $name ok";
+                    $input = $fh ;
+                }
+
+                my $x = new $UncompressClass($input, 
+                                             InputLength => $comp_len,
+                                             Transparent => 1)  ;
+                ok $x, "  created $UncompressClass";
+
+                my $len ;
+                my $output;
+                $len = $x->read($output, 100);
+
+                is $len, length($string);
+                is $output, $string;
+
+                if ($type eq 'filehandle')
+                {
+                    my $rest ;
+                    $input->read($rest, 1000);
+                    is $rest, $appended;
+                }
+            }
+
+
+        }
+        
+        foreach my $append (0, 1)
+        {
+            title "$UncompressClass -- Append $append" ;
+
+            my $lex = new LexFile my $name ;
+
+            my $string = "appended";
+            my $compressed ; 
+            my $c = new $CompressClass(\$compressed);
+            $c->write($string);
+            $c->close();
+
+            my $x = new $UncompressClass(\$compressed, Append => $append)  ;
+            ok $x, "  created $UncompressClass";
+
+            my $already = 'already';
+            my $output = $already;
+
+            my $len ;
+            $len = $x->read($output, 100);
+            is $len, length($string);
+
+            $x->close ;
+
+            if ($append)
+            {
+                is substr($output, 0, length($already)), $already, "  got prefix";
+                substr($output, 0, length($already)) = '';
+            }
+            is $output, $string, '  Got uncompressed data' ;
+        }
+        
+
+        foreach my $file (0, 1)
+        {
+            foreach my $trans (0, 1)
+            {
+                title "ungetc, File $file, Transparent $trans" ;
+
+                my $lex = new LexFile my $name ;
+
+                my $string = 'abcdeABCDE';
+                my $b ;
+                if ($trans)
+                {
+                    $b = $string ;
+                }
+                else
+                {
+                    my $a = new $CompressClass(\$b)  ;
+                    $a->write($string);
+                    $a->close ;
+                }
+
+                my $from ;
+                if ($file)
+                {
+                    writeFile($name, $b);
+                    $from = $name ;
+                }
+                else
+                {
+                    $from = \$b ;
+                }
+
+                my $u = $UncompressClass->new($from, Transparent => 1)  ;
+                my $first;
+                my $buff ;
+
+                # do an ungetc before reading
+                $u->ungetc("X");
+                $first = $u->getc();
+                is $first, 'X';
+
+                $first = $u->getc();
+                is $first, substr($string, 0,1);
+                $u->ungetc($first);
+                $first = $u->getc();
+                is $first, substr($string, 0,1);
+                $u->ungetc($first);
+
+                is $u->read($buff, 5), 5 ;
+                is $buff, substr($string, 0, 5);
+
+                $u->ungetc($buff) ;
+                is $u->read($buff, length($string)), length($string) ;
+                is $buff, $string;
+
+                is $u->read($buff, 1), 0;
+                ok $u->eof() ;
+
+                my $extra = 'extra';
+                $u->ungetc($extra);
+                ok ! $u->eof();
+                is $u->read($buff), length($extra) ;
+                is $buff, $extra;
+                
+                is $u->read($buff, 1), 0;
+                ok $u->eof() ;
+
+                # getc returns undef on eof
+                is $u->getc(), undef;
+                $u->close();
+
+            }
+        }
+
+
+        {
+            title "write tests - invalid data" ;
+
+            #my $lex = new LexFile my $name1 ;
+            my($Answer);
+
+            #ok ! -e $name1, "  File $name1 does not exist";
+
+            my @data = (
+                [ '{ }',         "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], 
+                [ '[ { } ]',     "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], 
+                [ '[ [ { } ] ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], 
+                [ '[ "" ]',      "${CompressClass}::write: input filename is undef or null string" ], 
+                [ '[ undef ]',   "${CompressClass}::write: input filename is undef or null string" ], 
+                [ '[ \$Answer ]',"${CompressClass}::write: input and output buffer are identical" ], 
+                #[ "not readable", 'xx' ], 
+                # same filehandle twice, 'xx'
+               ) ;
+
+            foreach my $data (@data)
+            {
+                my ($send, $get) = @$data ;
+                title "${CompressClass}::write( $send )";
+                my($copy);
+                eval "\$copy = $send";
+                my $x = new $CompressClass(\$Answer);
+                ok $x, "  Created $CompressClass object";
+                eval { $x->write($copy) } ;
+                #like $@, "/^$get/", "  error - $get";
+                like $@, "/not a scalar reference /", "  error - not a scalar reference";
+            }
+
+    #        @data = (
+    #            [ '[ $name1 ]',  "input file '$name1' does not exist" ], 
+    #            #[ "not readable", 'xx' ], 
+    #            # same filehandle twice, 'xx'
+    #           ) ;
+    #
+    #        foreach my $data (@data)
+    #        {
+    #            my ($send, $get) = @$data ;
+    #            title "${CompressClass}::write( $send )";
+    #            my $copy;
+    #            eval "\$copy = $send";
+    #            my $x = new $CompressClass(\$Answer);
+    #            ok $x, "  Created $CompressClass object";
+    #            ok ! $x->write($copy), "  write fails"  ;
+    #            like $$Error, "/^$get/", "  error - $get";
+    #        }
+
+            #exit;
+            
+        }
+
+
+    #    sub deepCopy
+    #    {
+    #        if (! ref $_[0] || ref $_[0] eq 'SCALAR')
+    #        {
+    #            return $_[0] ;
+    #        }
+    #
+    #        if (ref $_[0] eq 'ARRAY')
+    #        {
+    #            my @a ;
+    #            for my $x ( @{ $_[0] })
+    #            {
+    #                push @a, deepCopy($x);
+    #            }
+    #
+    #            return \@a ;
+    #        }
+    #
+    #        croak "bad! $_[0]";
+    #
+    #    }
+    #
+    #    sub deepSubst
+    #    {
+    #        #my $data = shift ;
+    #        my $from = $_[1] ;
+    #        my $to   = $_[2] ;
+    #
+    #        if (! ref $_[0])
+    #        {
+    #            $_[0] = $to 
+    #                if $_[0] eq $from ;
+    #            return ;    
+    #
+    #        }
+    #
+    #        if (ref $_[0] eq 'SCALAR')
+    #        {
+    #            $_[0] = \$to 
+    #                if defined ${ $_[0] } && ${ $_[0] } eq $from ;
+    #            return ;    
+    #
+    #        }
+    #
+    #        if (ref $_[0] eq 'ARRAY')
+    #        {
+    #            for my $x ( @{ $_[0] })
+    #            {
+    #                deepSubst($x, $from, $to);
+    #            }
+    #            return ;
+    #        }
+    #        #croak "bad! $_[0]";
+    #    }
+
+    #    {
+    #        title "More write tests" ;
+    #
+    #        my $file1 = "file1" ;
+    #        my $file2 = "file2" ;
+    #        my $file3 = "file3" ;
+    #        my $lex = new LexFile $file1, $file2, $file3 ;
+    #
+    #        writeFile($file1, "F1");
+    #        writeFile($file2, "F2");
+    #        writeFile($file3, "F3");
+    #
+    #        my @data = (
+    #              [ '""',                                   ""      ],
+    #              [ 'undef',                                ""      ],
+    #              [ '"abcd"',                               "abcd"  ],
+    #
+    #              [ '\""',                                   ""     ],
+    #              [ '\undef',                                ""     ],
+    #              [ '\"abcd"',                               "abcd" ],
+    #
+    #              [ '[]',                                    ""     ],
+    #              [ '[[]]',                                  ""     ],
+    #              [ '[[[]]]',                                ""     ],
+    #              [ '[\""]',                                 ""     ],
+    #              [ '[\undef]',                              ""     ],
+    #              [ '[\"abcd"]',                             "abcd" ],
+    #              [ '[\"ab", \"cd"]',                        "abcd" ],
+    #              [ '[[\"ab"], [\"cd"]]',                    "abcd" ],
+    #
+    #              [ '$file1',                                $file1 ],
+    #              [ '$fh2',                                  "F2"   ],
+    #              [ '[$file1, \"abc"]',                      "F1abc"],
+    #              [ '[\"a", $file1, \"bc"]',                 "aF1bc"],
+    #              [ '[\"a", $fh1, \"bc"]',                   "aF1bc"],
+    #              [ '[\"a", $fh1, \"bc", $file2]',           "aF1bcF2"],
+    #              [ '[\"a", $fh1, \"bc", $file2, $fh3]',     "aF1bcF2F3"],
+    #            ) ;
+    #
+    #
+    #        foreach my $data (@data)
+    #        {
+    #            my ($send, $get) = @$data ;
+    #
+    #            my $fh1 = new IO::File "< $file1" ;
+    #            my $fh2 = new IO::File "< $file2" ;
+    #            my $fh3 = new IO::File "< $file3" ;
+    #
+    #            title "${CompressClass}::write( $send )";
+    #            my $copy;
+    #            eval "\$copy = $send";
+    #            my $Answer ;
+    #            my $x = new $CompressClass(\$Answer);
+    #            ok $x, "  Created $CompressClass object";
+    #            my $len = length $get;
+    #            is $x->write($copy), length($get), "  write $len bytes";
+    #            ok $x->close(), "  close ok" ;
+    #
+    #            is myGZreadFile(\$Answer), $get, "  got expected output" ;
+    #            cmp_ok $$Error, '==', 0, "  no error";
+    #
+    #
+    #        }
+    #        
+    #    }
+    }
+
+}
+
+1;
+
+
+
+
+
diff --git a/gnu/usr.bin/perl/t/lib/compress/merge.pl b/gnu/usr.bin/perl/t/lib/compress/merge.pl
new file mode 100644
index 00000000000..7811966e84e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/compress/merge.pl
@@ -0,0 +1,330 @@
+use lib 't';
+use strict;
+use warnings;
+use bytes;
+
+use Test::More ; 
+use CompTestUtils;
+
+use Compress::Raw::Zlib 2 ;
+
+BEGIN 
+{ 
+    plan(skip_all => "Merge needs Zlib 1.2.1 or better - you have Zlib "  
+                . Compress::Raw::Zlib::zlib_version()) 
+        if ZLIB_VERNUM() < 0x1210 ;
+
+    # use Test::NoWarnings, if available
+    my $extra = 0 ;
+    $extra = 1
+        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
+
+    plan tests => 165 + $extra ;
+
+}
+
+
+sub run
+{
+
+    my $CompressClass   = identify();
+    my $UncompressClass = getInverse($CompressClass);
+    my $Error           = getErrorRef($CompressClass);
+    my $UnError         = getErrorRef($UncompressClass);
+
+    # Tests     
+    #   destination is a file that doesn't exist -- should work ok unless AnyDeflate
+    #   destination isn't compressed at all
+    #   destination is compressed but wrong format
+    #   destination is corrupt - error messages should be correct
+    #   use apend mode with old zlib - check that this is trapped
+    #   destination is not seekable, readable, writable - test for filename & handle
+
+    {
+        title "Misc error cases";
+
+        eval { new Compress::Raw::Zlib::InflateScan Bufsize => 0} ;
+        like $@, mkErr("^Compress::Raw::Zlib::InflateScan::new: Bufsize must be >= 1, you specified 0"), "  catch bufsize == 0";
+
+        eval { Compress::Raw::Zlib::inflateScanStream::createDeflateStream(undef, Bufsize => 0) } ;
+        like $@, mkErr("^Compress::Raw::Zlib::InflateScan::createDeflateStream: Bufsize must be >= 1, you specified 0"), "  catch bufsize == 0";
+
+    }
+
+    # output file/handle not writable
+    {
+
+        foreach my $to_file (0,1)
+        {
+            if ($to_file)
+              { title "$CompressClass - Merge to filename that isn't writable" }
+            else  
+              { title "$CompressClass - Merge to filehandle that isn't writable" }
+
+            my $lex = new LexFile my $out_file ;
+
+            # create empty file
+            open F, ">$out_file" ; print F "x"; close F;
+            ok   -e $out_file, "  file exists" ;
+            ok  !-z $out_file, "  and is not empty" ;
+            
+            # make unwritable
+            is chmod(0444, $out_file), 1, "  chmod worked" ;
+            ok   -e $out_file, "  still exists after chmod" ;
+
+            SKIP:
+            {
+                skip "Cannot create non-writable file", 3 
+                    if -w $out_file ;
+
+                ok ! -w $out_file, "  chmod made file unwritable" ;
+
+                my $dest ;
+                if ($to_file)
+                  { $dest = $out_file }
+                else
+                  { $dest = new IO::File "<$out_file"  }
+
+                my $gz = $CompressClass->new($dest, Merge => 1) ;
+                
+                ok ! $gz, "  Did not create $CompressClass object";
+
+                {
+                    if ($to_file) {
+                        is $$Error, "Output file '$out_file' is not writable",
+                                "  Got non-writable filename message" ;
+                    }
+                    else {
+                        ok $$Error, "  Got error message" ;
+                    }
+                }
+            }
+
+            chmod 0777, $out_file ;
+        }
+    }
+
+    # output is not compressed at all
+    {
+
+        my $lex = new LexFile my $out_file ;
+
+        foreach my $to_file ( qw(buffer file handle ) )
+        {
+            title "$CompressClass to $to_file, content is not compressed";
+
+            my $content = "abc" x 300 ;
+            my $buffer ;
+            my $disp_content = defined $content ? $content : '<undef>' ;
+            my $str_content = defined $content ? $content : '' ;
+
+            if ($to_file eq 'buffer')
+            {
+                $buffer = \$content ;
+            }
+            else
+            {
+                writeFile($out_file, $content);
+
+                if ($to_file eq 'handle')
+                {
+                    $buffer = new IO::File "+<$out_file" 
+                        or die "# Cannot open $out_file: $!";
+                }
+                else
+                  { $buffer = $out_file }
+            }
+
+            ok ! $CompressClass->new($buffer, Merge => 1), "  constructor fails";
+            {
+                like $$Error, '/Cannot create InflateScan object: (Header Error|unexpected end of file)/', "  got Bad Magic" ;
+            }
+
+        }
+    }
+
+    # output is empty
+    {
+
+        my $lex = new LexFile my $out_file ;
+
+        foreach my $to_file ( qw(buffer file handle ) )
+        {
+            title "$CompressClass to $to_file, content is empty";
+
+            my $content = '';
+            my $buffer ;
+            my $dest ;
+
+            if ($to_file eq 'buffer')
+            {
+                $dest = $buffer = \$content ;
+            }
+            else
+            {
+                writeFile($out_file, $content);
+                $dest = $out_file;
+
+                if ($to_file eq 'handle')
+                {
+                    $buffer = new IO::File "+<$out_file" 
+                        or die "# Cannot open $out_file: $!";
+                }
+                else
+                  { $buffer = $out_file }
+            }
+
+            ok my $gz = $CompressClass->new($buffer, Merge => 1, AutoClose => 1), "  constructor passes"
+                or diag $$Error;
+
+            $gz->write("FGHI");
+            $gz->close();
+
+            #hexDump($buffer);
+            my $out = anyUncompress($dest);
+
+            is $out, "FGHI", '  Merge OK';
+        }
+    }
+
+    {
+        title "$CompressClass - Merge to file that doesn't exist";
+
+        my $lex = new LexFile my $out_file ;
+        
+        ok ! -e $out_file, "  Destination file, '$out_file', does not exist";
+
+        ok my $gz1 = $CompressClass->new($out_file, Merge => 1)
+            or die "# $CompressClass->new failed: $$Error\n";
+        #hexDump($buffer);
+        $gz1->write("FGHI");
+        $gz1->close();
+
+        #hexDump($buffer);
+        my $out = anyUncompress($out_file);
+
+        is $out, "FGHI", '  Merged OK';
+    }
+
+    {
+
+        my $lex = new LexFile my $out_file ;
+
+        foreach my $to_file ( qw( buffer file handle ) )
+        {
+            foreach my $content (undef, '', 'x', 'abcde')
+            {
+                #next if ! defined $content && $to_file; 
+
+                my $buffer ;
+                my $disp_content = defined $content ? $content : '<undef>' ;
+                my $str_content = defined $content ? $content : '' ;
+
+                if ($to_file eq 'buffer')
+                {
+                    my $x ;
+                    $buffer = \$x ;
+                    title "$CompressClass to Buffer, content is '$disp_content'";
+                }
+                else
+                {
+                    $buffer = $out_file ;
+                    if ($to_file eq 'handle')
+                    {
+                        title "$CompressClass to Filehandle, content is '$disp_content'";
+                    }
+                    else
+                    {
+                        title "$CompressClass to File, content is '$disp_content'";
+                    }
+                }
+
+                my $gz = $CompressClass->new($buffer);
+                my $len = defined $content ? length($content) : 0 ;
+                is $gz->write($content), $len, "  write ok";
+                ok $gz->close(), " close ok";
+
+                #hexDump($buffer);
+                is anyUncompress($buffer), $str_content, '  Destination is ok';
+
+                #if ($corruption)
+                #{
+                    #    next if $TopTypes eq 'RawDeflate' && $content eq '';
+                    #
+                    #}
+
+                my $dest = $buffer ;    
+                if ($to_file eq 'handle')
+                {
+                    $dest = new IO::File "+<$buffer" ;
+                }
+
+                my $gz1 = $CompressClass->new($dest, Merge => 1, AutoClose => 1)
+                    or die "## Error is  $$Error\n";
+
+                #print "YYY\n";
+                #hexDump($buffer);
+                #print "XXX\n";
+                is $gz1->write("FGHI"), 4, "  write returned 4";
+                ok $gz1->close(), "  close ok";
+
+                #hexDump($buffer);
+                my $out = anyUncompress($buffer);
+
+                is $out, $str_content . "FGHI", '  Merged OK';
+                #exit;
+            }
+        }
+
+    }
+
+
+
+    {
+        my $Func = getTopFuncRef($CompressClass);
+        my $TopType = getTopFuncName($CompressClass);
+
+        my $buffer ;
+
+        my $lex = new LexFile my $out_file ;
+
+        foreach my $to_file (0, 1)
+        {
+            foreach my $content (undef, '', 'x', 'abcde')
+            {
+                my $disp_content = defined $content ? $content : '<undef>' ;
+                my $str_content = defined $content ? $content : '' ;
+                my $buffer ;
+                if ($to_file)
+                {
+                    $buffer = $out_file ;
+                    title "$TopType to File, content is '$disp_content'";
+                }
+                else
+                {
+                    my $x = '';
+                    $buffer = \$x ;
+                    title "$TopType to Buffer, content is '$disp_content'";
+                }
+                
+
+                ok $Func->(\$content, $buffer), " Compress content";
+                #hexDump($buffer);
+                is anyUncompress($buffer), $str_content, '  Destination is ok';
+
+
+                ok $Func->(\"FGHI", $buffer, Merge => 1), "  Merge content";
+
+                #hexDump($buffer);
+                my $out = anyUncompress($buffer);
+
+                is $out, $str_content . "FGHI", '  Merged OK';
+            }
+        }
+
+    }
+
+}
+
+
+1;
diff --git a/gnu/usr.bin/perl/t/lib/compress/multi.pl b/gnu/usr.bin/perl/t/lib/compress/multi.pl
new file mode 100644
index 00000000000..cfb5666f6ca
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/compress/multi.pl
@@ -0,0 +1,217 @@
+
+use lib 't';
+use strict;
+use warnings;
+use bytes;
+
+use Test::More ;
+use CompTestUtils;
+
+BEGIN {
+    # use Test::NoWarnings, if available
+    my $extra = 0 ;
+    $extra = 1
+        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
+
+    plan tests => 694 + $extra ;
+
+    use_ok('IO::Uncompress::AnyUncompress', qw($AnyUncompressError)) ;
+
+}
+
+sub run
+{
+
+    my $CompressClass   = identify();
+    my $UncompressClass = getInverse($CompressClass);
+    my $Error           = getErrorRef($CompressClass);
+    my $UnError         = getErrorRef($UncompressClass);
+
+
+
+
+    my @buffers ;
+    push @buffers, <<EOM ;
+hello world
+this is a test
+some more stuff on this line
+ad finally...
+EOM
+
+    push @buffers, <<EOM ;
+some more stuff
+line 2
+EOM
+
+    push @buffers, <<EOM ;
+even more stuff
+EOM
+
+    {
+        my $cc ;
+        my $gz ;
+        my $hsize ;
+        my %headers = () ;
+        
+
+        foreach my $fb ( qw( file filehandle buffer ) )
+        {
+
+            foreach my $i (1 .. @buffers) {
+
+                title "Testing $CompressClass with $i streams to $fb";
+
+                my @buffs = @buffers[0..$i -1] ;
+
+                if ($CompressClass eq 'IO::Compress::Gzip') {
+                    %headers = (
+                                  Strict     => 1,
+                                  Comment    => "this is a comment",
+                                  ExtraField => ["so" => "me extra"],
+                                  HeaderCRC  => 1); 
+
+                }
+
+                my $lex = new LexFile my $name ;
+                my $output ;
+                if ($fb eq 'buffer')
+                {
+                    my $compressed = '';
+                    $output = \$compressed;
+                }
+                elsif ($fb eq 'filehandle')
+                {
+                    $output = new IO::File ">$name" ;
+                }
+                else
+                {
+                    $output = $name ;
+                }
+
+                my $x = new $CompressClass($output, AutoClose => 1, %headers);
+                isa_ok $x, $CompressClass, '  $x' ;
+
+                foreach my $buffer (@buffs) {
+                    ok $x->write($buffer), "    Write OK" ;
+                    # this will add an extra "empty" stream
+                    ok $x->newStream(), "    newStream OK" ;
+                }
+                ok $x->close, "  Close ok" ;
+
+                #hexDump($compressed) ;
+
+                foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
+                    title "  Testing $CompressClass with $unc and $i streams, from $fb";
+                    $cc = $output ;
+                    if ($fb eq 'filehandle')
+                    {
+                        $cc = new IO::File "<$name" ;
+                    }
+                    my @opts = $unc ne $UncompressClass 
+                                    ? (RawInflate => 1)
+                                    : ();
+                    my $gz = new $unc($cc,
+                                   @opts,
+                                   Strict      => 1,
+                                   AutoClose   => 1,
+                                   Append      => 1,
+                                   MultiStream => 1,
+                                   Transparent => 0)
+                        or diag $$UnError;
+                    isa_ok $gz, $UncompressClass, '    $gz' ;
+
+                    my $un = '';
+                    1 while $gz->read($un) > 0 ;
+                    #print "[[$un]]\n" while $gz->read($un) > 0 ;
+                    ok ! $gz->error(), "      ! error()"
+                        or diag "Error is " . $gz->error() ;
+                    ok $gz->eof(), "      eof()";
+                    ok $gz->close(), "    close() ok"
+                        or diag "errno $!\n" ;
+
+                    is $gz->streamCount(), $i +1, "    streamCount ok " .  ($i +1)
+                        or diag "Stream count is " . $gz->streamCount();
+                    ok $un eq join('', @buffs), "    expected output" ;
+
+                }
+
+                foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
+                    title "  Testing $CompressClass with $unc nextStream and $i streams, from $fb";
+                    $cc = $output ;
+                    if ($fb eq 'filehandle')
+                    {
+                        $cc = new IO::File "<$name" ;
+                    }
+                    my @opts = $unc ne $UncompressClass 
+                                    ? (RawInflate => 1)
+                                    : ();
+                    my $gz = new $unc($cc,
+                                   @opts,
+                                   Strict      => 1,
+                                   AutoClose   => 1,
+                                   Append      => 1,
+                                   MultiStream => 0,
+                                   Transparent => 0)
+                        or diag $$UnError;
+                    isa_ok $gz, $UncompressClass, '    $gz' ;
+
+                    for my $stream (1 .. $i)
+                    {
+                        my $buff = $buffs[$stream-1];
+                        my @lines = split("\n", $buff);
+                        my $lines = @lines;
+
+                        my $un = '';
+                        #while (<$gz>) {
+                        while ($_ = $gz->getline()) {
+                            $un .= $_;
+                        }
+                        is $., $lines, "    \$. is $lines";
+                        
+                        ok ! $gz->error(), "      ! error()"
+                            or diag "Error is " . $gz->error() ;
+                        ok $gz->eof(), "      eof()";
+                        is $gz->streamCount(), $stream, "    streamCount is $stream"
+                            or diag "Stream count is " . $gz->streamCount();
+                        ok $un eq $buff, "    expected output" ;
+                        #is $gz->tell(), length $buff, "    tell is ok";
+                        is $gz->nextStream(), 1, "    nextStream ok";
+                        is $gz->tell(), 0, "    tell is 0";
+                        is $., 0, '    $. is 0';
+                    }
+
+                    {
+                        my $un = '';
+                        #1 while $gz->read($un) > 0 ;
+                        is $., 0, "    \$. is 0";
+                        $gz->read($un) ;
+                        #print "[[$un]]\n" while $gz->read($un) > 0 ;
+                        ok ! $gz->error(), "      ! error()"
+                            or diag "Error is " . $gz->error() ;
+                        ok $gz->eof(), "      eof()";
+                        is $gz->streamCount(), $i+1, "    streamCount is ok"
+                            or diag "Stream count is " . $gz->streamCount();
+                        ok $un eq "", "    expected output" ;
+                        is $gz->tell(), 0, "    tell is 0";
+                    }
+
+                    is $gz->nextStream(), 0, "    nextStream ok";
+                    ok $gz->eof(), "      eof()";
+                    ok $gz->close(), "    close() ok"
+                        or diag "errno $!\n" ;
+
+                    is $gz->streamCount(), $i +1, "    streamCount ok"
+                        or diag "Stream count is " . $gz->streamCount();
+
+                }
+            }
+        }
+    }
+}
+
+
+# corrupt one of the streams - all previous should be ok
+# trailing stuff
+# check that "tell" works ok
+
+1;
diff --git a/gnu/usr.bin/perl/t/lib/compress/newtied.pl b/gnu/usr.bin/perl/t/lib/compress/newtied.pl
new file mode 100644
index 00000000000..41861e90721
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/compress/newtied.pl
@@ -0,0 +1,374 @@
+use lib 't';
+use strict;
+use warnings;
+use bytes;
+
+use Test::More ;
+use CompTestUtils;
+
+our ($BadPerl, $UncompressClass);
+ 
+BEGIN 
+{ 
+    plan(skip_all => "Extra Tied Filehandle needs Perl 5.6 or better - you have Perl $]" )
+        if $] < 5.006 ;
+     
+    my $tests ;
+
+    $BadPerl = ($] >= 5.006 and $] <= 5.008) ;
+
+    if ($BadPerl) {
+        $tests = 78 ;
+    }
+    else {
+        $tests = 84 ;
+    }
+
+    # use Test::NoWarnings, if available
+    my $extra = 0 ;
+    $extra = 1
+        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
+
+    plan tests => $tests + $extra ;
+
+}
+
+
+use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
+
+
+
+sub myGZreadFile
+{
+    my $filename = shift ;
+    my $init = shift ;
+
+
+    my $fil = new $UncompressClass $filename,
+                                    -Strict   => 1,
+                                    -Append   => 1
+                                    ;
+
+    my $data ;
+    $data = $init if defined $init ;
+    1 while $fil->read($data) > 0;
+
+    $fil->close ;
+    return $data ;
+}
+
+
+sub run
+{
+
+    my $CompressClass   = identify();
+    $UncompressClass = getInverse($CompressClass);
+    my $Error           = getErrorRef($CompressClass);
+    my $UnError         = getErrorRef($UncompressClass);
+
+    {
+        title "Testing $CompressClass and $UncompressClass";
+
+
+
+        {
+            # Write
+            # these tests come almost 100% from IO::String
+
+            my $lex = new LexFile my $name ;
+
+            my $io = $CompressClass->new($name);
+
+            is tell($io), 0 ;
+            is $io->tell(), 0 ;
+
+            my $heisan = "Heisan\n";
+            print $io $heisan ;
+
+            ok ! eof($io);
+            ok ! $io->eof();
+
+            is tell($io), length($heisan) ;
+            is $io->tell(), length($heisan) ;
+
+            $io->print("a", "b", "c");
+
+            {
+                local($\) = "\n";
+                print $io "d", "e";
+                local($,) = ",";
+                print $io "f", "g", "h";
+            }
+
+            my $foo = "1234567890";
+            
+            ok syswrite($io, $foo, length($foo)) == length($foo) ;
+            if ( $] < 5.6 )
+              { is $io->syswrite($foo, length $foo), length $foo }
+            else
+              { is $io->syswrite($foo), length $foo }
+            ok $io->syswrite($foo, length($foo)) == length $foo;
+            ok $io->write($foo, length($foo), 5) == 5;
+            ok $io->write("xxx\n", 100, -1) == 1;
+
+            for (1..3) {
+                printf $io "i(%d)", $_;
+                $io->printf("[%d]\n", $_);
+            }
+            select $io;
+            print "\n";
+            select STDOUT;
+
+            close $io ;
+
+            ok eof($io);
+            ok $io->eof();
+
+            is myGZreadFile($name), "Heisan\nabcde\nf,g,h\n" .
+                                    ("1234567890" x 3) . "67890\n" .
+                                        "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n";
+
+
+        }
+
+        {
+            # Read
+            my $str = <<EOT;
+This is an example
+of a paragraph
+
+
+and a single line.
+
+EOT
+
+            my $lex = new LexFile my $name ;
+
+            my $iow = new $CompressClass $name ;
+            print $iow $str ;
+            close $iow;
+
+            my @tmp;
+            my $buf;
+            {
+                my $io = new $UncompressClass $name ;
+            
+                ok ! $io->eof;
+                ok ! eof $io;
+                is $io->tell(), 0 ;
+                is tell($io), 0 ;
+                my @lines = <$io>;
+                is @lines, 6
+                    or print "# Got " . scalar(@lines) . " lines, expected 6\n" ;
+                is $lines[1], "of a paragraph\n" ;
+                is join('', @lines), $str ;
+                is $., 6; 
+        #print "TELL says " . tell($io) , " should be ${ \length($str) }\n" ;
+                is $io->tell(), length($str) ;
+                is tell($io), length($str) ;
+            
+                ok $io->eof;
+                ok eof $io;
+
+                ok ! ( defined($io->getline)  ||
+                          (@tmp = $io->getlines) ||
+                          defined(<$io>)         ||
+                          defined($io->getc)     ||
+                          read($io, $buf, 100)   != 0) ;
+            }
+            
+            
+            {
+                local $/;  # slurp mode
+                my $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my @lines = $io->getlines;
+                ok $io->eof;
+                ok @lines == 1 && $lines[0] eq $str;
+            
+                $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my $line = <$io>;
+                ok $line eq $str;
+                ok $io->eof;
+            }
+            
+            {
+                local $/ = "";  # paragraph mode
+                my $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my @lines = <$io>;
+                ok $io->eof;
+                ok @lines == 2 
+                    or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
+                ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
+                    or print "# $lines[0]\n";
+                ok $lines[1] eq "and a single line.\n\n";
+            }
+            
+            {
+                local $/ = "is";
+                my $io = $UncompressClass->new($name);
+                my @lines = ();
+                my $no = 0;
+                my $err = 0;
+                ok ! $io->eof;
+                while (<$io>) {
+                    push(@lines, $_);
+                    $err++ if $. != ++$no;
+                }
+            
+                ok $err == 0 ;
+                ok $io->eof;
+            
+                ok @lines == 3 
+                    or print "# Got " . scalar(@lines) . " lines, expected 3\n" ;
+                ok join("-", @lines) eq
+                                 "This- is- an example\n" .
+                                "of a paragraph\n\n\n" .
+                                "and a single line.\n\n";
+            }
+            
+            
+            # Test read
+            
+            {
+                my $io = $UncompressClass->new($name);
+
+                ok $io, "opened ok" ;
+            
+                #eval { read($io, $buf, -1); } ;
+                #like $@, mkErr("length parameter is negative"), "xxx $io $UncompressClass $RawInflateError" ;
+
+                #eval { read($io, 1) } ;
+                #like $@, mkErr("buffer parameter is read-only");
+
+                is read($io, $buf, 0), 0, "Requested 0 bytes" ;
+
+                ok read($io, $buf, 3) == 3 ;
+                ok $buf eq "Thi";
+            
+                ok sysread($io, $buf, 3, 2) == 3 ;
+                ok $buf eq "Ths i"
+                    or print "# [$buf]\n" ;;
+                ok ! $io->eof;
+            
+        #        $io->seek(-4, 2);
+        #    
+        #        ok ! $io->eof;
+        #    
+        #        ok read($io, $buf, 20) == 4 ;
+        #        ok $buf eq "e.\n\n";
+        #    
+        #        ok read($io, $buf, 20) == 0 ;
+        #        ok $buf eq "";
+        #   
+        #        ok ! $io->eof;
+            }
+
+        }
+
+
+
+        {
+            title "seek tests" ;
+
+            my $lex = new LexFile my $name ;
+
+            my $first = "beginning" ;
+            my $last  = "the end" ;
+            my $iow = new $CompressClass $name ;
+            print $iow $first ;
+            ok seek $iow, 10, SEEK_CUR ;
+            is tell($iow), length($first)+10;
+            ok $iow->seek(0, SEEK_CUR) ;
+            is tell($iow), length($first)+10;
+            print $iow $last ;
+            close $iow;
+
+            my $io = $UncompressClass->new($name);
+            ok myGZreadFile($name) eq $first . "\x00" x 10 . $last ;
+
+            $io = $UncompressClass->new($name);
+            ok seek $io, length($first)+10, SEEK_CUR ;
+            ok ! $io->eof;
+            is tell($io), length($first)+10;
+            ok seek $io, 0, SEEK_CUR ;
+            is tell($io), length($first)+10;
+            my $buff ;
+            ok read $io, $buff, 100 ;
+            ok $buff eq $last ;
+            ok $io->eof;
+        }
+
+        if (! $BadPerl)
+        {
+            # seek error cases
+            my $b ;
+            my $a = new $CompressClass(\$b)  ;
+
+            ok ! $a->error() ;
+            eval { seek($a, -1, 10) ; };
+            like $@, mkErr("seek: unknown value, 10, for whence parameter");
+
+            eval { seek($a, -1, SEEK_END) ; };
+            like $@, mkErr("cannot seek backwards");
+
+            print $a "fred";
+            close $a ;
+
+
+            my $u = new $UncompressClass(\$b)  ;
+
+            eval { seek($u, -1, 10) ; };
+            like $@, mkErr("seek: unknown value, 10, for whence parameter");
+
+            eval { seek($u, -1, SEEK_END) ; };
+            like $@, mkErr("seek: SEEK_END not allowed");
+
+            eval { seek($u, -1, SEEK_CUR) ; };
+            like $@, mkErr("cannot seek backwards");
+        }
+
+        {
+            title 'fileno' ;
+
+            my $lex = new LexFile my $name ;
+
+            my $hello = <<EOM ;
+hello world
+this is a test
+EOM
+
+            {
+              my $fh ;
+              ok $fh = new IO::File ">$name" ;
+              my $x ;
+              ok $x = new $CompressClass $fh  ;
+
+              ok $x->fileno() == fileno($fh) ;
+              ok $x->fileno() == fileno($x) ;
+              ok $x->write($hello) ;
+              ok $x->close ;
+              $fh->close() ;
+            }
+
+            my $uncomp;
+            {
+              my $x ;
+              ok my $fh1 = new IO::File "<$name" ;
+              ok $x = new $UncompressClass $fh1, -Append => 1  ;
+              ok $x->fileno() == fileno $fh1 ;
+              ok $x->fileno() == fileno $x ;
+
+              1 while $x->read($uncomp) > 0 ;
+
+              ok $x->close ;
+            }
+
+            ok $hello eq $uncomp ;
+        }
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/t/lib/compress/oneshot.pl b/gnu/usr.bin/perl/t/lib/compress/oneshot.pl
new file mode 100644
index 00000000000..0646958d89d
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/compress/oneshot.pl
@@ -0,0 +1,1560 @@
+use lib 't';
+use strict;
+use warnings;
+use bytes;
+
+use Test::More ;
+use CompTestUtils;
+
+BEGIN {
+    plan(skip_all => "oneshot needs Perl 5.005 or better - you have Perl $]" )
+        if $] < 5.005 ;
+
+
+    # use Test::NoWarnings, if available
+    my $extra = 0 ;
+    $extra = 1
+        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
+
+    plan tests => 970 + $extra ;
+
+    use_ok('IO::Uncompress::AnyUncompress', qw(anyuncompress $AnyUncompressError)) ;
+
+}
+
+sub run
+{
+
+    my $CompressClass   = identify();
+    my $UncompressClass = getInverse($CompressClass);
+    my $Error           = getErrorRef($CompressClass);
+    my $UnError         = getErrorRef($UncompressClass);
+    my $TopFuncName     = getTopFuncName($CompressClass);
+
+
+    my @MultiValues     = getMultiValues($CompressClass);
+
+    foreach my $bit ($CompressClass, $UncompressClass,
+                     'IO::Uncompress::AnyUncompress',
+                    )
+    {
+        my $Error = getErrorRef($bit);
+        my $Func = getTopFuncRef($bit);
+        my $TopType = getTopFuncName($bit);
+
+        title "Testing $TopType Error Cases";
+
+        my $a;
+        my $x ;
+
+        eval { $a = $Func->(\$a => \$x, Fred => 1) ;} ;
+        like $@, mkErr("^$TopType: unknown key value\\(s\\) Fred"), '  Illegal Parameters';
+
+        eval { $a = $Func->() ;} ;
+        like $@, "/^$TopType: expected at least 1 parameters/", '  No Parameters';
+
+        eval { $a = $Func->(\$x, \1) ;} ;
+        like $$Error, "/^$TopType: output buffer is read-only/", '  Output is read-only' ;
+
+        my $in ;
+        eval { $a = $Func->($in, \$x) ;} ;
+        like $@, mkErr("^$TopType: input filename is undef or null string"), 
+            '  Input filename undef' ;
+
+        $in = '';    
+        eval { $a = $Func->($in, \$x) ;} ;
+        like $@, mkErr("^$TopType: input filename is undef or null string"), 
+            '  Input filename empty' ;
+
+        {
+            my $lex1 = new LexFile my $in ;
+            writeFile($in, "abc");
+            my $out = $in ;
+            eval { $a = $Func->($in, $out) ;} ;
+            like $@, mkErr("^$TopType: input and output filename are identical"),
+                '  Input and Output filename are the same';
+        }
+
+        {
+            my $dir = "tmpdir";
+            my $lex = new LexDir $dir ;
+            mkdir $dir, 0777 ;
+
+            $a = $Func->($dir, \$x) ;
+            is $a, undef, "  $TopType returned undef";
+            like $$Error, "/input file '$dir' is a directory/",
+                '  Input filename is a directory';
+
+            $a = $Func->(\$x, $dir) ;
+            is $a, undef, "  $TopType returned undef";
+            like $$Error, "/output file '$dir' is a directory/",
+                '  Output filename is a directory';
+        }
+
+        eval { $a = $Func->(\$in, \$in) ;} ;
+        like $@, mkErr("^$TopType: input and output buffer are identical"),
+            '  Input and Output buffer are the same';
+            
+        SKIP:
+        {
+            # Threaded 5.6.x seems to have a problem comparing filehandles.
+            use Config;
+
+            skip 'Cannot compare filehandles with threaded $]', 2
+                if $] >= 5.006  && $] < 5.007 && $Config{useithreads};
+
+            my $lex = new LexFile my $out_file ;
+            open OUT, ">$out_file" ;
+            eval { $a = $Func->(\*OUT, \*OUT) ;} ;
+            like $@, mkErr("^$TopType: input and output handle are identical"),
+                '  Input and Output handle are the same';
+                
+            close OUT;
+            is -s $out_file, 0, "  File zero length" ;
+        }
+
+        {
+            my %x = () ;
+            my $object = bless \%x, "someClass" ;
+
+            # Buffer not a scalar reference
+            #eval { $a = $Func->(\$x, \%x) ;} ;
+            eval { $a = $Func->(\$x, $object) ;} ;
+            like $@, mkErr("^$TopType: illegal output parameter"),
+                '  Bad Output Param';
+                
+            # Buffer not a scalar reference
+            eval { $a = $Func->(\$x, \%x) ;} ;
+            like $@, mkErr("^$TopType: illegal output parameter"),
+                '  Bad Output Param';
+                
+
+            eval { $a = $Func->(\%x, \$x) ;} ;
+            like $@, mkErr("^$TopType: illegal input parameter"),
+                '  Bad Input Param';
+
+            #eval { $a = $Func->(\%x, \$x) ;} ;
+            eval { $a = $Func->($object, \$x) ;} ;
+            like $@, mkErr("^$TopType: illegal input parameter"),
+                '  Bad Input Param';
+        }
+
+        my $filename = 'abc.def';
+        ok ! -e $filename, "  input file '$filename' does not exist";
+        $a = $Func->($filename, \$x) ;
+        is $a, undef, "  $TopType returned undef";
+        like $$Error, "/^input file '$filename' does not exist\$/", "  input File '$filename' does not exist";
+            
+        $filename = '/tmp/abd/abc.def';
+        ok ! -e $filename, "  output File '$filename' does not exist";
+        $a = $Func->(\$x, $filename) ;
+        is $a, undef, "  $TopType returned undef";
+        like $$Error, ("/^(cannot open file '$filename'|input file '$filename' does not exist):/"), "  output File '$filename' does not exist";
+            
+        eval { $a = $Func->(\$x, '<abc>') } ;
+        like $$Error, "/Need input fileglob for outout fileglob/",
+                '  Output fileglob with no input fileglob';
+        is $a, undef, "  $TopType returned undef";
+
+        $a = $Func->('<abc)>', '<abc>') ;
+        is $a, undef, "  $TopType returned undef";
+        like $$Error, "/Unmatched \\) in input fileglob/",
+                "  Unmatched ) in input fileglob";
+    }
+
+    foreach my $bit ($UncompressClass,
+                     'IO::Uncompress::AnyUncompress',
+                    )
+    {
+        my $Error = getErrorRef($bit);
+        my $Func = getTopFuncRef($bit);
+        my $TopType = getTopFuncName($bit);
+
+        {
+            my $in ;
+            my $out ;
+            my @x ;
+
+            SKIP:
+            {
+                use Config;
+
+                skip 'readonly + threads', 1
+                    if $Config{useithreads};
+
+                
+                eval { $a = $Func->(\$in, \$out, TrailingData => \"abc") ;} ;
+                like $@, mkErr("^$TopType: Parameter 'TrailingData' not writable"),
+                    '  TrailingData output not writable';
+            }
+
+            eval { $a = $Func->(\$in, \$out, TrailingData => \@x) ;} ;
+            like $@, mkErr("^$TopType: Parameter 'TrailingData' not a scalar reference"),
+                '  TrailingData output not scaral reference';
+        }
+    }
+
+    foreach my $bit ($UncompressClass,
+                     'IO::Uncompress::AnyUncompress',
+                    )
+    {
+        my $Error = getErrorRef($bit);
+        my $Func = getTopFuncRef($bit);
+        my $TopType = getTopFuncName($bit);
+
+        my $data = "mary had a little lamb" ;
+        my $keep = $data ;
+
+        for my $trans ( 0, 1)
+        {
+            title "Non-compressed data with $TopType, Transparent => $trans ";
+            my $a;
+            my $x ;
+            my $out = '' ;
+
+            $a = $Func->(\$data, \$out, Transparent => $trans) ;
+
+            is $data, $keep, "  Input buffer not changed" ;
+
+            if ($trans)
+            {
+                ok $a, "  $TopType returned true" ;
+                is $out, $data, "  got expected output" ;
+                ok ! $$Error, "  no error [$$Error]" ;
+            }
+            else
+            {
+                ok ! $a, "  $TopType returned false" ;
+                #like $$Error, '/xxx/', "  error" ;
+                ok $$Error, "  error is '$$Error'" ;
+            }
+        }
+    }
+
+    foreach my $bit ($CompressClass
+                    )
+    {
+        my $Error = getErrorRef($bit);
+        my $Func = getTopFuncRef($bit);
+        my $TopType = getTopFuncName($bit);
+        my $TopTypeInverse = getInverse($bit);
+        my $FuncInverse = getTopFuncRef($TopTypeInverse);
+        my $ErrorInverse = getErrorRef($TopTypeInverse);
+
+        title "$TopTypeInverse - corrupt data";
+
+        my $data = "abcd" x 100 ;
+        my $out;
+
+        ok $Func->(\$data, \$out), "  $TopType ok";
+
+        # corrupt the compressed data
+        #substr($out, -10, 10) = "x" x 10 ;
+        substr($out, int(length($out)/3), 10) = 'abcdeabcde';
+
+        my $result;
+        ok ! $FuncInverse->(\$out => \$result, Transparent => 0), "  $TopTypeInverse ok";
+        ok $$ErrorInverse, "  Got error '$$ErrorInverse'" ;
+
+        #is $result, $data, "  data ok";
+
+        ok ! anyuncompress(\$out => \$result, Transparent => 0), "anyuncompress ok";
+        ok $AnyUncompressError, "  Got error '$AnyUncompressError'" ;
+    }
+
+
+    foreach my $bit ($CompressClass
+                    )
+    {
+        my $Error = getErrorRef($bit);
+        my $Func = getTopFuncRef($bit);
+        my $TopType = getTopFuncName($bit);
+        my $TopTypeInverse = getInverse($bit);
+        my $FuncInverse = getTopFuncRef($TopTypeInverse);
+
+        my @opts = ();
+        @opts = (RawInflate => 1)
+            if $CompressClass eq 'IO::Compress::RawInflate';
+
+        for my $append ( 1, 0 )
+        {
+            my $already = '';
+            $already = 'abcde' if $append ;
+
+            for my $buffer ( undef, '', "abcde" )
+            {
+
+                my $disp_content = defined $buffer ? $buffer : '<undef>' ;
+
+                my $keep = $buffer;
+                my $out_file = "abcde.out";
+                my $in_file = "abcde.in";
+
+                {
+                    title "$TopType - From Buff to Buff content '$disp_content' Append $append" ;
+
+                    my $output = $already;
+                    ok &$Func(\$buffer, \$output, Append => $append), '  Compressed ok' ;
+
+                    is $keep, $buffer, "  Input buffer not changed" ;
+                    my $got = anyUncompress(\$output, $already);
+                    $got = undef if ! defined $buffer && $got eq '' ;
+                    is $got, $buffer, "  Uncompressed matches original";
+
+                }
+
+                {
+                    title "$TopType - From Buff to Array Ref content '$disp_content' Append $append" ;
+
+                    my @output = ('first') ;
+                    ok &$Func(\$buffer, \@output, Append => $append), '  Compressed ok' ;
+
+                    is $output[0], 'first', "  Array[0] unchanged";
+                    is $keep, $buffer, "  Input buffer not changed" ;
+                    my $got = anyUncompress($output[1]);
+                    $got = undef if ! defined $buffer && $got eq '' ;
+                    is $got, $buffer, "  Uncompressed matches original";
+                }
+
+                {
+                    title "$TopType - From Array Ref to Array Ref content '$disp_content' Append $append" ;
+
+                    my $lex = new LexFile my $in_file ;
+                    writeFile($in_file, $buffer);
+                    my @output = ('first') ;
+                    my @input = ($in_file);
+                    ok &$Func(\@input, \@output, Append => $append), '  Compressed ok' ;
+
+                    is $output[0], 'first', "  Array[0] unchanged";
+                    my $got = anyUncompress($output[1]);
+                    $got = undef if ! defined $buffer && $got eq '' ;
+                    is $got, $buffer, "  Uncompressed matches original";
+                }
+
+                {
+                    title "$TopType - From Buff to Filename content '$disp_content' Append $append" ;
+
+                    my $lex = new LexFile my $out_file ;
+                    ok ! -e $out_file, "  Output file does not exist";
+                    writeFile($out_file, $already);
+
+                    ok &$Func(\$buffer, $out_file, Append => $append), '  Compressed ok' ;
+
+                    ok -e $out_file, "  Created output file";
+                    my $got = anyUncompress($out_file, $already);
+                    $got = undef if ! defined $buffer && $got eq '' ;
+                    is $got, $buffer, "  Uncompressed matches original";
+                }
+
+                {
+                    title "$TopType - From Buff to Handle content '$disp_content' Append $append" ;
+
+                    my $lex = new LexFile my $out_file ;
+
+                    ok ! -e $out_file, "  Output file does not exist";
+                    writeFile($out_file, $already);
+                    my $of = new IO::File ">>$out_file" ;
+                    ok $of, "  Created output filehandle" ;
+
+                    ok &$Func(\$buffer, $of, AutoClose => 1, Append => $append), '  Compressed ok' ;
+
+                    ok -e $out_file, "  Created output file";
+                    my $got = anyUncompress($out_file, $already);
+                    $got = undef if ! defined $buffer && $got eq '' ;
+                    is $got, $buffer, "  Uncompressed matches original";
+                }
+
+
+                {
+                    title "$TopType - From Filename to Filename content '$disp_content' Append $append" ;
+
+                    my $lex = new LexFile(my $in_file, my $out_file) ;
+                    writeFile($in_file, $buffer);
+
+                    ok ! -e $out_file, "  Output file does not exist";
+                    writeFile($out_file, $already);
+
+                    ok &$Func($in_file => $out_file, Append => $append), '  Compressed ok' ;
+
+                    ok -e $out_file, "  Created output file";
+                    my $got = anyUncompress($out_file, $already);
+                    $got = undef if ! defined $buffer && $got eq '' ;
+                    is $got, $buffer, "  Uncompressed matches original";
+
+                }
+
+                {
+                    title "$TopType - From Filename to Handle content '$disp_content' Append $append" ;
+
+                    my $lex = new LexFile(my $in_file, my $out_file) ;
+                    writeFile($in_file, $buffer);
+
+                    ok ! -e $out_file, "  Output file does not exist";
+                    writeFile($out_file, $already);
+                    my $out = new IO::File ">>$out_file" ;
+
+                    ok &$Func($in_file, $out, AutoClose => 1, Append => $append), '  Compressed ok' ;
+
+                    ok -e $out_file, "  Created output file";
+                    my $got = anyUncompress($out_file, $already);
+                    $got = undef if ! defined $buffer && $got eq '' ;
+                    is $got, $buffer, "  Uncompressed matches original";
+
+                }
+
+                {
+                    title "$TopType - From Filename to Buffer content '$disp_content' Append $append" ;
+
+                    my $lex = new LexFile(my $in_file, my $out_file) ;
+                    writeFile($in_file, $buffer);
+
+                    my $out = $already;
+
+                    ok &$Func($in_file => \$out, Append => $append), '  Compressed ok' ;
+
+                    my $got = anyUncompress(\$out, $already);
+                    $got = undef if ! defined $buffer && $got eq '' ;
+                    is $got, $buffer, "  Uncompressed matches original";
+
+                }
+                
+                {
+                    title "$TopType - From Handle to Filename content '$disp_content' Append $append" ;
+
+                    my $lex = new LexFile(my $in_file, my $out_file) ;
+                    writeFile($in_file, $buffer);
+                    my $in = new IO::File "<$in_file" ;
+
+                    ok ! -e $out_file, "  Output file does not exist";
+                    writeFile($out_file, $already);
+
+                    ok &$Func($in, $out_file, Append => $append), '  Compressed ok' 
+                        or diag "error is $$Error" ;
+
+                    ok -e $out_file, "  Created output file";
+                    my $got = anyUncompress($out_file, $already);
+                    $got = undef if ! defined $buffer && $got eq '' ;
+                    is $buffer, $got, "  Uncompressed matches original";
+
+                }
+
+                {
+                    title "$TopType - From Handle to Handle content '$disp_content' Append $append" ;
+
+                    my $lex = new LexFile(my $in_file, my $out_file) ;
+                    writeFile($in_file, $buffer);
+                    my $in = new IO::File "<$in_file" ;
+
+                    ok ! -e $out_file, "  Output file does not exist";
+                    writeFile($out_file, $already);
+                    my $out = new IO::File ">>$out_file" ;
+
+                    ok &$Func($in, $out, AutoClose => 1, Append => $append), '  Compressed ok' ;
+
+                    ok -e $out_file, "  Created output file";
+                    my $got = anyUncompress($out_file, $already);
+                    $got = undef if ! defined $buffer && $got eq '' ;
+                    is $buffer, $got, "  Uncompressed matches original";
+
+                }
+
+                {
+                    title "$TopType - From Handle to Buffer content '$disp_content' Append $append" ;
+
+                    my $lex = new LexFile(my $in_file, my $out_file) ;
+                    writeFile($in_file, $buffer);
+                    my $in = new IO::File "<$in_file" ;
+
+                    my $out = $already ;
+
+                    ok &$Func($in, \$out, Append => $append), '  Compressed ok' ;
+
+                    my $got = anyUncompress(\$out, $already);
+                    $got = undef if ! defined $buffer && $got eq '' ;
+                    is $buffer, $got, "  Uncompressed matches original";
+
+                }
+
+                {
+                    title "$TopType - From stdin (via '-') to Buffer content '$disp_content' Append $append" ;
+
+                    my $lex = new LexFile(my $in_file, my $out_file) ;
+                    writeFile($in_file, $buffer);
+
+                       open(SAVEIN, "<&STDIN");
+                    my $dummy = fileno SAVEIN ;
+                    ok open(STDIN, "<$in_file"), "  redirect STDIN";
+
+                    my $out = $already;
+
+                    ok &$Func('-', \$out, Append => $append), '  Compressed ok' 
+                        or diag $$Error ;
+
+                       open(STDIN, "<&SAVEIN");
+
+                    my $got = anyUncompress(\$out, $already);
+                    $got = undef if ! defined $buffer && $got eq '' ;
+                    is $buffer, $got, "  Uncompressed matches original";
+
+                }
+
+            }
+        }
+    }
+
+    foreach my $bit ($CompressClass)
+    {
+        my $Error = getErrorRef($bit);
+        my $Func = getTopFuncRef($bit);
+        my $TopType = getTopFuncName($bit);
+
+        my $TopTypeInverse = getInverse($bit);
+        my $FuncInverse = getTopFuncRef($TopTypeInverse);
+
+        my $lex = new LexFile(my $file1, my $file2) ;
+
+        writeFile($file1, "data1");
+        writeFile($file2, "data2");
+        my $of = new IO::File "<$file1" ;
+        ok $of, "  Created output filehandle" ;
+
+        #my @input = (   undef, "", $file2, \undef, \'', \"abcde", $of) ;
+        #my @expected = ("", "", $file2, "", "", "abcde", "data1");
+        #my @uexpected = ("", "", "data2", "", "", "abcde", "data1");
+        #my @input = (   $file2, \"abcde", $of) ;
+        #my @expected = ( $file2, "abcde", "data1");
+        #my @uexpected = ("data2", "abcde", "data1");
+
+        my @input = (   $file1, $file2) ;
+        #my @expected = ( $file1, $file2);
+        my @expected = ("data1", "data2");
+        my @uexpected = ("data1", "data2");
+
+        my @keep = @input ;
+
+        {
+            title "$TopType - From Array Ref to Array Ref" ;
+
+            my @output = ('first') ;
+            ok &$Func(\@input, \@output, AutoClose => 0), '  Compressed ok' ;
+
+            is $output[0], 'first', "  Array[0] unchanged";
+
+            is_deeply \@input, \@keep, "  Input array not changed" ;
+            my @got = shift @output;
+            foreach (@output) { push @got, anyUncompress($_) }
+
+            is_deeply \@got, ['first', @expected], "  Got Expected uncompressed data";
+
+        }
+
+        foreach my $ms (@MultiValues)
+        {
+            {
+                title "$TopType - From Array Ref to Buffer, MultiStream $ms" ;
+
+                # rewind the filehandle
+                $of->open("<$file1") ;
+
+                my $output  ;
+                ok &$Func(\@input, \$output, MultiStream => $ms, AutoClose => 0), '  Compressed ok' 
+                    or diag $$Error;
+
+                my $got = anyUncompress([ \$output, MultiStream => $ms ]);
+
+                is $got, join('', @uexpected), "  Got Expected uncompressed data";
+                my @headers = getHeaders(\$output);
+                is @headers, $ms ? @input : 1, "  Header count ok";
+            }
+
+            {
+                title "$TopType - From Array Ref to Filename, MultiStream $ms" ;
+
+                my $lex = new LexFile( my $file3) ;
+
+                # rewind the filehandle
+                $of->open("<$file1") ;
+
+                my $output  ;
+                ok &$Func(\@input, $file3, MultiStream => $ms, AutoClose => 0), '  Compressed ok' ;
+
+                my $got = anyUncompress([ $file3, MultiStream => $ms ]);
+
+                is $got, join('', @uexpected), "  Got Expected uncompressed data";
+                my @headers = getHeaders($file3);
+                is @headers, $ms ? @input : 1, "  Header count ok";
+            }
+
+            {
+                title "$TopType - From Array Ref to Filehandle, MultiStream $ms" ;
+
+                my $lex = new LexFile(my $file3) ;
+
+                my $fh3 = new IO::File ">$file3";
+
+                # rewind the filehandle
+                $of->open("<$file1") ;
+
+                my $output  ;
+                ok &$Func(\@input, $fh3, MultiStream => $ms, AutoClose => 0), '  Compressed ok' ;
+
+                $fh3->close();
+
+                my $got = anyUncompress([ $file3, MultiStream => $ms ]);
+
+                is $got, join('', @uexpected), "  Got Expected uncompressed data";
+                my @headers = getHeaders($file3);
+                is @headers, $ms ? @input : 1, "  Header count ok";
+            }
+        }
+    }
+
+    foreach my $bit ($UncompressClass,
+                    #'IO::Uncompress::AnyUncompress',
+                    )
+    {
+        my $Error = getErrorRef($bit);
+        my $Func = getTopFuncRef($bit);
+        my $TopType = getTopFuncName($bit);
+        my $CompressClass = getInverse($bit);
+        my $C_Func = getTopFuncRef($CompressClass);
+
+
+        
+        my $data = "mary had a little lamb" ;
+        my $keep = $data ;
+        my $extra = "after the main event";
+
+        foreach my $fb ( qw( filehandle buffer ) )
+        {
+            title "Trailingdata with $TopType, from $fb";
+
+            my $lex = new LexFile my $name ;
+            my $input ;
+
+            my $compressed ;
+            ok &$C_Func(\$data, \$compressed), '  Compressed ok' ;
+            $compressed .= $extra;
+
+            if ($fb eq 'buffer')
+            {
+                $input = \$compressed;
+            }
+            else
+            {
+                writeFile($name, $compressed);
+
+                $input = new IO::File "<$name" ;
+            }
+
+            my $trailing;
+            my $out;
+            ok $Func->($input, \$out, TrailingData => $trailing), "  Uncompressed OK" ;
+            is $out, $keep, "  Got uncompressed data";
+
+            my $rest = '';
+            if ($fb eq 'filehandle')
+            {
+                read($input, $rest, 10000) ;
+            }
+
+            is $trailing . $rest, $extra, "  Got trailing data";
+            
+        }
+    }
+
+
+#    foreach my $bit ($CompressClass)
+#    {
+#        my $Error = getErrorRef($bit);
+#        my $Func = getTopFuncRef($bit);
+#        my $TopType = getTopFuncName($bit);
+#
+#        my $TopTypeInverse = getInverse($bit);
+#        my $FuncInverse = getTopFuncRef($TopTypeInverse);
+#
+#        my @inFiles  = map { "in$_.tmp"  } 1..4;
+#        my @outFiles = map { "out$_.tmp" } 1..4;
+#        my $lex = new LexFile(@inFiles, @outFiles);
+#
+#        writeFile($_, "data $_") foreach @inFiles ;
+#        
+#        {
+#            title "$TopType - Hash Ref: to filename" ;
+#
+#            my $output ;
+#            ok &$Func( { $inFiles[0] => $outFiles[0],
+#                         $inFiles[1] => $outFiles[1],
+#                         $inFiles[2] => $outFiles[2] } ), '  Compressed ok' ;
+#
+#            foreach (0 .. 2)
+#            {
+#                my $got = anyUncompress($outFiles[$_]);
+#                is $got, "data $inFiles[$_]", "  Uncompressed $_ matches original";
+#            }
+#        }
+#
+#        {
+#            title "$TopType - Hash Ref: to buffer" ;
+#
+#            my @buffer ;
+#            ok &$Func( { $inFiles[0] => \$buffer[0],
+#                         $inFiles[1] => \$buffer[1],
+#                         $inFiles[2] => \$buffer[2] } ), '  Compressed ok' ;
+#
+#            foreach (0 .. 2)
+#            {
+#                my $got = anyUncompress(\$buffer[$_]);
+#                is $got, "data $inFiles[$_]", "  Uncompressed $_ matches original";
+#            }
+#        }
+#
+#        {
+#            title "$TopType - Hash Ref: to undef" ;
+#
+#            my @buffer ;
+#            my %hash = ( $inFiles[0] => undef,
+#                         $inFiles[1] => undef,
+#                         $inFiles[2] => undef, 
+#                     );  
+#
+#            ok &$Func( \%hash ), '  Compressed ok' ;
+#
+#            foreach (keys %hash)
+#            {
+#                my $got = anyUncompress(\$hash{$_});
+#                is $got, "data $_", "  Uncompressed $_ matches original";
+#            }
+#        }
+#
+#        {
+#            title "$TopType - Filename to Hash Ref" ;
+#
+#            my %output ;
+#            ok &$Func( $inFiles[0] => \%output), '  Compressed ok' ;
+#
+#            is keys %output, 1, "  one pair in hash" ;
+#            my ($k, $v) = each %output;
+#            is $k, $inFiles[0], "  key is '$inFiles[0]'";
+#            my $got = anyUncompress($v);
+#            is $got, "data $inFiles[0]", "  Uncompressed matches original";
+#        }
+#
+#        {
+#            title "$TopType - File Glob to Hash Ref" ;
+#
+#            my %output ;
+#            ok &$Func( '<in*.tmp>' => \%output), '  Compressed ok' ;
+#
+#            is keys %output, 4, "  four pairs in hash" ;
+#            foreach my $fil (@inFiles)
+#            {
+#                ok exists $output{$fil}, "  key '$fil' exists" ;
+#                my $got = anyUncompress($output{$fil});
+#                is $got, "data $fil", "  Uncompressed matches original";
+#            }
+#        }
+#
+#
+#    }
+
+#    foreach my $bit ($CompressClass)
+#    {
+#        my $Error = getErrorRef($bit);
+#        my $Func = getTopFuncRef($bit);
+#        my $TopType = getTopFuncName($bit);
+#
+#        my $TopTypeInverse = getInverse($bit);
+#        my $FuncInverse = getTopFuncRef($TopTypeInverse);
+#
+#        my @inFiles  = map { "in$_.tmp"  } 1..4;
+#        my @outFiles = map { "out$_.tmp" } 1..4;
+#        my $lex = new LexFile(@inFiles, @outFiles);
+#
+#        writeFile($_, "data $_") foreach @inFiles ;
+#        
+#
+#
+#    #    if (0)
+#    #    {
+#    #        title "$TopType - Hash Ref to Array Ref" ;
+#    #
+#    #        my @output = ('first') ;
+#    #        ok &$Func( { \@input, \@output } , AutoClose => 0), '  Compressed ok' ;
+#    #
+#    #        is $output[0], 'first', "  Array[0] unchanged";
+#    #
+#    #        is_deeply \@input, \@keep, "  Input array not changed" ;
+#    #        my @got = shift @output;
+#    #        foreach (@output) { push @got, anyUncompress($_) }
+#    #
+#    #        is_deeply \@got, ['first', @expected], "  Got Expected uncompressed data";
+#    #
+#    #    }
+#    #
+#    #    if (0)
+#    #    {
+#    #        title "$TopType - From Array Ref to Buffer" ;
+#    #
+#    #        # rewind the filehandle
+#    #        $of->open("<$file1") ;
+#    #
+#    #        my $output  ;
+#    #        ok &$Func(\@input, \$output, AutoClose => 0), '  Compressed ok' ;
+#    #
+#    #        my $got = anyUncompress(\$output);
+#    #
+#    #        is $got, join('', @expected), "  Got Expected uncompressed data";
+#    #    }
+#    #
+#    #    if (0)
+#    #    {
+#    #        title "$TopType - From Array Ref to Filename" ;
+#    #
+#    #        my ($file3) = ("file3");
+#    #        my $lex = new LexFile($file3) ;
+#    #
+#    #        # rewind the filehandle
+#    #        $of->open("<$file1") ;
+#    #
+#    #        my $output  ;
+#    #        ok &$Func(\@input, $file3, AutoClose => 0), '  Compressed ok' ;
+#    #
+#    #        my $got = anyUncompress($file3);
+#    #
+#    #        is $got, join('', @expected), "  Got Expected uncompressed data";
+#    #    }
+#    #
+#    #    if (0)
+#    #    {
+#    #        title "$TopType - From Array Ref to Filehandle" ;
+#    #
+#    #        my ($file3) = ("file3");
+#    #        my $lex = new LexFile($file3) ;
+#    #
+#    #        my $fh3 = new IO::File ">$file3";
+#    #
+#    #        # rewind the filehandle
+#    #        $of->open("<$file1") ;
+#    #
+#    #        my $output  ;
+#    #        ok &$Func(\@input, $fh3, AutoClose => 0), '  Compressed ok' ;
+#    #
+#    #        $fh3->close();
+#    #
+#    #        my $got = anyUncompress($file3);
+#    #
+#    #        is $got, join('', @expected), "  Got Expected uncompressed data";
+#    #    }
+#    }
+
+    foreach my $bit ($CompressClass
+                    )
+    {
+        my $Error = getErrorRef($bit);
+        my $Func = getTopFuncRef($bit);
+        my $TopType = getTopFuncName($bit);
+
+        for my $files ( [qw(a1)], [qw(a1 a2 a3)] )
+        {
+
+            my $tmpDir1 = 'tmpdir1';
+            my $tmpDir2 = 'tmpdir2';
+            my $lex = new LexDir($tmpDir1, $tmpDir2) ;
+
+            mkdir $tmpDir1, 0777;
+            mkdir $tmpDir2, 0777;
+
+            ok   -d $tmpDir1, "  Temp Directory $tmpDir1 exists";
+            #ok ! -d $tmpDir2, "  Temp Directory $tmpDir2 does not exist";
+
+            my @files = map { "$tmpDir1/$_.tmp" } @$files ;
+            foreach (@files) { writeFile($_, "abc $_") }
+
+            my @expected = map { "abc $_" } @files ;
+            my @outFiles = map { s/$tmpDir1/$tmpDir2/; $_ } @files ;
+
+            {
+                title "$TopType - From FileGlob to FileGlob files [@$files]" ;
+
+                ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>"), '  Compressed ok' 
+                    or diag $$Error ;
+
+                my @copy = @expected;
+                for my $file (@outFiles)
+                {
+                    is anyUncompress($file), shift @copy, "  got expected from $file" ;
+                }
+
+                is @copy, 0, "  got all files";
+            }
+
+            {
+                title "$TopType - From FileGlob to Array files [@$files]" ;
+
+                my @buffer = ('first') ;
+                ok &$Func("<$tmpDir1/a*.tmp>" => \@buffer), '  Compressed ok' 
+                    or diag $$Error ;
+
+                is shift @buffer, 'first';
+
+                my @copy = @expected;
+                for my $buffer (@buffer)
+                {
+                    is anyUncompress($buffer), shift @copy, "  got expected " ;
+                }
+
+                is @copy, 0, "  got all files";
+            }
+
+            foreach my $ms (@MultiValues)
+            {
+                {
+                    title "$TopType - From FileGlob to Buffer files [@$files], MS $ms" ;
+
+                    my $buffer ;
+                    ok &$Func("<$tmpDir1/a*.tmp>" => \$buffer, 
+                               MultiStream => $ms), '  Compressed ok' 
+                        or diag $$Error ;
+
+                    #hexDump(\$buffer);
+
+                    my $got = anyUncompress([ \$buffer, MultiStream => $ms ]);
+
+                    is $got, join("", @expected), "  got expected" ;
+                    my @headers = getHeaders(\$buffer);
+                    is @headers, $ms ? @files : 1, "  Header count ok";
+                }
+
+                {
+                    title "$TopType - From FileGlob to Filename files [@$files], MS $ms" ;
+
+                    my $filename = "abcde";
+                    my $lex = new LexFile($filename) ;
+                    
+                    ok &$Func("<$tmpDir1/a*.tmp>" => $filename,
+                              MultiStream => $ms), '  Compressed ok' 
+                        or diag $$Error ;
+
+                    #hexDump(\$buffer);
+
+                    my $got = anyUncompress([$filename, MultiStream => $ms]);
+
+                    is $got, join("", @expected), "  got expected" ;
+                    my @headers = getHeaders($filename);
+                    is @headers, $ms ? @files : 1, "  Header count ok";
+                }
+
+                {
+                    title "$TopType - From FileGlob to Filehandle files [@$files], MS $ms" ;
+
+                    my $filename = "abcde";
+                    my $lex = new LexFile($filename) ;
+                    my $fh = new IO::File ">$filename";
+                    
+                    ok &$Func("<$tmpDir1/a*.tmp>" => $fh, 
+                              MultiStream => $ms, AutoClose => 1), '  Compressed ok' 
+                        or diag $$Error ;
+
+                    #hexDump(\$buffer);
+
+                    my $got = anyUncompress([$filename, MultiStream => $ms]);
+
+                    is $got, join("", @expected), "  got expected" ;
+                    my @headers = getHeaders($filename);
+                    is @headers, $ms ? @files : 1, "  Header count ok";
+                }
+            }
+        }
+
+    }
+
+    foreach my $bit ($UncompressClass,
+                     'IO::Uncompress::AnyUncompress',
+                    )
+    {
+        my $Error = getErrorRef($bit);
+        my $Func = getTopFuncRef($bit);
+        my $TopType = getTopFuncName($bit);
+
+        my $buffer = "abcde" ;
+        my $buffer2 = "ABCDE" ;
+        my $keep_orig = $buffer;
+
+        my $comp = compressBuffer(getTopFuncName($UncompressClass), $buffer) ;
+        my $comp2 = compressBuffer(getTopFuncName($UncompressClass), $buffer2) ;
+        my $keep_comp = $comp;
+
+        my $incumbent = "incumbent data" ;
+
+        my @opts = (Strict => 1);
+        push @opts,  (RawInflate => 1)
+            if $bit eq 'IO::Uncompress::AnyUncompress';
+
+        for my $append (0, 1)
+        {
+            my $expected = $buffer ;
+            $expected = $incumbent . $buffer if $append ;
+
+            {
+                title "$TopType - From Buff to Buff, Append($append)" ;
+
+                my $output ;
+                $output = $incumbent if $append ;
+                ok &$Func(\$comp, \$output, Append => $append, @opts), '  Uncompressed ok' ;
+
+                is $keep_comp, $comp, "  Input buffer not changed" ;
+                is $output, $expected, "  Uncompressed matches original";
+            }
+
+            {
+                title "$TopType - From Buff to Array, Append($append)" ;
+
+                my @output = ('first');
+                #$output = $incumbent if $append ;
+                ok &$Func(\$comp, \@output, Append => $append, @opts), '  Uncompressed ok' ;
+
+                is $keep_comp, $comp, "  Input buffer not changed" ;
+                is $output[0], 'first', "  Uncompressed matches original";
+                is ${ $output[1] }, $buffer, "  Uncompressed matches original"
+                    or diag $output[1] ;
+                is @output, 2, "  only 2 elements in the array" ;
+            }
+
+            {
+                title "$TopType - From Buff to Filename, Append($append)" ;
+
+                my $lex = new LexFile(my $out_file) ;
+                if ($append)
+                  { writeFile($out_file, $incumbent) }
+                else
+                  { ok ! -e $out_file, "  Output file does not exist" }
+
+                ok &$Func(\$comp, $out_file, Append => $append, @opts), '  Uncompressed ok' ;
+
+                ok -e $out_file, "  Created output file";
+                my $content = readFile($out_file) ;
+
+                is $keep_comp, $comp, "  Input buffer not changed" ;
+                is $content, $expected, "  Uncompressed matches original";
+            }
+
+            {
+                title "$TopType - From Buff to Handle, Append($append)" ;
+
+                my $lex = new LexFile(my $out_file) ;
+                my $of ;
+                if ($append) {
+                    writeFile($out_file, $incumbent) ;
+                    $of = new IO::File "+< $out_file" ;
+                }
+                else {
+                    ok ! -e $out_file, "  Output file does not exist" ;
+                    $of = new IO::File "> $out_file" ;
+                }
+                isa_ok $of, 'IO::File', '  $of' ;
+
+                ok &$Func(\$comp, $of, Append => $append, AutoClose => 1, @opts), '  Uncompressed ok' ;
+
+                ok -e $out_file, "  Created output file";
+                my $content = readFile($out_file) ;
+
+                is $keep_comp, $comp, "  Input buffer not changed" ;
+                is $content, $expected, "  Uncompressed matches original";
+            }
+
+            {
+                title "$TopType - From Filename to Filename, Append($append)" ;
+
+                my $lex = new LexFile(my $in_file, my $out_file) ;
+                if ($append)
+                  { writeFile($out_file, $incumbent) }
+                else
+                  { ok ! -e $out_file, "  Output file does not exist" }
+
+                writeFile($in_file, $comp);
+
+                ok &$Func($in_file, $out_file, Append => $append, @opts), '  Uncompressed ok' ;
+
+                ok -e $out_file, "  Created output file";
+                my $content = readFile($out_file) ;
+
+                is $keep_comp, $comp, "  Input buffer not changed" ;
+                is $content, $expected, "  Uncompressed matches original";
+            }
+
+            {
+                title "$TopType - From Filename to Handle, Append($append)" ;
+
+                my $lex = new LexFile(my $in_file, my $out_file) ;
+                my $out ;
+                if ($append) {
+                    writeFile($out_file, $incumbent) ;
+                    $out = new IO::File "+< $out_file" ;
+                }
+                else {
+                    ok ! -e $out_file, "  Output file does not exist" ;
+                    $out = new IO::File "> $out_file" ;
+                }
+                isa_ok $out, 'IO::File', '  $out' ;
+
+                writeFile($in_file, $comp);
+
+                ok &$Func($in_file, $out, Append => $append, AutoClose => 1, @opts), '  Uncompressed ok' ;
+
+                ok -e $out_file, "  Created output file";
+                my $content = readFile($out_file) ;
+
+                is $keep_comp, $comp, "  Input buffer not changed" ;
+                is $content, $expected, "  Uncompressed matches original";
+            }
+
+            {
+                title "$TopType - From Filename to Buffer, Append($append)" ;
+
+                my $lex = new LexFile(my $in_file) ;
+                writeFile($in_file, $comp);
+
+                my $output ;
+                $output = $incumbent if $append ;
+
+                ok &$Func($in_file, \$output, Append => $append, @opts), '  Uncompressed ok' ;
+
+                is $keep_comp, $comp, "  Input buffer not changed" ;
+                is $output, $expected, "  Uncompressed matches original";
+            }
+
+            {
+                title "$TopType - From Handle to Filename, Append($append)" ;
+
+                my $lex = new LexFile(my $in_file, my $out_file) ;
+                if ($append)
+                  { writeFile($out_file, $incumbent) }
+                else
+                  { ok ! -e $out_file, "  Output file does not exist" }
+
+                writeFile($in_file, $comp);
+                my $in = new IO::File "<$in_file" ;
+
+                ok &$Func($in, $out_file, Append => $append, @opts), '  Uncompressed ok' ;
+
+                ok -e $out_file, "  Created output file";
+                my $content = readFile($out_file) ;
+
+                is $keep_comp, $comp, "  Input buffer not changed" ;
+                is $content, $expected, "  Uncompressed matches original";
+            }
+
+            {
+                title "$TopType - From Handle to Handle, Append($append)" ;
+
+                my $lex = new LexFile(my $in_file, my $out_file) ;
+                my $out ;
+                if ($append) {
+                    writeFile($out_file, $incumbent) ;
+                    $out = new IO::File "+< $out_file" ;
+                }
+                else {
+                    ok ! -e $out_file, "  Output file does not exist" ;
+                    $out = new IO::File "> $out_file" ;
+                }
+                isa_ok $out, 'IO::File', '  $out' ;
+
+                writeFile($in_file, $comp);
+                my $in = new IO::File "<$in_file" ;
+
+                ok &$Func($in, $out, Append => $append, AutoClose => 1, @opts), '  Uncompressed ok' ;
+
+                ok -e $out_file, "  Created output file";
+                my $content = readFile($out_file) ;
+
+                is $keep_comp, $comp, "  Input buffer not changed" ;
+                is $content, $expected, "  Uncompressed matches original";
+            }
+
+            {
+                title "$TopType - From Filename to Buffer, Append($append)" ;
+
+                my $lex = new LexFile(my $in_file) ;
+                writeFile($in_file, $comp);
+                my $in = new IO::File "<$in_file" ;
+
+                my $output ;
+                $output = $incumbent if $append ;
+
+                ok &$Func($in, \$output, Append => $append, @opts), '  Uncompressed ok' ;
+
+                is $keep_comp, $comp, "  Input buffer not changed" ;
+                is $output, $expected, "  Uncompressed matches original";
+            }
+
+            {
+                title "$TopType - From stdin (via '-') to Buffer content, Append($append) " ;
+
+                my $lex = new LexFile(my $in_file) ;
+                writeFile($in_file, $comp);
+
+                   open(SAVEIN, "<&STDIN");
+                my $dummy = fileno SAVEIN ;
+                ok open(STDIN, "<$in_file"), "  redirect STDIN";
+
+                my $output ;
+                $output = $incumbent if $append ;
+
+                ok &$Func('-', \$output, Append => $append, @opts), '  Uncompressed ok' 
+                    or diag $$Error ;
+
+                   open(STDIN, "<&SAVEIN");
+
+                is $keep_comp, $comp, "  Input buffer not changed" ;
+                is $output, $expected, "  Uncompressed matches original";
+            }
+        }
+
+        {
+            title "$TopType - From Handle to Buffer, InputLength" ;
+
+            my $lex = new LexFile(my $in_file, my $out_file) ;
+            my $out ;
+
+            my $expected = $buffer ;
+            my $appended = 'appended';
+            my $len_appended = length $appended;
+            writeFile($in_file, $comp . $appended . $comp . $appended) ;
+            my $in = new IO::File "<$in_file" ;
+
+            ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp, @opts), '  Uncompressed ok' ;
+
+            is $out, $expected, "  Uncompressed matches original";
+
+            my $buff;
+            is $in->read($buff, $len_appended), $len_appended, "  Length of Appended data ok";
+            is $buff, $appended, "  Appended data ok";
+
+            $out = '';
+            ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp, @opts), '  Uncompressed ok' ;
+
+            is $out, $expected, "  Uncompressed matches original";
+
+            $buff = '';
+            is $in->read($buff, $len_appended), $len_appended, "  Length of Appended data ok";
+            is $buff, $appended, "  Appended data ok";
+        }
+
+        for my $stdin ('-', *STDIN) # , \*STDIN)
+        {
+            title "$TopType - From stdin (via $stdin) to Buffer content, InputLength" ;
+
+            my $lex = new LexFile my $in_file ;
+            my $expected = $buffer ;
+            my $appended = 'appended';
+            my $len_appended = length $appended;
+            writeFile($in_file, $comp . $appended ) ;
+
+               open(SAVEIN, "<&STDIN");
+            my $dummy = fileno SAVEIN ;
+            ok open(STDIN, "<$in_file"), "  redirect STDIN";
+
+            my $output ;
+
+            ok &$Func($stdin, \$output, Transparent => 0, InputLength => length $comp, @opts), '  Uncompressed ok' 
+                or diag $$Error ;
+
+            my $buff ;
+            is read(STDIN, $buff, $len_appended), $len_appended, "  Length of Appended data ok";
+
+            is $output, $expected, "  Uncompressed matches original";
+            is $buff, $appended, "  Appended data ok";
+
+              open(STDIN, "<&SAVEIN");
+        }
+    }
+
+    foreach my $bit ($UncompressClass,
+                     'IO::Uncompress::AnyUncompress',
+                    )
+    {
+        # TODO -- Add Append mode tests
+
+        my $Error = getErrorRef($bit);
+        my $Func = getTopFuncRef($bit);
+        my $TopType = getTopFuncName($bit);
+
+        my $buffer = "abcde" ;
+        my $keep_orig = $buffer;
+
+        my $null = compressBuffer(getTopFuncName($UncompressClass), "") ;
+        my $undef = compressBuffer(getTopFuncName($UncompressClass), undef) ;
+        my $comp = compressBuffer(getTopFuncName($UncompressClass), $buffer) ;
+        my $keep_comp = $comp;
+
+        my @opts = ();
+        @opts = (RawInflate => 1)
+            if $bit eq 'IO::Uncompress::AnyUncompress';
+
+        my $incumbent = "incumbent data" ;
+
+        my $lex = new LexFile(my $file1, my $file2) ;
+
+        writeFile($file1, compressBuffer(getTopFuncName($UncompressClass),"data1"));
+        writeFile($file2, compressBuffer(getTopFuncName($UncompressClass),"data2"));
+
+        my $of = new IO::File "<$file1" ;
+        ok $of, "  Created output filehandle" ;
+
+        #my @input    = ($file2, \$undef, \$null, \$comp, $of) ;
+        #my @expected = ('data2', '',      '',    'abcde', 'data1');
+        my @input    = ($file1, $file2);
+        my @expected = ('data1', 'data2');
+
+        my @keep = @input ;
+
+        {
+            title "$TopType - From ArrayRef to Buffer" ;
+
+            my $output  ;
+            ok &$Func(\@input, \$output, AutoClose => 0, @opts), '  UnCompressed ok' ;
+
+            is $output, join('', @expected)
+        }
+
+        {
+            title "$TopType - From ArrayRef to Filename" ;
+
+            my $lex = new LexFile my $output;
+            $of->open("<$file1") ;
+
+            ok &$Func(\@input, $output, AutoClose => 0, @opts), '  UnCompressed ok' ;
+
+            is readFile($output), join('', @expected)
+        }
+
+        {
+            title "$TopType - From ArrayRef to Filehandle" ;
+
+            my $lex = new LexFile my $output;
+            my $fh = new IO::File ">$output" ;
+            $of->open("<$file1") ;
+
+            ok &$Func(\@input, $fh, AutoClose => 0, @opts), '  UnCompressed ok' ;
+            $fh->close;
+
+            is readFile($output), join('', @expected)
+        }
+
+        {
+            title "$TopType - From Array Ref to Array Ref" ;
+
+            my @output = (\'first') ;
+            $of->open("<$file1") ;
+            ok &$Func(\@input, \@output, AutoClose => 0, @opts), '  UnCompressed ok' ;
+
+            is_deeply \@input, \@keep, "  Input array not changed" ;
+            is_deeply [map { defined $$_ ? $$_ : "" } @output], 
+                      ['first', @expected], 
+                      "  Got Expected uncompressed data";
+
+        }
+    }
+
+    foreach my $bit ($UncompressClass,
+                     'IO::Uncompress::AnyUncompress',
+                    )
+    {
+        # TODO -- Add Append mode tests
+
+        my $Error = getErrorRef($bit);
+        my $Func = getTopFuncRef($bit);
+        my $TopType = getTopFuncName($bit);
+
+        my $tmpDir1 = 'tmpdir1';
+        my $tmpDir2 = 'tmpdir2';
+        my $lex = new LexDir($tmpDir1, $tmpDir2) ;
+
+        mkdir $tmpDir1, 0777;
+        mkdir $tmpDir2, 0777;
+
+        my @opts = ();
+        @opts = (RawInflate => 1)
+            if $bit eq 'IO::Uncompress::AnyUncompress';
+
+        ok   -d $tmpDir1, "  Temp Directory $tmpDir1 exists";
+        #ok ! -d $tmpDir2, "  Temp Directory $tmpDir2 does not exist";
+
+        my @files = map { "$tmpDir1/$_.tmp" } qw( a1 a2 a3) ;
+        foreach (@files) { writeFile($_, compressBuffer(getTopFuncName($UncompressClass), "abc $_")) }
+
+        my @expected = map { "abc $_" } @files ;
+        my @outFiles = map { s/$tmpDir1/$tmpDir2/; $_ } @files ;
+
+        {
+            title "$TopType - From FileGlob to FileGlob" ;
+
+            ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>", @opts), '  UnCompressed ok' 
+                or diag $$Error ;
+
+            my @copy = @expected;
+            for my $file (@outFiles)
+            {
+                is readFile($file), shift @copy, "  got expected from $file" ;
+            }
+
+            is @copy, 0, "  got all files";
+        }
+
+        {
+            title "$TopType - From FileGlob to Arrayref" ;
+
+            my @output = (\'first');
+            ok &$Func("<$tmpDir1/a*.tmp>" => \@output, @opts), '  UnCompressed ok' 
+                or diag $$Error ;
+
+            my @copy = ('first', @expected);
+            for my $data (@output)
+            {
+                is $$data, shift @copy, "  got expected data" ;
+            }
+
+            is @copy, 0, "  got all files";
+        }
+
+        {
+            title "$TopType - From FileGlob to Buffer" ;
+
+            my $output ;
+            ok &$Func("<$tmpDir1/a*.tmp>" => \$output, @opts), '  UnCompressed ok' 
+                or diag $$Error ;
+
+            is $output, join('', @expected), "  got expected uncompressed data";
+        }
+
+        {
+            title "$TopType - From FileGlob to Filename" ;
+
+            my $lex = new LexFile my $output ;
+            ok ! -e $output, "  $output does not exist" ;
+            ok &$Func("<$tmpDir1/a*.tmp>" => $output, @opts), '  UnCompressed ok' 
+                or diag $$Error ;
+
+            ok -e $output, "  $output does exist" ;
+            is readFile($output), join('', @expected), "  got expected uncompressed data";
+        }
+
+        {
+            title "$TopType - From FileGlob to Filehandle" ;
+
+            my $output = 'abc' ;
+            my $lex = new LexFile $output ;
+            my $fh = new IO::File ">$output" ;
+            ok &$Func("<$tmpDir1/a*.tmp>" => $fh, AutoClose => 1, @opts), '  UnCompressed ok' 
+                or diag $$Error ;
+
+            ok -e $output, "  $output does exist" ;
+            is readFile($output), join('', @expected), "  got expected uncompressed data";
+        }
+
+    }
+
+    foreach my $TopType ($CompressClass
+                         # TODO -- add the inflate classes
+                        )
+    {
+        my $Error = getErrorRef($TopType);
+        my $Func = getTopFuncRef($TopType);
+        my $Name = getTopFuncName($TopType);
+
+        title "More write tests" ;
+
+        my $lex = new LexFile(my $file1, my $file2, my $file3) ;
+
+        writeFile($file1, "F1");
+        writeFile($file2, "F2");
+        writeFile($file3, "F3");
+
+#        my @data = (
+#              [ '[\"ab", \"cd"]',                        "abcd" ],
+#
+#              [ '[\"a", $fh1, \"bc"]',                   "aF1bc"],
+#            ) ;
+#
+#
+#        foreach my $data (@data)
+#        {
+#            my ($send, $get) = @$data ;
+#
+#            my $fh1 = new IO::File "< $file1" ;
+#            my $fh2 = new IO::File "< $file2" ;
+#            my $fh3 = new IO::File "< $file3" ;
+#
+#            title "$send";
+#            my ($copy);
+#            eval "\$copy = $send";
+#            my $Answer ;
+#            ok &$Func($copy, \$Answer), "  $Name ok";
+#
+#            my $got = anyUncompress(\$Answer);
+#            is $got, $get, "  got expected output" ;
+#            ok ! $$Error,  "  no error"
+#                or diag "Error is $$Error";
+#
+#        }
+
+        title "Array Input Error tests" ;
+
+        my @data = (
+                   [ '[]',    "empty array reference"],
+                   [ '[[]]',    "unknown input parameter"],
+                   [ '[[[]]]',   "unknown input parameter"],
+                   [ '[[\"ab"], [\"cd"]]', "unknown input parameter"],
+                   [ '[\""]',     "not a filename"],
+                   [ '[\undef]',  "not a filename"],
+                   [ '[\"abcd"]', "not a filename"],
+                   [ '[\&xx]',      "unknown input parameter"],
+                   [ '[$fh2]',      "not a filename"],
+                ) ;
+
+
+        foreach my $data (@data)
+        {
+            my ($send, $get) = @$data ;
+
+            my $fh1 = new IO::File "< $file1" ;
+            my $fh2 = new IO::File "< $file2" ;
+            my $fh3 = new IO::File "< $file3" ;
+
+            title "$send";
+            my($copy);
+            eval "\$copy = $send";
+            my $Answer ;
+            my $a ;
+            eval { $a = &$Func($copy, \$Answer) };
+            ok ! $a, "  $Name fails";
+
+            is $$Error, $get, "  got error message";
+
+        }
+
+        @data = (
+                   '[""]', 
+                   '[undef]', 
+                ) ;
+
+
+        foreach my $send (@data)
+        {
+            title "$send";
+            my($copy);
+            eval "\$copy = $send";
+            my $Answer ;
+            eval { &$Func($copy, \$Answer) } ;
+            like $@, mkErr("^$TopFuncName: input filename is undef or null string"), 
+                "  got error message";
+
+        }
+    }
+
+}
+
+# TODO add more error cases
+
+1;
diff --git a/gnu/usr.bin/perl/t/lib/compress/prime.pl b/gnu/usr.bin/perl/t/lib/compress/prime.pl
new file mode 100644
index 00000000000..4e804e5b005
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/compress/prime.pl
@@ -0,0 +1,90 @@
+
+use lib 't';
+use strict;
+use warnings;
+use bytes;
+
+use Test::More ;
+use CompTestUtils;
+
+our ($extra);
+
+BEGIN {
+    # use Test::NoWarnings, if available
+    $extra = 0 ;
+    $extra = 1
+        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
+
+}
+
+sub run
+{
+
+    my $CompressClass   = identify();
+    my $UncompressClass = getInverse($CompressClass);
+    my $Error           = getErrorRef($CompressClass);
+    my $UnError         = getErrorRef($UncompressClass);
+
+
+
+    my $hello = <<EOM ;
+hello world
+this is a test
+some more stuff on this line
+ad finally...
+EOM
+
+    print "#\n# Testing $UncompressClass\n#\n";
+
+    my $compressed = mkComplete($CompressClass, $hello);
+    my $cc = $compressed ;
+
+    plan tests => (length($compressed) * 6 * 7) + 1 + $extra ;
+
+    is anyUncompress(\$cc), $hello ;
+
+    for my $blocksize (1, 2, 13)
+    {
+        for my $i (0 .. length($compressed) - 1)
+        {
+            for my $useBuf (0 .. 1)
+            {
+                print "#\n# BlockSize $blocksize, Length $i, Buffer $useBuf\n#\n" ;
+                my $lex = new LexFile my $name ;
+        
+                my $prime = substr($compressed, 0, $i);
+                my $rest = substr($compressed, $i);
+        
+                my $start  ;
+                if ($useBuf) {
+                    $start = \$rest ;
+                }
+                else {
+                    $start = $name ;
+                    writeFile($name, $rest);
+                }
+
+                #my $gz = new $UncompressClass $name,
+                my $gz = new $UncompressClass $start,
+                                              -Append      => 1,
+                                              -BlockSize   => $blocksize,
+                                              -Prime       => $prime,
+                                              -Transparent => 0
+                                              ;
+                ok $gz;
+                ok ! $gz->error() ;
+                my $un ;
+                my $status = 1 ;
+                $status = $gz->read($un) while $status > 0 ;
+                is $status, 0 ;
+                ok ! $gz->error() 
+                    or print "Error is '" . $gz->error() . "'\n";
+                is $un, $hello ;
+                ok $gz->eof() ;
+                ok $gz->close() ;
+            }
+        }
+    }
+}
+ 
+1;
diff --git a/gnu/usr.bin/perl/t/lib/compress/tied.pl b/gnu/usr.bin/perl/t/lib/compress/tied.pl
new file mode 100644
index 00000000000..80d42b75613
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/compress/tied.pl
@@ -0,0 +1,492 @@
+
+use lib 't';
+use strict;
+use warnings;
+use bytes;
+
+use Test::More ;
+use CompTestUtils;
+
+our ($BadPerl, $UncompressClass);
+ 
+BEGIN 
+{ 
+    plan(skip_all => "Tied Filehandle needs Perl 5.005 or better" )
+        if $] < 5.005 ;
+
+    # use Test::NoWarnings, if available
+    my $extra = 0 ;
+    $extra = 1
+        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
+
+    my $tests ;
+    $BadPerl = ($] >= 5.006 and $] <= 5.008) ;
+
+    if ($BadPerl) {
+        $tests = 241 ;
+    }
+    else {
+        $tests = 249 ;
+    }
+
+    plan tests => $tests + $extra ;
+
+}
+ 
+ 
+use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
+ 
+
+
+sub myGZreadFile
+{
+    my $filename = shift ;
+    my $init = shift ;
+
+
+    my $fil = new $UncompressClass $filename,
+                                    -Strict   => 1,
+                                    -Append   => 1
+                                    ;
+
+    my $data ;
+    $data = $init if defined $init ;
+    1 while $fil->read($data) > 0;
+
+    $fil->close ;
+    return $data ;
+}
+
+sub run
+{
+
+    my $CompressClass   = identify();
+    $UncompressClass = getInverse($CompressClass);
+    my $Error           = getErrorRef($CompressClass);
+    my $UnError         = getErrorRef($UncompressClass);
+
+    {
+        next if $BadPerl ;
+
+
+        title "Testing $CompressClass";
+
+            
+        my $x ;
+        my $gz = new $CompressClass(\$x); 
+
+        my $buff ;
+
+        eval { getc($gz) } ;
+        like $@, mkErr("^getc Not Available: File opened only for output");
+
+        eval { read($gz, $buff, 1) } ;
+        like $@, mkErr("^read Not Available: File opened only for output");
+
+        eval { <$gz>  } ;
+        like $@, mkErr("^readline Not Available: File opened only for output");
+
+    }
+
+    {
+        next if $BadPerl;
+        $UncompressClass = getInverse($CompressClass);
+
+        title "Testing $UncompressClass";
+
+        my $gc ;
+        my $guz = new $CompressClass(\$gc); 
+        $guz->write("abc") ;
+        $guz->close();
+
+        my $x ;
+        my $gz = new $UncompressClass(\$gc); 
+
+        my $buff ;
+
+        eval { print $gz "abc" } ;
+        like $@, mkErr("^print Not Available: File opened only for intput");
+
+        eval { printf $gz "fmt", "abc" } ;
+        like $@, mkErr("^printf Not Available: File opened only for intput");
+
+        #eval { write($gz, $buff, 1) } ;
+        #like $@, mkErr("^write Not Available: File opened only for intput");
+
+    }
+
+    {
+        $UncompressClass = getInverse($CompressClass);
+
+        title "Testing $CompressClass and $UncompressClass";
+
+
+        {
+            # Write
+            # these tests come almost 100% from IO::String
+
+            my $lex = new LexFile my $name ;
+
+            my $io = $CompressClass->new($name);
+
+            is $io->tell(), 0 ;
+
+            my $heisan = "Heisan\n";
+            print $io $heisan ;
+
+            ok ! $io->eof;
+
+            is $io->tell(), length($heisan) ;
+
+            print($io "a", "b", "c");
+
+            {
+                local($\) = "\n";
+                print $io "d", "e";
+                local($,) = ",";
+                print $io "f", "g", "h";
+            }
+
+            my $foo = "1234567890";
+            
+            ok syswrite($io, $foo, length($foo)) == length($foo) ;
+            if ( $] < 5.6 )
+              { is $io->syswrite($foo, length $foo), length $foo }
+            else
+              { is $io->syswrite($foo), length $foo }
+            ok $io->syswrite($foo, length($foo)) == length $foo;
+            ok $io->write($foo, length($foo), 5) == 5;
+            ok $io->write("xxx\n", 100, -1) == 1;
+
+            for (1..3) {
+                printf $io "i(%d)", $_;
+                $io->printf("[%d]\n", $_);
+            }
+            select $io;
+            print "\n";
+            select STDOUT;
+
+            close $io ;
+
+            ok $io->eof;
+
+            is myGZreadFile($name), "Heisan\nabcde\nf,g,h\n" .
+                                    ("1234567890" x 3) . "67890\n" .
+                                        "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n";
+
+
+        }
+
+        {
+            # Read
+            my $str = <<EOT;
+This is an example
+of a paragraph
+
+
+and a single line.
+
+EOT
+
+            my $lex = new LexFile my $name ;
+
+            my $iow = new $CompressClass $name ;
+            print $iow $str ;
+            close $iow;
+
+            my @tmp;
+            my $buf;
+            {
+                my $io = new $UncompressClass $name ;
+            
+                ok ! $io->eof, "  Not EOF";
+                is $io->tell(), 0, "  Tell is 0" ;
+                my @lines = <$io>;
+                is @lines, 6, "  Line is 6"
+                    or print "# Got " . scalar(@lines) . " lines, expected 6\n" ;
+                is $lines[1], "of a paragraph\n" ;
+                is join('', @lines), $str ;
+                is $., 6; 
+                is $io->tell(), length($str) ;
+            
+                ok $io->eof;
+
+                ok ! ( defined($io->getline)  ||
+                          (@tmp = $io->getlines) ||
+                          defined(<$io>)         ||
+                          defined($io->getc)     ||
+                          read($io, $buf, 100)   != 0) ;
+            }
+            
+            
+            {
+                local $/;  # slurp mode
+                my $io = $UncompressClass->new($name);
+                ok !$io->eof;
+                my @lines = $io->getlines;
+                ok $io->eof;
+                ok @lines == 1 && $lines[0] eq $str;
+            
+                $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my $line = <$io>;
+                ok $line eq $str;
+                ok $io->eof;
+            }
+            
+            {
+                local $/ = "";  # paragraph mode
+                my $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my @lines = <$io>;
+                ok $io->eof;
+                ok @lines == 2 
+                    or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
+                ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
+                    or print "# $lines[0]\n";
+                ok $lines[1] eq "and a single line.\n\n";
+            }
+            
+            {
+                local $/ = "is";
+                my $io = $UncompressClass->new($name);
+                my @lines = ();
+                my $no = 0;
+                my $err = 0;
+                ok ! $io->eof;
+                while (<$io>) {
+                    push(@lines, $_);
+                    $err++ if $. != ++$no;
+                }
+            
+                ok $err == 0 ;
+                ok $io->eof;
+            
+                ok @lines == 3 
+                    or print "# Got " . scalar(@lines) . " lines, expected 3\n" ;
+                ok join("-", @lines) eq
+                                 "This- is- an example\n" .
+                                "of a paragraph\n\n\n" .
+                                "and a single line.\n\n";
+            }
+            
+            
+            # Test read
+            
+            {
+                my $io = $UncompressClass->new($name);
+            
+
+                if (! $BadPerl) {
+                    eval { read($io, $buf, -1) } ;
+                    like $@, mkErr("length parameter is negative");
+                }
+
+                is read($io, $buf, 0), 0, "Requested 0 bytes" ;
+
+                ok read($io, $buf, 3) == 3 ;
+                ok $buf eq "Thi";
+            
+                ok sysread($io, $buf, 3, 2) == 3 ;
+                ok $buf eq "Ths i"
+                    or print "# [$buf]\n" ;;
+                ok ! $io->eof;
+            
+        #        $io->seek(-4, 2);
+        #    
+        #        ok ! $io->eof;
+        #    
+        #        ok read($io, $buf, 20) == 4 ;
+        #        ok $buf eq "e.\n\n";
+        #    
+        #        ok read($io, $buf, 20) == 0 ;
+        #        ok $buf eq "";
+        #   
+        #        ok ! $io->eof;
+            }
+
+        }
+
+        {
+            # Read from non-compressed file
+
+            my $str = <<EOT;
+This is an example
+of a paragraph
+
+
+and a single line.
+
+EOT
+
+            my $lex = new LexFile my $name ;
+
+            writeFile($name, $str);
+            my @tmp;
+            my $buf;
+            {
+                my $io = new $UncompressClass $name, -Transparent => 1 ;
+            
+                ok defined $io;
+                ok ! $io->eof;
+                ok $io->tell() == 0 ;
+                my @lines = <$io>;
+                ok @lines == 6; 
+                ok $lines[1] eq "of a paragraph\n" ;
+                ok join('', @lines) eq $str ;
+                ok $. == 6; 
+                ok $io->tell() == length($str) ;
+            
+                ok $io->eof;
+
+                ok ! ( defined($io->getline)  ||
+                          (@tmp = $io->getlines) ||
+                          defined(<$io>)         ||
+                          defined($io->getc)     ||
+                          read($io, $buf, 100)   != 0) ;
+            }
+            
+            
+            {
+                local $/;  # slurp mode
+                my $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my @lines = $io->getlines;
+                ok $io->eof;
+                ok @lines == 1 && $lines[0] eq $str;
+            
+                $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my $line = <$io>;
+                ok $line eq $str;
+                ok $io->eof;
+            }
+            
+            {
+                local $/ = "";  # paragraph mode
+                my $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my @lines = <$io>;
+                ok $io->eof;
+                ok @lines == 2 
+                    or print "# exected 2 lines, got " . scalar(@lines) . "\n";
+                ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
+                    or print "# [$lines[0]]\n" ;
+                ok $lines[1] eq "and a single line.\n\n";
+            }
+            
+            {
+                local $/ = "is";
+                my $io = $UncompressClass->new($name);
+                my @lines = ();
+                my $no = 0;
+                my $err = 0;
+                ok ! $io->eof;
+                while (<$io>) {
+                    push(@lines, $_);
+                    $err++ if $. != ++$no;
+                }
+            
+                ok $err == 0 ;
+                ok $io->eof;
+            
+                ok @lines == 3 ;
+                ok join("-", @lines) eq
+                                 "This- is- an example\n" .
+                                "of a paragraph\n\n\n" .
+                                "and a single line.\n\n";
+            }
+            
+            
+            # Test read
+            
+            {
+                my $io = $UncompressClass->new($name);
+            
+                ok read($io, $buf, 3) == 3 ;
+                ok $buf eq "Thi";
+            
+                ok sysread($io, $buf, 3, 2) == 3 ;
+                ok $buf eq "Ths i";
+                ok ! $io->eof;
+            
+        #        $io->seek(-4, 2);
+        #    
+        #        ok ! $io->eof;
+        #    
+        #        ok read($io, $buf, 20) == 4 ;
+        #        ok $buf eq "e.\n\n";
+        #    
+        #        ok read($io, $buf, 20) == 0 ;
+        #        ok $buf eq "";
+        #    
+        #        ok ! $io->eof;
+            }
+
+
+        }
+
+        {
+            # Vary the length parameter in a read
+
+            my $str = <<EOT;
+x
+x
+This is an example
+of a paragraph
+
+
+and a single line.
+
+EOT
+            $str = $str x 100 ;
+
+
+            foreach my $bufsize (1, 3, 512, 4096, length($str)-1, length($str), length($str)+1)
+            {
+                foreach my $trans (0, 1)
+                {
+                    foreach my $append (0, 1)
+                    {
+                        title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ;
+
+                        my $lex = new LexFile my $name ;
+
+                        if ($trans) {
+                            writeFile($name, $str) ;
+                        }
+                        else {
+                            my $iow = new $CompressClass $name ;
+                            print $iow $str ;
+                            close $iow;
+                        }
+
+                        
+                        my $io = $UncompressClass->new($name, 
+                                                       -Append => $append,
+                                                       -Transparent  => $trans);
+                    
+                        my $buf;
+                        
+                        is $io->tell(), 0;
+
+                        if ($append) {
+                            1 while $io->read($buf, $bufsize) > 0;
+                        }
+                        else {
+                            my $tmp ;
+                            $buf .= $tmp while $io->read($tmp, $bufsize) > 0 ;
+                        }
+                        is length $buf, length $str;
+                        ok $buf eq $str ;
+                        ok ! $io->error() ;
+                        ok $io->eof;
+                    }
+                }
+            }
+        }
+
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/t/lib/compress/truncate.pl b/gnu/usr.bin/perl/t/lib/compress/truncate.pl
new file mode 100644
index 00000000000..b362fd3b6e0
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/compress/truncate.pl
@@ -0,0 +1,169 @@
+
+use lib 't';
+use strict;
+use warnings;
+use bytes;
+
+use Test::More ;
+use CompTestUtils;
+
+sub run
+{
+    my $CompressClass   = identify();
+    my $UncompressClass = getInverse($CompressClass);
+    my $Error           = getErrorRef($CompressClass);
+    my $UnError         = getErrorRef($UncompressClass);
+    
+#    my $hello = <<EOM ;
+#hello world
+#this is a test
+#some more stuff on this line
+#and finally...
+#EOM
+
+    # ASCII hex equivalent of the text above. This makes the test
+    # harness behave identically on an EBCDIC platform.
+    my $hello = 
+      "\x68\x65\x6c\x6c\x6f\x20\x77\x6f\x72\x6c\x64\x0a\x74\x68\x69\x73" .
+      "\x20\x69\x73\x20\x61\x20\x74\x65\x73\x74\x0a\x73\x6f\x6d\x65\x20" .
+      "\x6d\x6f\x72\x65\x20\x73\x74\x75\x66\x66\x20\x6f\x6e\x20\x74\x68" .
+      "\x69\x73\x20\x6c\x69\x6e\x65\x0a\x61\x6e\x64\x20\x66\x69\x6e\x61" .
+      "\x6c\x6c\x79\x2e\x2e\x2e\x0a" ;
+
+    my $blocksize = 10 ;
+
+
+    my ($info, $compressed) = mkComplete($CompressClass, $hello);
+
+    my $header_size  = $info->{HeaderLength};
+    my $trailer_size = $info->{TrailerLength};
+    my $fingerprint_size = $info->{FingerprintLength};
+    ok 1, "Compressed size is " . length($compressed) ;
+    ok 1, "Fingerprint size is $fingerprint_size" ;
+    ok 1, "Header size is $header_size" ;
+    ok 1, "Trailer size is $trailer_size" ;
+
+    for my $trans ( 0 .. 1)
+    {
+        title "Truncating $CompressClass, Transparent $trans";
+
+
+        foreach my $i (1 .. $fingerprint_size-1)
+        {
+            my $lex = new LexFile my $name ;
+        
+            title "Fingerprint Truncation - length $i, Transparent $trans";
+
+            my $part = substr($compressed, 0, $i);
+            writeFile($name, $part);
+
+            my $gz = new $UncompressClass $name,
+                                          -BlockSize   => $blocksize,
+                                          -Transparent => $trans;
+            if ($trans) {
+                ok $gz;
+                ok ! $gz->error() ;
+                my $buff ;
+                is $gz->read($buff), length($part) ;
+                ok $buff eq $part ;
+                ok $gz->eof() ;
+                $gz->close();
+            }
+            else {
+                ok !$gz;
+            }
+
+        }
+
+        #
+        # Any header corruption past the fingerprint is considered catastrophic
+        # so even if Transparent is set, it should still fail
+        #
+        foreach my $i ($fingerprint_size .. $header_size -1)
+        {
+            my $lex = new LexFile my $name ;
+        
+            title "Header Truncation - length $i, Transparent $trans";
+
+            my $part = substr($compressed, 0, $i);
+            writeFile($name, $part);
+            ok ! defined new $UncompressClass $name,
+                                              -BlockSize   => $blocksize,
+                                              -Transparent => $trans;
+            #ok $gz->eof() ;
+        }
+
+        
+        foreach my $i ($header_size .. length($compressed) - 1 - $trailer_size)
+        {
+            next if $i == 0 ;
+
+            my $lex = new LexFile my $name ;
+        
+            title "Compressed Data Truncation - length $i, Transparent $trans";
+
+            my $part = substr($compressed, 0, $i);
+            writeFile($name, $part);
+            ok my $gz = new $UncompressClass $name,
+                                             -Strict      => 1,
+                                             -BlockSize   => $blocksize,
+                                             -Transparent => $trans
+                 or diag $$UnError;
+
+            my $un ;
+            my $status = 1 ;
+            $status = $gz->read($un) while $status > 0 ;
+            cmp_ok $status, "<", 0 ;
+            ok $gz->error() ;
+            ok $gz->eof() ;
+            $gz->close();
+        }
+        
+        # RawDeflate does not have a trailer
+        next if $CompressClass eq 'IO::Compress::RawDeflate' ;
+
+        title "Compressed Trailer Truncation";
+        foreach my $i (length($compressed) - $trailer_size .. length($compressed) -1 )
+        {
+            foreach my $lax (0, 1)
+            {
+                my $lex = new LexFile my $name ;
+            
+                ok 1, "Compressed Trailer Truncation - Length $i, Lax $lax, Transparent $trans" ;
+                my $part = substr($compressed, 0, $i);
+                writeFile($name, $part);
+                ok my $gz = new $UncompressClass $name,
+                                                 -BlockSize   => $blocksize,
+                                                 -Strict      => !$lax,
+                                                 -Append      => 1,   
+                                                 -Transparent => $trans;
+                my $un = '';
+                my $status = 1 ;
+                $status = $gz->read($un) while $status > 0 ;
+
+                if ($lax)
+                {
+                    is $un, $hello;
+                    is $status, 0 
+                        or diag "Status $status Error is " . $gz->error() ;
+                    ok $gz->eof()
+                        or diag "Status $status Error is " . $gz->error() ;
+                    ok ! $gz->error() ;
+                }
+                else
+                {
+                    cmp_ok $status, "<", 0 
+                        or diag "Status $status Error is " . $gz->error() ;
+                    ok $gz->eof()
+                        or diag "Status $status Error is " . $gz->error() ;
+                    ok $gz->error() ;
+                }
+                
+                $gz->close();
+            }
+        }
+    }
+}
+
+1;
+
diff --git a/gnu/usr.bin/perl/t/lib/compress/zlib-generic.pl b/gnu/usr.bin/perl/t/lib/compress/zlib-generic.pl
new file mode 100644
index 00000000000..94e5da9f723
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/compress/zlib-generic.pl
@@ -0,0 +1,233 @@
+
+use strict;
+use warnings;
+use bytes;
+
+use Test::More ;
+use CompTestUtils;
+
+BEGIN 
+{ 
+    # use Test::NoWarnings, if available
+    my $extra = 0 ;
+    $extra = 1
+        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
+
+    plan tests => 49 + $extra ;
+}
+
+
+
+my $CompressClass   = identify();
+my $UncompressClass = getInverse($CompressClass);
+my $Error           = getErrorRef($CompressClass);
+my $UnError         = getErrorRef($UncompressClass);
+
+use Compress::Raw::Zlib;
+use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
+
+sub myGZreadFile
+{
+    my $filename = shift ;
+    my $init = shift ;
+
+
+    my $fil = new $UncompressClass $filename,
+                                    -Strict   => 1,
+                                    -Append   => 1
+                                    ;
+
+    my $data = '';
+    $data = $init if defined $init ;
+    1 while $fil->read($data) > 0;
+
+    $fil->close ;
+    return $data ;
+}
+
+
+{
+
+    title "Testing $CompressClass Errors";
+
+}
+
+
+{
+    title "Testing $UncompressClass Errors";
+
+}
+
+{
+    title "Testing $CompressClass and $UncompressClass";
+
+    {
+        title "flush" ;
+
+
+        my $lex = new LexFile my $name ;
+
+        my $hello = <<EOM ;
+hello world
+this is a test
+EOM
+
+        {
+          my $x ;
+          ok $x = new $CompressClass $name  ;
+
+          ok $x->write($hello), "write" ;
+          ok $x->flush(Z_FINISH), "flush";
+          ok $x->close, "close" ;
+        }
+
+        {
+          my $uncomp;
+          ok my $x = new $UncompressClass $name, -Append => 1  ;
+
+          my $len ;
+          1 while ($len = $x->read($uncomp)) > 0 ;
+
+          is $len, 0, "read returned 0";
+
+          ok $x->close ;
+          is $uncomp, $hello ;
+        }
+    }
+
+
+    if ($CompressClass ne 'RawDeflate')
+    {
+        # write empty file
+        #========================================
+
+        my $buffer = '';
+        {
+          my $x ;
+          ok $x = new $CompressClass(\$buffer) ;
+          ok $x->close ;
+      
+        }
+
+        my $keep = $buffer ;
+        my $uncomp= '';
+        {
+          my $x ;
+          ok $x = new $UncompressClass(\$buffer, Append => 1)  ;
+
+          1 while $x->read($uncomp) > 0  ;
+
+          ok $x->close ;
+        }
+
+        ok $uncomp eq '' ;
+        ok $buffer eq $keep ;
+
+    }
+
+    
+    {
+        title "inflateSync on plain file";
+
+        my $hello = "I am a HAL 9000 computer" x 2001 ;
+
+        my $k = new $UncompressClass(\$hello, Transparent => 1);
+        ok $k ;
+     
+        # Skip to the flush point -- no-op for plain file
+        my $status = $k->inflateSync();
+        is $status, 1 
+            or diag $k->error() ;
+     
+        my $rest; 
+        is $k->read($rest, length($hello)), length($hello)
+            or diag $k->error() ;
+        ok $rest eq $hello ;
+
+        ok $k->close();
+    }
+
+    {
+        title "$CompressClass: inflateSync for real";
+
+        # create a deflate stream with flush points
+
+        my $hello = "I am a HAL 9000 computer" x 2001 ;
+        my $goodbye = "Will I dream?" x 2010;
+        my ($x, $err, $answer, $X, $Z, $status);
+        my $Answer ;
+     
+        ok ($x = new $CompressClass(\$Answer));
+        ok $x ;
+     
+        is $x->write($hello), length($hello);
+    
+        # create a flush point
+        ok $x->flush(Z_FULL_FLUSH) ;
+         
+        is $x->write($goodbye), length($goodbye);
+    
+        ok $x->close() ;
+     
+        my $k;
+        $k = new $UncompressClass(\$Answer, BlockSize => 1);
+        ok $k ;
+     
+        my $initial;
+        is $k->read($initial, 1), 1 ;
+        is $initial, substr($hello, 0, 1);
+
+        # Skip to the flush point
+        $status = $k->inflateSync();
+        is $status, 1, "   inflateSync returned 1"
+            or diag $k->error() ;
+     
+        my $rest; 
+        is $k->read($rest, length($hello) + length($goodbye)), 
+                length($goodbye)
+            or diag $k->error() ;
+        ok $rest eq $goodbye, " got expected output" ;
+
+        ok $k->close();
+    }
+
+    {
+        title "$CompressClass: inflateSync no FLUSH point";
+
+        # create a deflate stream with flush points
+
+        my $hello = "I am a HAL 9000 computer" x 2001 ;
+        my ($x, $err, $answer, $X, $Z, $status);
+        my $Answer ;
+     
+        ok ($x = new $CompressClass(\$Answer));
+        ok $x ;
+     
+        is $x->write($hello), length($hello);
+    
+        ok $x->close() ;
+     
+        my $k = new $UncompressClass(\$Answer, BlockSize => 1);
+        ok $k ;
+     
+        my $initial;
+        is $k->read($initial, 1), 1 ;
+        is $initial, substr($hello, 0, 1);
+
+        # Skip to the flush point
+        $status = $k->inflateSync();
+        is $status, 0 
+            or diag $k->error() ;
+     
+        ok $k->close();
+        is $k->inflateSync(), 0 ;
+    }
+
+}
+
+
+1;
+
+
+
+
diff --git a/gnu/usr.bin/perl/t/lib/cygwin.t b/gnu/usr.bin/perl/t/lib/cygwin.t
index 01485461439..096cb98dcf5 100755
--- a/gnu/usr.bin/perl/t/lib/cygwin.t
+++ b/gnu/usr.bin/perl/t/lib/cygwin.t
@@ -9,7 +9,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 4;
+use Test::More tests => 16;
 
 is(Cygwin::winpid_to_pid(Cygwin::pid_to_winpid($$)), $$,
    "perl pid translates to itself");
@@ -29,3 +29,46 @@ close($ps);
 is(Cygwin::winpid_to_pid($catwinpid), $catpid, "winpid to pid");
 is(Cygwin::pid_to_winpid($catpid), $catwinpid, "pid to winpid");
 close($cat);
+
+is(Cygwin::win_to_posix_path("t\\lib"), "t/lib", "win to posix path: t/lib");
+is(Cygwin::posix_to_win_path("t/lib"), "t\\lib", "posix to win path: t\\lib");
+
+use Win32;
+use Cwd;
+my $pwd = getcwd();
+chdir("/");
+my $winpath = Win32::GetCwd();
+is(Cygwin::posix_to_win_path("/", 1), $winpath, "posix to absolute win path");
+chdir($pwd);
+is(Cygwin::win_to_posix_path($winpath, 1), "/", "win to absolute posix path");
+
+my $mount = join '', `/usr/bin/mount`;
+$mount =~ m|on /usr/bin type .+ \((\w+mode)\)|m;
+my $binmode = $1 eq 'binmode';
+is(Cygwin::is_binmount("/"),  $binmode ? 1 : '', "check / for binmount");
+
+my $rootmnt = Cygwin::mount_flags("/");
+ok($binmode ? ($rootmnt =~ /,binmode/) : ($rootmnt =~ /,textmode/), "check / mount_flags");
+is(Cygwin::mount_flags("/cygdrive") =~ /,cygdrive/,  1, "check cygdrive mount_flags");
+
+# Cygdrive mount prefix
+my @flags = split(/,/, Cygwin::mount_flags('/cygdrive'));
+my $prefix = pop(@flags);
+ok($prefix, "cygdrive mount prefix = " . (($prefix) ? $prefix : '<none>'));
+chomp(my $prefix2 = `df | grep -i '^c: ' | cut -d% -f2 | xargs`);
+$prefix2 =~ s/\/c$//i;
+if (! $prefix2) {
+    $prefix2 = '/';
+}
+is($prefix, $prefix2, 'cygdrive mount prefix');
+
+my @mnttbl = Cygwin::mount_table();
+ok(@mnttbl > 0, "non empty mount_table");
+for $i (@mnttbl) {
+  if ($i->[0] eq '/') {
+    is($i->[2].",".$i->[3], $rootmnt, "same root mount flags");
+    last;
+  }
+}
+
+ok(Cwd->cwd(), "bug#38628 legacy");
diff --git a/gnu/usr.bin/perl/t/lib/feature/implicit b/gnu/usr.bin/perl/t/lib/feature/implicit
new file mode 100644
index 00000000000..0632770401c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/feature/implicit
@@ -0,0 +1,62 @@
+Check implicit loading of features with use VERSION.
+
+__END__
+# Standard feature bundle
+use feature ":5.10";
+say "Hello", "world";
+EXPECT
+Helloworld
+########
+# VERSION requirement, dotted notation
+use 5.9.5;
+say "Hello", "world";
+EXPECT
+Helloworld
+########
+# VERSION requirement, v-dotted notation
+use v5.9.5;
+say "Hello", "world";
+EXPECT
+Helloworld
+########
+# VERSION requirement, decimal notation
+use 5.009005;
+say defined $INC{"feature.pm"} ? "Helloworld" : "Good bye";
+EXPECT
+Helloworld
+########
+# VERSION requirement, doesn't load anything for < 5.9.5
+use 5.8.8;
+print "<".$INC{"feature.pm"}.">\n";
+EXPECT
+<>
+########
+# VERSION requirement, doesn't load anything with require
+require 5.9.5;
+print "<".$INC{"feature.pm"}.">\n";
+EXPECT
+<>
+########
+# VERSION requirement in eval {}
+eval {
+    use 5.9.5;
+    say "Hello", "world";
+}
+EXPECT
+Helloworld
+########
+# VERSION requirement in eval ""
+eval q{
+    use 5.9.5;
+    say "Hello", "world";
+}
+EXPECT
+Helloworld
+########
+# VERSION requirement in BEGIN
+BEGIN {
+    use 5.9.5;
+    say "Hello", "world";
+}
+EXPECT
+Helloworld
diff --git a/gnu/usr.bin/perl/t/lib/feature/nonesuch b/gnu/usr.bin/perl/t/lib/feature/nonesuch
new file mode 100644
index 00000000000..0de975ad540
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/feature/nonesuch
@@ -0,0 +1,22 @@
+Test that non-existent features fail as expected.
+
+__END__
+use feature "nonesuch";
+EXPECT
+OPTIONS regex
+^Feature "nonesuch" is not supported by Perl [v0-9.]+ at - line 1
+########
+no feature "nonesuch";
+EXPECT
+OPTIONS regex
+^Feature "nonesuch" is not supported by Perl [v0-9.]+ at - line 1
+########
+use feature ":nonesuch";
+EXPECT
+OPTIONS regex
+^Feature bundle "nonesuch" is not supported by Perl [v0-9.]+ at - line 1
+########
+no feature ":nonesuch";
+EXPECT
+OPTIONS regex
+^Feature bundle "nonesuch" is not supported by Perl [v0-9.]+ at - line 1
diff --git a/gnu/usr.bin/perl/t/lib/feature/say b/gnu/usr.bin/perl/t/lib/feature/say
new file mode 100644
index 00000000000..4b507e6d572
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/feature/say
@@ -0,0 +1,64 @@
+Check the lexical scoping of the say keyword.
+(The actual behaviour is tested in t/op/say.t)
+
+__END__
+# No say; should be a syntax error.
+use warnings;
+say "Hello", "world";
+EXPECT
+Unquoted string "say" may clash with future reserved word at - line 3.
+String found where operator expected at - line 3, near "say "Hello""
+	(Do you need to predeclare say?)
+syntax error at - line 3, near "say "Hello""
+Execution of - aborted due to compilation errors.
+########
+# With say, should work
+use warnings;
+use feature "say";
+say "Hello", "world";
+EXPECT
+Helloworld
+########
+# With say, should work in eval too
+use warnings;
+use feature "say";
+eval q(say "Hello", "world");
+EXPECT
+Helloworld
+########
+# feature out of scope; should be a syntax error.
+use warnings;
+{ use feature 'say'; }
+say "Hello", "world";
+EXPECT
+Unquoted string "say" may clash with future reserved word at - line 4.
+String found where operator expected at - line 4, near "say "Hello""
+	(Do you need to predeclare say?)
+syntax error at - line 4, near "say "Hello""
+Execution of - aborted due to compilation errors.
+########
+# 'no feature' should work
+use warnings;
+use feature 'say';
+say "Hello", "world";
+no feature;
+say "Hello", "world";
+EXPECT
+Unquoted string "say" may clash with future reserved word at - line 6.
+String found where operator expected at - line 6, near "say "Hello""
+	(Do you need to predeclare say?)
+syntax error at - line 6, near "say "Hello""
+Execution of - aborted due to compilation errors.
+########
+# 'no feature "say"' should work too
+use warnings;
+use feature 'say';
+say "Hello", "world";
+no feature 'say';
+say "Hello", "world";
+EXPECT
+Unquoted string "say" may clash with future reserved word at - line 6.
+String found where operator expected at - line 6, near "say "Hello""
+	(Do you need to predeclare say?)
+syntax error at - line 6, near "say "Hello""
+Execution of - aborted due to compilation errors.
diff --git a/gnu/usr.bin/perl/t/lib/feature/switch b/gnu/usr.bin/perl/t/lib/feature/switch
new file mode 100644
index 00000000000..022cbd17610
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/feature/switch
@@ -0,0 +1,158 @@
+Check the lexical scoping of the switch keywords.
+(The actual behaviour is tested in t/op/switch.t)
+
+__END__
+# No switch; given should be a bareword.
+use warnings;
+print STDOUT given;
+EXPECT
+Unquoted string "given" may clash with future reserved word at - line 3.
+given
+########
+# No switch; when should be a bareword.
+use warnings;
+print STDOUT when;
+EXPECT
+Unquoted string "when" may clash with future reserved word at - line 3.
+when
+########
+# No switch; default should be a bareword.
+use warnings;
+print STDOUT default;
+EXPECT
+Unquoted string "default" may clash with future reserved word at - line 3.
+default
+########
+# No switch; break should be a bareword.
+use warnings;
+print STDOUT break;
+EXPECT
+Unquoted string "break" may clash with future reserved word at - line 3.
+break
+########
+# No switch; but continue is still a keyword
+print STDOUT continue;
+EXPECT
+syntax error at - line 2, near "STDOUT continue"
+Execution of - aborted due to compilation errors.
+########
+# Use switch; so given is a keyword
+use feature 'switch';
+given("okay\n") { print }
+EXPECT
+okay
+########
+# Use switch; so when is a keyword
+use feature 'switch';
+given(1) { when(1) { print "okay" } }
+EXPECT
+okay
+########
+# Use switch; so default is a keyword
+use feature 'switch';
+given(1) { default { print "okay" } }
+EXPECT
+okay
+########
+# Use switch; so break is a keyword
+use feature 'switch';
+break;
+EXPECT
+Can't "break" outside a given block at - line 3.
+########
+# Use switch; so continue is a keyword
+use feature 'switch';
+continue;
+EXPECT
+Can't "continue" outside a when block at - line 3.
+########
+# switch out of scope; given should be a bareword.
+use warnings;
+{ use feature 'switch';
+  given (1) {print "Okay here\n";}
+}
+print STDOUT given;
+EXPECT
+Unquoted string "given" may clash with future reserved word at - line 6.
+Okay here
+given
+########
+# switch out of scope; when should be a bareword.
+use warnings;
+{ use feature 'switch';
+  given (1) { when(1) {print "Okay here\n";} }
+}
+print STDOUT when;
+EXPECT
+Unquoted string "when" may clash with future reserved word at - line 6.
+Okay here
+when
+########
+# switch out of scope; default should be a bareword.
+use warnings;
+{ use feature 'switch';
+  given (1) { default {print "Okay here\n";} }
+}
+print STDOUT default;
+EXPECT
+Unquoted string "default" may clash with future reserved word at - line 6.
+Okay here
+default
+########
+# switch out of scope; break should be a bareword.
+use warnings;
+{ use feature 'switch';
+  given (1) { break }  
+}
+print STDOUT break;
+EXPECT
+Unquoted string "break" may clash with future reserved word at - line 6.
+break
+########
+# switch out of scope; continue should not work
+{ use feature 'switch';
+  given (1) { default {continue} }  
+}
+print STDOUT continue;
+EXPECT
+syntax error at - line 5, near "STDOUT continue"
+Execution of - aborted due to compilation errors.
+########
+# C<no feature 'switch'> should work
+use warnings;
+use feature 'switch';
+given (1) { when(1) {print "Okay here\n";} }
+no feature 'switch';
+print STDOUT when;
+EXPECT
+Unquoted string "when" may clash with future reserved word at - line 6.
+Okay here
+when
+########
+# C<no feature> should work too
+use warnings;
+use feature 'switch';
+given (1) { when(1) {print "Okay here\n";} }
+no feature;
+print STDOUT when;
+EXPECT
+Unquoted string "when" may clash with future reserved word at - line 6.
+Okay here
+when
+########
+# Without the feature, no 'Unambiguous use of' warning:
+use warnings;
+@break = ($break = "break");
+print ${break}, ${break[0]};
+EXPECT
+breakbreak
+########
+# With the feature, we get an 'Unambiguous use of' warning:
+use warnings;
+use feature 'switch';
+@break = ($break = "break");
+print ${break}, ${break[0]};
+EXPECT
+Ambiguous use of ${break} resolved to $break at - line 5.
+Ambiguous use of ${break[...]} resolved to $break[...] at - line 5.
+breakbreak
diff --git a/gnu/usr.bin/perl/t/lib/h2ph.pht b/gnu/usr.bin/perl/t/lib/h2ph.pht
index 7b29896a58f..145e6824ae2 100644
--- a/gnu/usr.bin/perl/t/lib/h2ph.pht
+++ b/gnu/usr.bin/perl/t/lib/h2ph.pht
@@ -28,21 +28,21 @@ unless(defined(&_H2PH_H_)) {
     	    eval q((($a) < ($b) ? ($a) : ($b)));
 	}' unless defined(&MIN);
     }
-    if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : 0))) {
+    if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : undef))) {
     }
- elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : 0))) {
+ elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : undef))) {
 	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))) {
+    if((!((defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : undef)  && defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : undef))) || defined (defined(&__SOMETHING_OVERPOWERING) ? &__SOMETHING_OVERPOWERING : undef))) {
 	eval 'sub WHATEVER () {6;}' unless defined(&WHATEVER);
     }
- elsif(!(defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : 0)) ) {
+ elsif(!(defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : undef)) ) {
 	eval 'sub WHATEVER () {7;}' unless defined(&WHATEVER);
     }
- elsif(!(defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : 0)) ) {
+ elsif(!(defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : undef)) ) {
 	eval 'sub WHATEVER () {8;}' unless defined(&WHATEVER);
     } else {
 	eval 'sub WHATEVER () {1000;}' unless defined(&WHATEVER);
diff --git a/gnu/usr.bin/perl/t/lib/mypragma.pm b/gnu/usr.bin/perl/t/lib/mypragma.pm
new file mode 100644
index 00000000000..fc6ee7b8c5b
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/mypragma.pm
@@ -0,0 +1,45 @@
+=head1 NAME
+
+mypragma - an example of a user pragma
+
+=head1 SYNOPSIS
+
+In your code
+
+    use mypragma; # Enable the pragma
+    
+    mypragma::in_effect() # returns true; pragma is enabled
+
+    no mypragma;
+    
+    mypragma::in_effect() # returns false; pragma is not enabled
+
+=head1 DESCRIPTION
+
+An example of how to write a pragma.
+
+=head1 AUTHOR
+
+Rafael Garcia-Suarez
+
+=cut
+
+package mypragma;
+
+use strict;
+use warnings;
+
+sub import {
+    $^H{mypragma} = 42;
+}
+
+sub unimport {
+    $^H{mypragma} = 0;
+}
+
+sub in_effect {
+    my $hinthash = (caller(0))[10];
+    return $hinthash->{mypragma};
+}
+
+1;
diff --git a/gnu/usr.bin/perl/t/lib/mypragma.t b/gnu/usr.bin/perl/t/lib/mypragma.t
new file mode 100644
index 00000000000..48e9865384a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/mypragma.t
@@ -0,0 +1,46 @@
+#!./perl
+
+BEGIN {
+    chdir 't';
+    @INC = ('../lib', 'lib');
+}
+
+use strict;
+use warnings;
+use Test::More tests => 13;
+
+use mypragma (); # don't enable this pragma yet
+
+BEGIN {
+   is($^H{mypragma}, undef, "Shouldn't be in %^H yet");
+}
+
+is(mypragma::in_effect(), undef, "pragma not in effect yet");
+{
+    is(mypragma::in_effect(), undef, "pragma not in effect yet");
+    eval qq{is(mypragma::in_effect(), undef, "pragma not in effect yet"); 1}
+	or die $@;
+
+    use mypragma;
+    is(mypragma::in_effect(), 42, "pragma is in effect within this block");
+    eval qq{is(mypragma::in_effect(), 42,
+	       "pragma is in effect within this eval"); 1} or die $@;
+
+    {
+      no mypragma;
+      is(mypragma::in_effect(), 0, "pragma no longer in effect");
+      eval qq{is(mypragma::in_effect(), 0, "pragma no longer in effect"); 1}
+	or die $@;
+    }
+
+    is(mypragma::in_effect(), 42, "pragma is in effect within this block");
+    eval qq{is(mypragma::in_effect(), 42,
+	       "pragma is in effect within this eval"); 1} or die $@;
+}
+is(mypragma::in_effect(), undef, "pragma no longer in effect");
+eval qq{is(mypragma::in_effect(), undef, "pragma not in effect"); 1} or die $@;
+
+
+BEGIN {
+   is($^H{mypragma}, undef, "Should no longer be in %^H");
+}
diff --git a/gnu/usr.bin/perl/t/lib/no_load.t b/gnu/usr.bin/perl/t/lib/no_load.t
new file mode 100644
index 00000000000..3f10200d5bf
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/no_load.t
@@ -0,0 +1,41 @@
+#!./perl
+#
+# Check that certain modules don't get loaded when other modules are used.
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = qw(. ../lib);
+}
+
+use strict;
+use warnings;
+
+require "test.pl";
+
+#
+# Format: [Module-that-should-not-be-loaded => modules to test]
+#
+my @TESTS = (
+    [Carp  => qw [warnings Exporter]],
+);
+
+my $count = 0;
+$count += @$_ - 1 for @TESTS;
+
+print "1..$count\n";
+
+foreach my $test (@TESTS) {
+    my ($exclude, @modules) = @$test;
+
+    foreach my $module (@modules) {
+        my $prog = <<"        --";
+            use $module;
+            print exists \$INC {'$exclude.pm'} ? "not ok" : "ok";
+        --
+        fresh_perl_is ($prog, "ok", "", "$module does not load $exclude");
+    }
+}
+
+
+__END__
diff --git a/gnu/usr.bin/perl/t/lib/proxy_constant_subs.t b/gnu/usr.bin/perl/t/lib/proxy_constant_subs.t
new file mode 100644
index 00000000000..4af73d38c42
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/proxy_constant_subs.t
@@ -0,0 +1,41 @@
+my @symbols;
+BEGIN {
+    chdir 't';
+    @INC = '../lib';
+    require Config;
+    if (($Config::Config{'extensions'} !~ /\bB\b/) ){
+        print "1..0 # Skip -- Perl configured without B module\n";
+        exit 0;
+    }
+    if ($Config::Config{'extensions'} !~ /\bPOSIX\b/) {
+        print "1..0 # Skip -- Perl configured without POSIX\n";
+        exit 0;
+    }
+    # errno is a real subroutine, and acts as control
+    # SEEK_SET is a proxy constant subroutine.
+    @symbols = qw(errno SEEK_SET);
+}
+
+use strict;
+use warnings;
+use Test::More tests => 4 * @symbols;
+use B qw(svref_2object GVf_IMPORTED_CV);
+use POSIX @symbols;
+
+# GVf_IMPORTED_CV should not be set on the original, but should be set on the
+# imported GV.
+
+foreach my $symbol (@symbols) {
+    my ($ps, $ms);
+    {
+	no strict 'refs';
+	$ps = svref_2object(\*{"POSIX::$symbol"});
+	$ms = svref_2object(\*{"::$symbol"});
+    }
+    isa_ok($ps, 'B::GV');
+    is($ps->GvFLAGS() & GVf_IMPORTED_CV, 0,
+       "GVf_IMPORTED_CV not set on original");
+    isa_ok($ms, 'B::GV');
+    is($ms->GvFLAGS() & GVf_IMPORTED_CV, GVf_IMPORTED_CV,
+       "GVf_IMPORTED_CV set on imported GV");
+}
diff --git a/gnu/usr.bin/perl/t/lib/strict/refs b/gnu/usr.bin/perl/t/lib/strict/refs
index b6a2753360f..6237d6d3a9b 100644
--- a/gnu/usr.bin/perl/t/lib/strict/refs
+++ b/gnu/usr.bin/perl/t/lib/strict/refs
@@ -301,3 +301,24 @@ use strict 'refs';
 /(?{${"foo"}++})/;
 EXPECT
 Can't use string ("foo") as a SCALAR ref while "strict refs" in use at (re_eval 1) line 1.
+########
+# [perl #37886] strict 'refs' doesn't apply inside defined
+use strict 'refs';
+my $x = "foo";
+defined $$x;
+EXPECT
+Can't use string ("foo") as a SCALAR ref while "strict refs" in use at - line 4.
+########
+# [perl #37886] strict 'refs' doesn't apply inside defined
+use strict 'refs';
+my $x = "foo";
+defined @$x;
+EXPECT
+Can't use string ("foo") as an ARRAY ref while "strict refs" in use at - line 4.
+########
+# [perl #37886] strict 'refs' doesn't apply inside defined
+use strict 'refs';
+my $x = "foo";
+defined %$x;
+EXPECT
+Can't use string ("foo") as a HASH ref while "strict refs" in use at - line 4.
diff --git a/gnu/usr.bin/perl/t/lib/strict/subs b/gnu/usr.bin/perl/t/lib/strict/subs
index e53d8b8f4b8..20a8afa80e2 100644
--- a/gnu/usr.bin/perl/t/lib/strict/subs
+++ b/gnu/usr.bin/perl/t/lib/strict/subs
@@ -362,6 +362,11 @@ EXPECT
 Bareword "bad" not allowed while "strict subs" in use at - line 3.
 Execution of - aborted due to compilation errors.
 ########
+eval q{ use strict; no strict refs; };
+print $@;
+EXPECT
+Bareword "refs" not allowed while "strict subs" in use at (eval 1) line 1.
+########
 # [perl #25147] 
 use strict;
 print "" if BAREWORD;
diff --git a/gnu/usr.bin/perl/t/lib/strict/vars b/gnu/usr.bin/perl/t/lib/strict/vars
index c01d79b7b5d..16deab9837f 100644
--- a/gnu/usr.bin/perl/t/lib/strict/vars
+++ b/gnu/usr.bin/perl/t/lib/strict/vars
@@ -379,7 +379,7 @@ our $foo;
 ${foo} = 10;
 our $foo;
 EXPECT
-"our" variable $foo masks earlier declaration in same scope at - line 7.
+"our" variable $foo redeclared at - line 7.
 ########
 
 # multiple our declarations in same scope, same package, warning
@@ -390,12 +390,14 @@ use warnings;
 our $foo;
 {
     our $foo;
+    our $foo;
     package Foo;
     our $foo;
 }
 EXPECT
 "our" variable $foo redeclared at - line 9.
 	(Did you mean "local" instead of "our"?)
+"our" variable $foo redeclared at - line 10.
 ########
 
 --FILE-- abc
@@ -422,6 +424,15 @@ EXPECT
 Global symbol "@i_like_crackers" requires explicit package name at - line 7.
 Execution of - aborted due to compilation errors.
 ########
+
+# [perl #21914] New bug > 5.8.0. Used to dump core.
+use strict 'vars';
+@k = <$k>;
+EXPECT
+Global symbol "@k" requires explicit package name at - line 4.
+Global symbol "$k" requires explicit package name at - line 4.
+Execution of - aborted due to compilation errors.
+########
 # [perl #26910] hints not propagated into (?{...})
 use strict 'vars';
 qr/(?{$foo++})/;
diff --git a/gnu/usr.bin/perl/t/lib/warnings/1global b/gnu/usr.bin/perl/t/lib/warnings/1global
index 0af80221b25..9de457da0f7 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/1global
+++ b/gnu/usr.bin/perl/t/lib/warnings/1global
@@ -43,7 +43,7 @@ EXPECT
 $^W = 1 ;
 my $b ; chop $b ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 4.
+Use of uninitialized value $b in scalar chop at - line 4.
 ########
 
 # warnings enabled at compile time, disabled at run time
@@ -59,7 +59,7 @@ BEGIN { $^W = 0 }
 $^W = 1 ;
 my $b ; chop $b ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 5.
+Use of uninitialized value $b in scalar chop at - line 5.
 ########
 -w
 --FILE-- abcd
@@ -68,7 +68,7 @@ my $b ; chop $b ;
 --FILE-- 
 require "./abcd";
 EXPECT
-Use of uninitialized value in scalar chop at ./abcd line 1.
+Use of uninitialized value $b in scalar chop at ./abcd line 1.
 ########
 
 --FILE-- abcd
@@ -78,7 +78,7 @@ my $b ; chop $b ;
 #! perl -w
 require "./abcd";
 EXPECT
-Use of uninitialized value in scalar chop at ./abcd line 1.
+Use of uninitialized value $b in scalar chop at ./abcd line 1.
 ########
 
 --FILE-- abcd
@@ -88,7 +88,7 @@ my $b ; chop $b ;
 $^W =1 ;
 require "./abcd";
 EXPECT
-Use of uninitialized value in scalar chop at ./abcd line 1.
+Use of uninitialized value $b in scalar chop at ./abcd line 1.
 ########
 
 --FILE-- abcd
@@ -110,28 +110,28 @@ $^W =0 ;
 require "./abcd";
 my $b ; chop $b ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 3.
+Use of uninitialized value $b in scalar chop at - line 3.
 ########
 
 $^W = 1;
 eval 'my $b ; chop $b ;' ;
 print $@ ;
 EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 1.
+Use of uninitialized value $b in scalar chop at (eval 1) line 1.
 ########
 
 eval '$^W = 1;' ;
 print $@ ;
 my $b ; chop $b ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 4.
+Use of uninitialized value $b in scalar chop at - line 4.
 ########
 
 eval {$^W = 1;} ;
 print $@ ;
 my $b ; chop $b ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 4.
+Use of uninitialized value $b in scalar chop at - line 4.
 ########
 
 {
@@ -149,7 +149,7 @@ my $a ; chop $a ;
 }
 my $c ; chop $c ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 5.
+Use of uninitialized value $b in scalar chop at - line 5.
 ########
 -w
 -e undef
@@ -186,4 +186,4 @@ sub fred { my $b ; chop $b ;}
   fred() ;
 }
 EXPECT
-Use of uninitialized value in scalar chop at - line 2.
+Use of uninitialized value $b in scalar chop at - line 2.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/2use b/gnu/usr.bin/perl/t/lib/warnings/2use
index d8ef72f4d9c..eef0f3ffec6 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/2use
+++ b/gnu/usr.bin/perl/t/lib/warnings/2use
@@ -42,7 +42,7 @@ use warnings 'uninitialized' ;
 }
 my $b ; chop $b ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 8.
+Use of uninitialized value $b in scalar chop at - line 8.
 ########
 
 # Check runtime scope of pragma
@@ -53,7 +53,7 @@ no warnings ;
 }
 my $b ; chop $b ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 6.
+Use of uninitialized value $b in scalar chop at - line 6.
 ########
 
 # Check runtime scope of pragma
@@ -64,7 +64,7 @@ no warnings ;
 }
 &$a ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 6.
+Use of uninitialized value $b in scalar chop at - line 6.
 ########
 
 use warnings 'syntax' ;
@@ -109,7 +109,7 @@ require "./abc";
 my $a ; chop $a ;
 EXPECT
 Reversed += operator at ./abc line 2.
-Use of uninitialized value in scalar chop at - line 3.
+Use of uninitialized value $a in scalar chop at - line 3.
 ########
 
 --FILE-- abc.pm
@@ -122,7 +122,7 @@ use abc;
 my $a ; chop $a ;
 EXPECT
 Reversed += operator at abc.pm line 2.
-Use of uninitialized value in scalar chop at - line 3.
+Use of uninitialized value $a in scalar chop at - line 3.
 ########
 
 # Check scope of pragma with eval
@@ -149,7 +149,7 @@ use warnings;
     my $b ; chop $b ;
 }
 EXPECT
-Use of uninitialized value in scalar chop at - line 8.
+Use of uninitialized value $b in scalar chop at - line 8.
 ########
 
 # Check scope of pragma with eval
@@ -162,8 +162,8 @@ no warnings;
     my $b ; chop $b ;
 }
 EXPECT
-Use of uninitialized value in scalar chop at - line 7.
-Use of uninitialized value in scalar chop at - line 9.
+Use of uninitialized value $b in scalar chop at - line 7.
+Use of uninitialized value $b in scalar chop at - line 9.
 ########
 
 # Check scope of pragma with eval
@@ -177,7 +177,7 @@ no warnings;
     my $b ; chop $b ;
 }
 EXPECT
-Use of uninitialized value in scalar chop at - line 10.
+Use of uninitialized value $b in scalar chop at - line 10.
 ########
 
 # Check scope of pragma with eval
@@ -259,7 +259,7 @@ use warnings;
     my $b ; chop $b ;
 }
 EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 3.
+Use of uninitialized value $b in scalar chop at (eval 1) line 3.
 ########
 
 # Check scope of pragma with eval
@@ -272,8 +272,8 @@ no warnings;
     my $b ; chop $b ;
 }
 EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 2.
-Use of uninitialized value in scalar chop at - line 9.
+Use of uninitialized value $b in scalar chop at (eval 1) line 2.
+Use of uninitialized value $b in scalar chop at - line 9.
 ########
 
 # Check scope of pragma with eval
@@ -287,7 +287,7 @@ no warnings;
     my $b ; chop $b ;
 }
 EXPECT
-Use of uninitialized value in scalar chop at - line 10.
+Use of uninitialized value $b in scalar chop at - line 10.
 ########
 
 # Check scope of pragma with eval
@@ -357,4 +357,4 @@ no warnings 'syntax' ;
 $a =+ 1 ;
 EXPECT
 Reversed += operator at - line 6.
-Use of uninitialized value in scalar chop at - line 9.
+Use of uninitialized value $c in scalar chop at - line 9.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/3both b/gnu/usr.bin/perl/t/lib/warnings/3both
index a4d9ba806d6..733261cf3bc 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/3both
+++ b/gnu/usr.bin/perl/t/lib/warnings/3both
@@ -13,7 +13,7 @@ sub fred {
 }
 
 EXPECT
-Use of uninitialized value in scalar chop at - line 6.
+Use of uninitialized value $b in scalar chop at - line 6.
 ########
 
 # Check interaction of $^W and use warnings
@@ -27,7 +27,7 @@ sub fred {
 }
 
 EXPECT
-Use of uninitialized value in scalar chop at - line 6.
+Use of uninitialized value $b in scalar chop at - line 6.
 ########
 
 # Check interaction of $^W and use warnings
@@ -64,7 +64,7 @@ $^W = 1 ;
 my $b ; 
 chop $b ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 6.
+Use of uninitialized value $b in scalar chop at - line 6.
 ########
 
 # Check interaction of $^W and use warnings
@@ -73,7 +73,7 @@ use warnings ;
 my $b ; 
 chop $b ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 6.
+Use of uninitialized value $b in scalar chop at - line 6.
 ########
 
 # Check interaction of $^W and use warnings
@@ -107,7 +107,7 @@ use warnings ;
 my $b ; 
 chop $b ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 5.
+Use of uninitialized value $b in scalar chop at - line 5.
 ########
 
 # Check interaction of $^W and use warnings
@@ -119,7 +119,7 @@ sub fred {
 BEGIN {  $^W = 0 }
 fred() ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 6.
+Use of uninitialized value $b in scalar chop at - line 6.
 ########
 
 # Check interaction of $^W and use warnings
@@ -141,7 +141,7 @@ BEGIN {  $^W = 1 }
 my $b ; 
 chop $b ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 6.
+Use of uninitialized value $b in scalar chop at - line 6.
 ########
 
 # Check interaction of $^W and use warnings
@@ -150,7 +150,7 @@ use warnings ;
 my $b ; 
 chop $b ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 6.
+Use of uninitialized value $b in scalar chop at - line 6.
 ########
 
 # Check interaction of $^W and use warnings
@@ -181,7 +181,7 @@ BEGIN {  $^W = 1 }
 my $b ;
 chop $b ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 10.
+Use of uninitialized value $b in scalar chop at - line 10.
 ########
 
 # Check interaction of $^W and use warnings
@@ -194,7 +194,7 @@ BEGIN {  $^W = 0 }
 my $b ;
 chop $b ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 7.
+Use of uninitialized value $b in scalar chop at - line 7.
 ########
 
 # Check scope of pragma with eval
@@ -222,7 +222,7 @@ use warnings;
     my $b ; chop $b ;
 }
 EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 3.
+Use of uninitialized value $b in scalar chop at (eval 1) line 3.
 ########
 
 # Check scope of pragma with eval
@@ -235,8 +235,8 @@ BEGIN {  $^W = 0 }
     my $b ; chop $b ;
 }
 EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 2.
-Use of uninitialized value in scalar chop at - line 9.
+Use of uninitialized value $b in scalar chop at (eval 1) line 2.
+Use of uninitialized value $b in scalar chop at - line 9.
 ########
 
 # Check scope of pragma with eval
@@ -250,7 +250,7 @@ BEGIN {  $^W = 0 }
     my $b ; chop $b ;
 }
 EXPECT
-Use of uninitialized value in scalar chop at - line 10.
+Use of uninitialized value $b in scalar chop at - line 10.
 ########
 
 # Check scope of pragma with eval
diff --git a/gnu/usr.bin/perl/t/lib/warnings/4lint b/gnu/usr.bin/perl/t/lib/warnings/4lint
index 805bd98905e..5b46ce4ec53 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/4lint
+++ b/gnu/usr.bin/perl/t/lib/warnings/4lint
@@ -68,7 +68,7 @@ use abc;
 my $a ; chop $a ;
 EXPECT
 Reversed += operator at abc.pm line 4.
-Use of uninitialized value in scalar chop at - line 3.
+Use of uninitialized value $a in scalar chop at - line 3.
 ########
 -W
 --FILE-- abc
@@ -83,7 +83,7 @@ require "./abc";
 my $a ; chop $a ;
 EXPECT
 Reversed += operator at ./abc line 4.
-Use of uninitialized value in scalar chop at - line 3.
+Use of uninitialized value $a in scalar chop at - line 3.
 ########
 -W
 --FILE-- abc.pm
@@ -98,7 +98,7 @@ use abc;
 my $a ; chop $a ;
 EXPECT
 Reversed += operator at abc.pm line 4.
-Use of uninitialized value in scalar chop at - line 3.
+Use of uninitialized value $a in scalar chop at - line 3.
 ########
 -W
 --FILE-- abc
@@ -112,7 +112,7 @@ require "./abc";
 my $a ; chop $a ;
 EXPECT
 Reversed += operator at ./abc line 3.
-Use of uninitialized value in scalar chop at - line 3.
+Use of uninitialized value $a in scalar chop at - line 3.
 ########
 -W
 # Check scope of pragma with eval
@@ -124,8 +124,8 @@ Use of uninitialized value in scalar chop at - line 3.
     my $b ; chop $b ;
 }
 EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 2.
-Use of uninitialized value in scalar chop at - line 8.
+Use of uninitialized value $b in scalar chop at (eval 1) line 2.
+Use of uninitialized value $b in scalar chop at - line 8.
 ########
 -W
 # Check scope of pragma with eval
@@ -139,8 +139,8 @@ use warnings;
     my $b ; chop $b ;
 }
 EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 3.
-Use of uninitialized value in scalar chop at - line 10.
+Use of uninitialized value $b in scalar chop at (eval 1) line 3.
+Use of uninitialized value $b in scalar chop at - line 10.
 ########
 -W
 # Check scope of pragma with eval
@@ -153,8 +153,8 @@ no warnings;
     my $b ; chop $b ;
 }
 EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 2.
-Use of uninitialized value in scalar chop at - line 9.
+Use of uninitialized value $b in scalar chop at (eval 1) line 2.
+Use of uninitialized value $b in scalar chop at - line 9.
 ########
 -W
 # Check scope of pragma with eval
@@ -168,8 +168,8 @@ no warnings;
     my $b ; chop $b ;
 }
 EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 3.
-Use of uninitialized value in scalar chop at - line 10.
+Use of uninitialized value $b in scalar chop at (eval 1) line 3.
+Use of uninitialized value $b in scalar chop at - line 10.
 ########
 -W
 # Check scope of pragma with eval
diff --git a/gnu/usr.bin/perl/t/lib/warnings/7fatal b/gnu/usr.bin/perl/t/lib/warnings/7fatal
index a3e70f8d50f..dfbb7134ab1 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/7fatal
+++ b/gnu/usr.bin/perl/t/lib/warnings/7fatal
@@ -35,7 +35,7 @@ use warnings FATAL => 'uninitialized' ;
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 8.
+Use of uninitialized value $b in scalar chop at - line 8.
 ########
 
 # Check runtime scope of pragma
@@ -47,7 +47,7 @@ use warnings FATAL => 'all' ;
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 8.
+Use of uninitialized value $b in scalar chop at - line 8.
 ########
 
 # Check runtime scope of pragma
@@ -59,7 +59,7 @@ no warnings ;
 &$a ;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 6.
+Use of uninitialized value $b in scalar chop at - line 6.
 ########
 
 # Check runtime scope of pragma
@@ -71,7 +71,7 @@ no warnings ;
 &$a ;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 6.
+Use of uninitialized value $b in scalar chop at - line 6.
 ########
 
 --FILE-- abc
@@ -105,7 +105,7 @@ my $a ; chop $a ;
 print STDERR "The End.\n" ;
 EXPECT
 Reversed += operator at ./abc line 2.
-Use of uninitialized value in scalar chop at - line 3.
+Use of uninitialized value $a in scalar chop at - line 3.
 ########
 
 --FILE-- abc.pm
@@ -119,7 +119,7 @@ my $a ; chop $a ;
 print STDERR "The End.\n" ;
 EXPECT
 Reversed += operator at abc.pm line 2.
-Use of uninitialized value in scalar chop at - line 3.
+Use of uninitialized value $a in scalar chop at - line 3.
 ########
 
 # Check scope of pragma with eval
@@ -131,7 +131,7 @@ eval {
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
--- Use of uninitialized value in scalar chop at - line 6.
+-- Use of uninitialized value $b in scalar chop at - line 6.
 The End.
 ########
 
@@ -143,8 +143,8 @@ eval {
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
--- Use of uninitialized value in scalar chop at - line 5.
-Use of uninitialized value in scalar chop at - line 7.
+-- Use of uninitialized value $b in scalar chop at - line 5.
+Use of uninitialized value $b in scalar chop at - line 7.
 ########
 
 # Check scope of pragma with eval
@@ -156,7 +156,7 @@ eval {
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 8.
+Use of uninitialized value $b in scalar chop at - line 8.
 ########
 
 # Check scope of pragma with eval
@@ -214,7 +214,7 @@ eval q[
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
--- Use of uninitialized value in scalar chop at (eval 1) line 3.
+-- Use of uninitialized value $b in scalar chop at (eval 1) line 3.
 The End.
 ########
 
@@ -226,8 +226,8 @@ eval '
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
--- Use of uninitialized value in scalar chop at (eval 1) line 2.
-Use of uninitialized value in scalar chop at - line 7.
+-- Use of uninitialized value $b in scalar chop at (eval 1) line 2.
+Use of uninitialized value $b in scalar chop at - line 7.
 ########
 
 # Check scope of pragma with eval
@@ -239,7 +239,7 @@ eval '
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 8.
+Use of uninitialized value $b in scalar chop at - line 8.
 ########
 
 # Check scope of pragma with eval
@@ -277,6 +277,7 @@ print STDERR "The End.\n" ;
 EXPECT
 Reversed += operator at - line 8.
 ########
+# TODO ? !$Config{usethreads} && $::UTF8 && ($ENV{PERL_DESTRUCT_LEVEL} || 0) > 1 ? "Parser leaks OPs, which leak shared hash keys" : ''
 
 use warnings 'void' ;
 
@@ -294,6 +295,7 @@ EXPECT
 Useless use of time in void context at - line 4.
 Useless use of length in void context at - line 8.
 ########
+# TODO ? !$Config{usethreads} && $::UTF8 && ($ENV{PERL_DESTRUCT_LEVEL} || 0) > 1 ? "Parser leaks OPs, which leak shared hash keys" : ''
 
 use warnings ;
 
@@ -324,8 +326,8 @@ use warnings FATAL => 'all';
 my $b ; chop $b;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 8.
-Use of uninitialized value in scalar chop at - line 11.
+Use of uninitialized value $b in scalar chop at - line 8.
+Use of uninitialized value $b in scalar chop at - line 11.
 ########
 
 use warnings FATAL => 'all';
@@ -340,8 +342,8 @@ use warnings FATAL => 'all';
 my $b ; chop $b;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 8.
-Use of uninitialized value in scalar chop at - line 11.
+Use of uninitialized value $b in scalar chop at - line 8.
+Use of uninitialized value $b in scalar chop at - line 11.
 ########
 
 use warnings FATAL => 'all';
@@ -355,7 +357,7 @@ use warnings FATAL => 'all';
 my $b ; chop $b;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value in scalar chop at - line 7.
+Use of uninitialized value $b in scalar chop at - line 7.
 ########
 
 use warnings FATAL => 'syntax', NONFATAL => 'void' ;
@@ -383,7 +385,7 @@ length "abc";
 print STDERR "The End.\n" ;
 EXPECT
 Useless use of length in void context at - line 5.
-Use of uninitialized value in scalar chomp at - line 4.
+Use of uninitialized value $a in scalar chomp at - line 4.
 ########
 
 use warnings FATAL => 'void', NONFATAL => 'void' ;
@@ -394,6 +396,7 @@ EXPECT
 Useless use of length in void context at - line 4.
 The End.
 ########
+# TODO ? !$Config{usethreads} && $::UTF8 && ($ENV{PERL_DESTRUCT_LEVEL} || 0) > 1 ? "Parser leaks OPs, which leak shared hash keys" : ''
 
 use warnings NONFATAL => 'void', FATAL => 'void' ;
 
diff --git a/gnu/usr.bin/perl/t/lib/warnings/9enabled b/gnu/usr.bin/perl/t/lib/warnings/9enabled
index 99d32e54e81..6d15948ed4b 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/9enabled
+++ b/gnu/usr.bin/perl/t/lib/warnings/9enabled
@@ -47,7 +47,7 @@ ok2
 --FILE-- abc
 no warnings ;
 print "ok1\n" if !warnings::enabled('all') ;
-print "ok2\n" if warnings::enabled("syntax") ;
+print "ok2\n" if !warnings::enabled("syntax") ;
 1;
 --FILE-- 
 use warnings 'syntax' ;
@@ -61,7 +61,7 @@ ok2
 use warnings 'syntax' ;
 print "ok1\n" if ! warnings::enabled('all') ;
 print "ok2\n" if ! warnings::enabled("syntax") ;
-print "ok3\n" if   warnings::enabled("io") ;
+print "ok3\n" if ! warnings::enabled("io") ;
 1;
 --FILE-- 
 use warnings 'io' ;
@@ -173,7 +173,7 @@ print "ok3\n" if !warnings::enabled("io") ;
 --FILE-- def.pm
 use warnings 'syntax' ;
 print "ok4\n" if !warnings::enabled('all') ;
-print "ok5\n" if warnings::enabled("io") ;
+print "ok5\n" if !warnings::enabled("io") ;
 use abc ;
 1;
 --FILE--
@@ -1179,3 +1179,51 @@ ok5
 my message 1 at - line 8
 my message 2 at - line 8
 my message 4 at - line 8
+########
+
+--FILE--
+# test for bug [perl #15395]
+my ( $warn_cat, # warning category we'll try to control
+     $warn_msg, # the error message to catch
+);
+
+package SomeModule;
+use warnings::register;
+
+BEGIN {
+    $warn_cat = __PACKAGE__;
+    $warn_msg = 'from ' . __PACKAGE__;
+}
+
+# a sub that generates a random warning
+sub gen_warning {
+    warnings::warnif( $warn_msg );
+}
+
+package ClientModule;
+# use SomeModule; (would go here)
+our @CARP_NOT = ( $warn_cat ); # deliver warnings to *our* client
+
+# call_warner provokes a warning.  It is delivered to its caller,
+# who should also be able to control it
+sub call_warner {
+    SomeModule::gen_warning();
+}
+
+# user
+
+package main;
+my $warn_line = __LINE__ + 3; # this line should be in the error message
+eval {
+    use warnings FATAL => $warn_cat; # we want to know if this works
+    ClientModule::call_warner();
+};
+
+# have we caught an error, and is it the one we generated?
+print "ok1\n" if $@ =~ /$warn_msg/;
+
+# does it indicate the right line?
+print "ok2\n" if $@ =~ /line $warn_line/; 
+EXPECT
+ok1
+ok2
diff --git a/gnu/usr.bin/perl/t/lib/warnings/9uninit b/gnu/usr.bin/perl/t/lib/warnings/9uninit
new file mode 100644
index 00000000000..e2e6ef9fecd
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/warnings/9uninit
@@ -0,0 +1,1315 @@
+DAPM 4/2004.
+
+Test the appearance of variable names in "Use of uninitialized value"
+warnings.
+
+The following ops aren't tested, mainly because they do IO or non-portable
+stuff:
+
+    send recv bind conect listen accept shutdown chdir chown chroot unlink
+    chmod utime rename link symlink readlink mkdir rmdir opendir seekdir
+    system exec kill getpgrp alarm sleep dofile require gethostbyname
+    gethostbyaddr getnetbyname getnetbyaddr getprotobyname getprotobynumber
+    getservbyname getservbyport sethostent setnetent setprotoent setservent
+    getpwnam getpwuid getgrnam getgrgid waitpid setpgrp setpriority
+    getpriority syscall dbmopen ioctl fcntl truncate getsockopt setsockopt
+    semctl semop semget msgget msgctl msgsnd msgrcv shmget shmctl shmread
+    shmwrite
+
+    ---------------------------------------------------
+
+
+__END__
+use warnings 'uninitialized';
+my ($m1, $m2, $v);
+
+$v = $m1 + 10;
+$v = 22 + $m2;
+$v = $m1 + $m2;
+EXPECT
+Use of uninitialized value $m1 in addition (+) at - line 4.
+Use of uninitialized value $m2 in addition (+) at - line 5.
+Use of uninitialized value $m2 in addition (+) at - line 6.
+Use of uninitialized value $m1 in addition (+) at - line 6.
+########
+use warnings 'uninitialized';
+my ($m1, $v);
+our ($g1, $g2);
+
+$v = $g1 + 21;
+$v = 31 + $g2;
+$v = $g1 + $g2;
+$v = $m1 + $g2;
+EXPECT
+Use of uninitialized value $g1 in addition (+) at - line 5.
+Use of uninitialized value $g2 in addition (+) at - line 6.
+Use of uninitialized value $g2 in addition (+) at - line 7.
+Use of uninitialized value $g1 in addition (+) at - line 7.
+Use of uninitialized value $g2 in addition (+) at - line 8.
+Use of uninitialized value $m1 in addition (+) at - line 8.
+########
+use warnings 'uninitialized';
+my ($m1, @ma, $v);
+
+$v = $ma[5] + 45;
+$v = 56 + $ma[6];
+$v = $ma[7] + $m1;
+$v = $ma[8] + $ma[9];
+$v = $ma[-1] + $ma[-2];
+EXPECT
+Use of uninitialized value $ma[5] in addition (+) at - line 4.
+Use of uninitialized value $ma[6] in addition (+) at - line 5.
+Use of uninitialized value $m1 in addition (+) at - line 6.
+Use of uninitialized value in addition (+) at - line 6.
+Use of uninitialized value in addition (+) at - line 7.
+Use of uninitialized value in addition (+) at - line 7.
+Use of uninitialized value in addition (+) at - line 8.
+Use of uninitialized value in addition (+) at - line 8.
+########
+use warnings 'uninitialized';
+my ($v);
+my @mau = (undef) x 258;
+my %mhu = ('foo', undef, 'bar', undef);
+
+$v = $mau[5] + 23;
+$v = $mau[-5] + 45;
+$v = 56 + $mau[6];
+$v = 78 + $mau[-6];
+$v = $mau[7] + $mau[8];
+$v = $mau[256] + $mau[257];
+$v = $mau[-1] + $mau[-2];
+$v = $mhu{foo} + $mhu{bar};
+EXPECT
+Use of uninitialized value $mau[5] in addition (+) at - line 6.
+Use of uninitialized value $mau[-5] in addition (+) at - line 7.
+Use of uninitialized value $mau[6] in addition (+) at - line 8.
+Use of uninitialized value $mau[-6] in addition (+) at - line 9.
+Use of uninitialized value $mau[8] in addition (+) at - line 10.
+Use of uninitialized value $mau[7] in addition (+) at - line 10.
+Use of uninitialized value $mau[257] in addition (+) at - line 11.
+Use of uninitialized value $mau[256] in addition (+) at - line 11.
+Use of uninitialized value $mau[-2] in addition (+) at - line 12.
+Use of uninitialized value $mau[-1] in addition (+) at - line 12.
+Use of uninitialized value $mhu{"bar"} in addition (+) at - line 13.
+Use of uninitialized value $mhu{"foo"} in addition (+) at - line 13.
+########
+use warnings 'uninitialized';
+my ($v);
+our (@ga);
+
+$v = $ga[8] + 21;
+$v = $ga[-8] + 46;
+$v = 57 + $ga[9];
+$v = 58 + $ga[-9];
+$v = $ga[10] + $ga[11];
+$v = $ga[-10] + $ga[-11];
+EXPECT
+Use of uninitialized value $ga[8] in addition (+) at - line 5.
+Use of uninitialized value $ga[-8] in addition (+) at - line 6.
+Use of uninitialized value $ga[9] in addition (+) at - line 7.
+Use of uninitialized value $ga[-9] in addition (+) at - line 8.
+Use of uninitialized value in addition (+) at - line 9.
+Use of uninitialized value in addition (+) at - line 9.
+Use of uninitialized value in addition (+) at - line 10.
+Use of uninitialized value in addition (+) at - line 10.
+########
+use warnings 'uninitialized';
+my ($v);
+our @gau = (undef) x 258;
+our %ghu = ('foo', undef, 'bar', undef);
+
+$v = $gau[8] + 46;
+$v = $gau[-8] + 47;
+$v = 57 + $gau[9];
+$v = 57 + $gau[-9];
+$v = $gau[10] + $gau[11];
+$v = $gau[256] + $gau[257];
+$v = $gau[-1] + $gau[-2];
+$v = $ghu{foo} + $ghu{bar};
+EXPECT
+Use of uninitialized value $gau[8] in addition (+) at - line 6.
+Use of uninitialized value $gau[-8] in addition (+) at - line 7.
+Use of uninitialized value $gau[9] in addition (+) at - line 8.
+Use of uninitialized value $gau[-9] in addition (+) at - line 9.
+Use of uninitialized value $gau[11] in addition (+) at - line 10.
+Use of uninitialized value $gau[10] in addition (+) at - line 10.
+Use of uninitialized value $gau[257] in addition (+) at - line 11.
+Use of uninitialized value $gau[256] in addition (+) at - line 11.
+Use of uninitialized value $gau[-2] in addition (+) at - line 12.
+Use of uninitialized value $gau[-1] in addition (+) at - line 12.
+Use of uninitialized value $ghu{"bar"} in addition (+) at - line 13.
+Use of uninitialized value $ghu{"foo"} in addition (+) at - line 13.
+########
+use warnings 'uninitialized';
+my ($v);
+our @gau = (undef) x 258;
+our %ghu = ('foo', undef, 'bar', undef);
+my @mau = (undef) x 258;
+my %mhu = ('foo', undef, 'bar', undef);
+
+my $i1 = 10;
+my $i2 = 20;
+my $i3 = 2000;
+my $k1 = 'foo';
+my $k2 = 'bar';
+my $k3 = 'baz';
+$v = $mau[$i1] + $mau[$i2];
+$v = $gau[$i1] + $gau[$i2];
+$v = $gau[$i1] + $gau[$i3];
+$v = $mhu{$k1} + $mhu{$k2};
+$v = $ghu{$k1} + $ghu{$k2};
+$v = $ghu{$k1} + $ghu{$k3};
+EXPECT
+Use of uninitialized value $mau[20] in addition (+) at - line 14.
+Use of uninitialized value $mau[10] in addition (+) at - line 14.
+Use of uninitialized value $gau[20] in addition (+) at - line 15.
+Use of uninitialized value $gau[10] in addition (+) at - line 15.
+Use of uninitialized value in addition (+) at - line 16.
+Use of uninitialized value $gau[10] in addition (+) at - line 16.
+Use of uninitialized value $mhu{"bar"} in addition (+) at - line 17.
+Use of uninitialized value $mhu{"foo"} in addition (+) at - line 17.
+Use of uninitialized value $ghu{"bar"} in addition (+) at - line 18.
+Use of uninitialized value $ghu{"foo"} in addition (+) at - line 18.
+Use of uninitialized value in addition (+) at - line 19.
+Use of uninitialized value $ghu{"foo"} in addition (+) at - line 19.
+########
+use warnings 'uninitialized';
+my ($m1, $m2, @ma, %mh, $v);
+our ($g1, $g2, @ga, %gh);
+
+$v = $ma[$m1];
+$v = $ma[$g1];
+$v = $ga[$m2];
+$v = $ga[$g2];
+
+$v = $mh{$m1};
+$v = $mh{$g1};
+$v = $gh{$m2};
+$v = $gh{$g2};
+
+$v = $m1+($m2-$g1);
+$v = $ma[$ga[3]];
+$v = $ga[$ma[4]];
+EXPECT
+Use of uninitialized value $m1 in array element at - line 5.
+Use of uninitialized value $g1 in array element at - line 6.
+Use of uninitialized value $m2 in array element at - line 7.
+Use of uninitialized value $g2 in array element at - line 8.
+Use of uninitialized value $m1 in hash element at - line 10.
+Use of uninitialized value $g1 in hash element at - line 11.
+Use of uninitialized value $m2 in hash element at - line 12.
+Use of uninitialized value $g2 in hash element at - line 13.
+Use of uninitialized value $g1 in subtraction (-) at - line 15.
+Use of uninitialized value $m2 in subtraction (-) at - line 15.
+Use of uninitialized value $m1 in addition (+) at - line 15.
+Use of uninitialized value $ga[3] in array element at - line 16.
+Use of uninitialized value $ma[4] in array element at - line 17.
+########
+use warnings 'uninitialized';
+my (@ma, %mh, $v);
+our (@ga, %gh);
+
+$v = sin $ga[1000];
+$v = sin $ma[1000];
+$v = sin $gh{foo};
+$v = sin $mh{bar};
+
+$v = sin $ga[$$];
+$v = sin $ma[$$];
+$v = sin $gh{$$};
+$v = sin $mh{$$};
+EXPECT
+Use of uninitialized value $ga[1000] in sin at - line 5.
+Use of uninitialized value $ma[1000] in sin at - line 6.
+Use of uninitialized value $gh{"foo"} in sin at - line 7.
+Use of uninitialized value $mh{"bar"} in sin at - line 8.
+Use of uninitialized value within @ga in sin at - line 10.
+Use of uninitialized value within @ma in sin at - line 11.
+Use of uninitialized value within %gh in sin at - line 12.
+Use of uninitialized value within %mh in sin at - line 13.
+########
+use warnings 'uninitialized';
+my (@mat, %mht, $v);
+sub X::TIEARRAY { bless [], 'X' }
+sub X::TIEHASH { bless [], 'X' }
+sub X::FETCH { undef }
+tie @mat, 'X';
+tie %mht, 'X';
+my $key1 = 'akey';
+my $key2 = 'bkey';
+my $index1 = 33;
+my $index2 = 55;
+
+$v = sin $mat[0];
+$v = $mat[0] + $mat[1];
+$v = sin $mat[1000];
+$v = $mat[1000] + $mat[1001];
+
+$v = sin $mat[$index1];
+$v = $mat[$index1] + $mat[$index2];
+
+$v = sin $mht{foo};
+$v = $mht{foo} + $mht{bar};
+
+$v = sin $mht{$key1};
+$v = $mht{$key1} + $mht{$key2};
+
+$v = $1+1;
+EXPECT
+Use of uninitialized value $mat[0] in sin at - line 13.
+Use of uninitialized value in addition (+) at - line 14.
+Use of uninitialized value in addition (+) at - line 14.
+Use of uninitialized value $mat[1000] in sin at - line 15.
+Use of uninitialized value in addition (+) at - line 16.
+Use of uninitialized value in addition (+) at - line 16.
+Use of uninitialized value within @mat in sin at - line 18.
+Use of uninitialized value in addition (+) at - line 19.
+Use of uninitialized value in addition (+) at - line 19.
+Use of uninitialized value $mht{"foo"} in sin at - line 21.
+Use of uninitialized value in addition (+) at - line 22.
+Use of uninitialized value in addition (+) at - line 22.
+Use of uninitialized value within %mht in sin at - line 24.
+Use of uninitialized value in addition (+) at - line 25.
+Use of uninitialized value in addition (+) at - line 25.
+Use of uninitialized value $1 in addition (+) at - line 27.
+########
+use warnings 'uninitialized';
+my ($m1);
+our ($g1, @ga);
+
+print $ga[1000];
+print STDERR $ga[1000];
+print STDERR $m1, $g1, $ga[1],$m2;
+print STDERR "", $ga[1],"";
+EXPECT
+Use of uninitialized value $ga[1000] in print at - line 5.
+Use of uninitialized value $ga[1000] in print at - line 6.
+Use of uninitialized value $m1 in print at - line 7.
+Use of uninitialized value $g1 in print at - line 7.
+Use of uninitialized value in print at - line 7.
+Use of uninitialized value $m2 in print at - line 7.
+Use of uninitialized value $ga[1] in print at - line 8.
+########
+use warnings 'uninitialized';
+my ($m1);
+our ($g1);
+
+close $m1;	# exercises rv2gv
+close $g1;	# exercises rv2gv
+EXPECT
+Use of uninitialized value $m1 in ref-to-glob cast at - line 5.
+Use of uninitialized value $g1 in ref-to-glob cast at - line 6.
+########
+use warnings 'uninitialized';
+my ($m1, $m2, $v);
+our ($g1, $g2);
+
+$v = $$m1;
+$v = $$g1;
+
+$v = @$m1;
+$v = @$g1;
+$v = %$m2;
+$v = %$g2;
+
+$v = ${"foo.bar"}+1;
+$v = ${"foo$m1"}+1;
+$v = ${"foo$g1"}+1;
+EXPECT
+Use of uninitialized value $m1 in scalar dereference at - line 5.
+Use of uninitialized value $g1 in scalar dereference at - line 6.
+Use of uninitialized value $m1 in array dereference at - line 8.
+Use of uninitialized value $g1 in array dereference at - line 9.
+Use of uninitialized value $m2 in hash dereference at - line 10.
+Use of uninitialized value $g2 in hash dereference at - line 11.
+Use of uninitialized value in addition (+) at - line 13.
+Use of uninitialized value $m1 in concatenation (.) or string at - line 14.
+Use of uninitialized value in addition (+) at - line 14.
+Use of uninitialized value $g1 in concatenation (.) or string at - line 15.
+Use of uninitialized value in addition (+) at - line 15.
+########
+use warnings 'uninitialized';
+my ($m1, $v);
+our ($g1);
+
+$v = $m1 | $m2;
+$v = $m1 & $m2;
+$v = $m1 ^ $m2;
+$v = ~$m1;
+
+$v = $g1 | $g2;
+$v = $g1 & $g2;
+$v = $g1 ^ $g2;
+$v = ~$g1;
+EXPECT
+Use of uninitialized value $m1 in bitwise or (|) at - line 5.
+Use of uninitialized value $m2 in bitwise or (|) at - line 5.
+Use of uninitialized value $m1 in bitwise and (&) at - line 6.
+Use of uninitialized value $m2 in bitwise and (&) at - line 6.
+Use of uninitialized value $m1 in bitwise xor (^) at - line 7.
+Use of uninitialized value $m2 in bitwise xor (^) at - line 7.
+Use of uninitialized value $m1 in 1's complement (~) at - line 8.
+Use of uninitialized value $g1 in bitwise or (|) at - line 10.
+Use of uninitialized value $g2 in bitwise or (|) at - line 10.
+Use of uninitialized value $g1 in bitwise and (&) at - line 11.
+Use of uninitialized value $g2 in bitwise and (&) at - line 11.
+Use of uninitialized value $g1 in bitwise xor (^) at - line 12.
+Use of uninitialized value $g2 in bitwise xor (^) at - line 12.
+Use of uninitialized value $g1 in 1's complement (~) at - line 13.
+########
+use warnings 'uninitialized';
+my ($v);
+
+my  $tmp1; $v = $tmp1++; # (doesn't warn)
+our $tmp2; $v = $tmp2++; # (doesn't warn)
+my  $tmp3; $v = ++$tmp1; # (doesn't warn)
+our $tmp4; $v = ++$tmp2; # (doesn't warn)
+
+my  $tmp5; $v = $tmp5--; # (doesn't warn)
+our $tmp6; $v = $tmp6--; # (doesn't warn)
+my  $tmp7; $v = --$tmp7; # (doesn't warn)
+our $tmp8; $v = --$tmp8; # (doesn't warn)
+EXPECT
+########
+use warnings 'uninitialized';
+
+my $s1; chomp $s1;
+my $s2; chop  $s2;
+my ($s3,$s4); chomp ($s3,$s4);
+my ($s5,$s6); chop  ($s5,$s6);
+EXPECT
+Use of uninitialized value $s1 in scalar chomp at - line 3.
+Use of uninitialized value $s2 in scalar chop at - line 4.
+Use of uninitialized value $s4 in chomp at - line 5.
+Use of uninitialized value $s3 in chomp at - line 5.
+Use of uninitialized value $s5 in chop at - line 6.
+Use of uninitialized value $s6 in chop at - line 6.
+########
+use warnings 'uninitialized';
+my ($m1);
+
+local $/ =\$m1;
+my $x = "abc";
+chomp $x; chop $x;
+my $y;
+chomp ($x, $y); chop ($x, $y);
+EXPECT
+Use of uninitialized value ${$/} in scalar chomp at - line 6.
+Use of uninitialized value ${$/} in chomp at - line 8.
+Use of uninitialized value $y in chomp at - line 8.
+Use of uninitialized value ${$/} in chomp at - line 8.
+Use of uninitialized value $y in chop at - line 8.
+########
+use warnings 'uninitialized';
+my ($m1, @ma, %mh);
+our ($g1);
+
+delete $ma[$m1];
+delete @ma[$m1, $g1];
+delete $mh{$m1};
+delete @mh{$m1, $g1};
+EXPECT
+Use of uninitialized value $m1 in delete at - line 5.
+Use of uninitialized value $m1 in delete at - line 6.
+Use of uninitialized value $g1 in delete at - line 6.
+Use of uninitialized value $m1 in delete at - line 7.
+Use of uninitialized value $m1 in delete at - line 8.
+Use of uninitialized value $g1 in delete at - line 8.
+########
+use warnings 'uninitialized';
+my ($m1, @ma, %mh);
+our ($g1);
+
+my @a = @ma[$m1, $g1];
+@a = (4,5)[$m1, $g1];
+@a = @mh{$m1, $g1};
+EXPECT
+Use of uninitialized value $m1 in array slice at - line 5.
+Use of uninitialized value $g1 in array slice at - line 5.
+Use of uninitialized value $m1 in list slice at - line 6.
+Use of uninitialized value $g1 in list slice at - line 6.
+Use of uninitialized value $m1 in hash slice at - line 7.
+Use of uninitialized value $g1 in hash slice at - line 7.
+########
+use warnings 'uninitialized';
+my ($m1, @ma, %mh, $v);
+our ($g1, @ga, %gh);
+
+$v = exists $ma[$m1];
+$v = exists $ga[$g1];
+$v = exists $mh{$m1};
+$v = exists $gh{$g1};
+EXPECT
+Use of uninitialized value $m1 in exists at - line 5.
+Use of uninitialized value $g1 in exists at - line 6.
+Use of uninitialized value $m1 in exists at - line 7.
+Use of uninitialized value $g1 in exists at - line 8.
+########
+use warnings 'uninitialized';
+my ($m1, $v);
+our ($g1);
+
+my ($x1,$x2);
+$v = $x1 << $m1;
+$v = $x2 << $g1;
+EXPECT
+Use of uninitialized value $m1 in left bitshift (<<) at - line 6.
+Use of uninitialized value $x1 in left bitshift (<<) at - line 6.
+Use of uninitialized value $g1 in left bitshift (<<) at - line 7.
+Use of uninitialized value $x2 in left bitshift (<<) at - line 7.
+########
+use warnings 'uninitialized';
+my ($m1, $m2, $v);
+our ($g1, $g2);
+
+use integer;
+$v = $m1 + $g1;
+$v = $m1 - $g1;
+$v = $m1 * $g1;
+eval {$v = $m1 / $g1};
+$v = $m2 / 2;
+eval {$v = $m1 % $g1};
+$v = $m2 % 2;
+$v = $m1 < $g1;
+$v = $m1 > $g1;
+$v = $m1 <= $g1;
+$v = $m1 >= $g1;
+$v = $m1 == $g1;
+$v = $m1 != $g1;
+$v = $m1 <=> $g1;
+$v = -$m1;
+EXPECT
+Use of uninitialized value $g1 in integer addition (+) at - line 6.
+Use of uninitialized value $m1 in integer addition (+) at - line 6.
+Use of uninitialized value $g1 in integer subtraction (-) at - line 7.
+Use of uninitialized value $m1 in integer subtraction (-) at - line 7.
+Use of uninitialized value $g1 in integer multiplication (*) at - line 8.
+Use of uninitialized value $m1 in integer multiplication (*) at - line 8.
+Use of uninitialized value $g1 in integer division (/) at - line 9.
+Use of uninitialized value $m2 in integer division (/) at - line 10.
+Use of uninitialized value $g1 in integer modulus (%) at - line 11.
+Use of uninitialized value $m1 in integer modulus (%) at - line 11.
+Use of uninitialized value $m2 in integer modulus (%) at - line 12.
+Use of uninitialized value $g1 in integer lt (<) at - line 13.
+Use of uninitialized value $m1 in integer lt (<) at - line 13.
+Use of uninitialized value $g1 in integer gt (>) at - line 14.
+Use of uninitialized value $m1 in integer gt (>) at - line 14.
+Use of uninitialized value $g1 in integer le (<=) at - line 15.
+Use of uninitialized value $m1 in integer le (<=) at - line 15.
+Use of uninitialized value $g1 in integer ge (>=) at - line 16.
+Use of uninitialized value $m1 in integer ge (>=) at - line 16.
+Use of uninitialized value $g1 in integer eq (==) at - line 17.
+Use of uninitialized value $m1 in integer eq (==) at - line 17.
+Use of uninitialized value $g1 in integer ne (!=) at - line 18.
+Use of uninitialized value $m1 in integer ne (!=) at - line 18.
+Use of uninitialized value $g1 in integer comparison (<=>) at - line 19.
+Use of uninitialized value $m1 in integer comparison (<=>) at - line 19.
+Use of uninitialized value $m1 in integer negation (-) at - line 20.
+########
+use warnings 'uninitialized';
+my ($m1, $m2, $v);
+our ($g1, $g2);
+
+$v = int($g1);
+$v = abs($g2);
+EXPECT
+Use of uninitialized value $g1 in int at - line 5.
+Use of uninitialized value $g2 in abs at - line 6.
+########
+use warnings 'uninitialized';
+my ($m1, $m2, $v);
+our ($g1);
+
+$v = pack $m1;
+$v = pack "i*", $m2, $g1, $g2;
+my @unpack = unpack $m1, $m2;
+EXPECT
+Use of uninitialized value $m1 in pack at - line 5.
+Use of uninitialized value $m2 in pack at - line 6.
+Use of uninitialized value $g1 in pack at - line 6.
+Use of uninitialized value $g2 in pack at - line 6.
+Use of uninitialized value $m1 in unpack at - line 7.
+Use of uninitialized value $m2 in unpack at - line 7.
+########
+use warnings 'uninitialized';
+my ($m1);
+our ($g1);
+
+my @sort;
+@sort = sort $m1, $g1;
+@sort = sort {$a <=> $b} $m1, $g1;
+sub sortf {$a-1 <=> $b-1};
+@sort = sort  &sortf, $m1, $g1;
+EXPECT
+Use of uninitialized value $m1 in sort at - line 6.
+Use of uninitialized value $g1 in sort at - line 6.
+Use of uninitialized value $m1 in sort at - line 6.
+Use of uninitialized value $g1 in sort at - line 6.
+Use of uninitialized value $m1 in sort at - line 7.
+Use of uninitialized value $g1 in sort at - line 7.
+Use of uninitialized value $m1 in sort at - line 7.
+Use of uninitialized value $g1 in sort at - line 7.
+Use of uninitialized value $a in subtraction (-) at - line 8.
+Use of uninitialized value $b in subtraction (-) at - line 8.
+Use of uninitialized value $m1 in sort at - line 9.
+Use of uninitialized value $g1 in sort at - line 9.
+Use of uninitialized value $m1 in sort at - line 9.
+Use of uninitialized value $m1 in sort at - line 9.
+Use of uninitialized value $g1 in sort at - line 9.
+Use of uninitialized value $g1 in sort at - line 9.
+########
+use warnings 'uninitialized';
+my ($m1, $m2, $v);
+our ($g1);
+
+eval { $v = $m1 / $g1 };
+$v = $m2 / 2;
+eval { $v = $m1 % $g1 };
+$v = $m2 % 2;
+$v = $m1 == $g1;
+$v = $m1 >= $g1;
+$v = $m1 >  $g1;
+$v = $m1 <= $g1;
+$v = $m1 <  $g1;
+$v = $m1 *  $g1;
+$v = $m1 <=>$g1;
+$v = $m1 != $g1;
+$v = $m1   -$g1;
+$v = $m1 ** $g1;
+$v = $m1 +  $g1;
+$v = $m1 -  $g1;
+EXPECT
+Use of uninitialized value $g1 in division (/) at - line 5.
+Use of uninitialized value $m1 in division (/) at - line 5.
+Use of uninitialized value $m2 in division (/) at - line 6.
+Use of uninitialized value $g1 in modulus (%) at - line 7.
+Use of uninitialized value $m1 in modulus (%) at - line 7.
+Use of uninitialized value $m2 in modulus (%) at - line 8.
+Use of uninitialized value $g1 in numeric eq (==) at - line 9.
+Use of uninitialized value $m1 in numeric eq (==) at - line 9.
+Use of uninitialized value $g1 in numeric ge (>=) at - line 10.
+Use of uninitialized value $m1 in numeric ge (>=) at - line 10.
+Use of uninitialized value $g1 in numeric gt (>) at - line 11.
+Use of uninitialized value $m1 in numeric gt (>) at - line 11.
+Use of uninitialized value $g1 in numeric le (<=) at - line 12.
+Use of uninitialized value $m1 in numeric le (<=) at - line 12.
+Use of uninitialized value $g1 in numeric lt (<) at - line 13.
+Use of uninitialized value $m1 in numeric lt (<) at - line 13.
+Use of uninitialized value $g1 in multiplication (*) at - line 14.
+Use of uninitialized value $m1 in multiplication (*) at - line 14.
+Use of uninitialized value $g1 in numeric comparison (<=>) at - line 15.
+Use of uninitialized value $m1 in numeric comparison (<=>) at - line 15.
+Use of uninitialized value $g1 in numeric ne (!=) at - line 16.
+Use of uninitialized value $m1 in numeric ne (!=) at - line 16.
+Use of uninitialized value $g1 in subtraction (-) at - line 17.
+Use of uninitialized value $m1 in subtraction (-) at - line 17.
+Use of uninitialized value $g1 in exponentiation (**) at - line 18.
+Use of uninitialized value $m1 in exponentiation (**) at - line 18.
+Use of uninitialized value $g1 in addition (+) at - line 19.
+Use of uninitialized value $m1 in addition (+) at - line 19.
+Use of uninitialized value $g1 in subtraction (-) at - line 20.
+Use of uninitialized value $m1 in subtraction (-) at - line 20.
+########
+use warnings 'uninitialized';
+my ($m1, $v);
+our ($g1);
+
+$v = *global1{$m1};
+$v = prototype $g1;
+$v = bless [], $g1;
+$v = `$m1`;
+
+$v = $m1 . $g1;
+EXPECT
+Use of uninitialized value $m1 in glob elem at - line 5.
+Use of uninitialized value $g1 in subroutine prototype at - line 6.
+Use of uninitialized value $g1 in bless at - line 7.
+Use of uninitialized value $m1 in quoted execution (``, qx) at - line 8.
+Use of uninitialized value $m1 in concatenation (.) or string at - line 10.
+Use of uninitialized value $g1 in concatenation (.) or string at - line 10.
+########
+use warnings 'uninitialized';
+my ($m1);
+our ($g1, $g2);
+
+/y/;
+/$m1/;
+/$g1/;
+
+s/y/z/;		undef $_;
+s/$m1/z/;	undef $_;
+s//$g1/;	undef $_;
+s/$m1/$g1/;	undef $_;
+tr/x/y/;	undef $_;
+
+my $_; 
+/y/;
+/$m1/;
+/$g1/;
+s/y/z/;		undef $_;
+s/$m1/z/;	undef $_;
+s//$g1/;	undef $_;
+s/$m1/$g1/;	undef $_;
+tr/x/y/;	undef $_;
+
+$g2 =~ /y/;
+$g2 =~ /$m1/;
+$g2 =~ /$g1/;
+$g2 =~ s/y/z/;		undef $g2;
+$g2 =~ s/$m1/z/;	undef $g2;
+$g2 =~ s//$g1/;		undef $g2;
+$g2 =~ s/$m1/$g1/;	undef $g2;
+$g2 =~ tr/x/y/;		undef $g2; # XXX can't extract var name yet
+
+my $foo = "abc";
+$foo =~ /$m1/;
+$foo =~ /$g1/;
+$foo =~ s/y/z/;
+$foo =~ s/$m1/z/;
+$foo =~ s//$g1/;
+$foo =~ s/$m1/$g1/;
+$foo =~ s/./$m1/e;
+EXPECT
+Use of uninitialized value $_ in pattern match (m//) at - line 5.
+Use of uninitialized value $m1 in regexp compilation at - line 6.
+Use of uninitialized value $_ in pattern match (m//) at - line 6.
+Use of uninitialized value $g1 in regexp compilation at - line 7.
+Use of uninitialized value $_ in pattern match (m//) at - line 7.
+Use of uninitialized value $_ in substitution (s///) at - line 9.
+Use of uninitialized value $m1 in regexp compilation at - line 10.
+Use of uninitialized value $_ in substitution (s///) at - line 10.
+Use of uninitialized value $_ in substitution (s///) at - line 10.
+Use of uninitialized value $_ in substitution (s///) at - line 11.
+Use of uninitialized value $g1 in substitution (s///) at - line 11.
+Use of uninitialized value $_ in substitution (s///) at - line 11.
+Use of uninitialized value $g1 in substitution (s///) at - line 11.
+Use of uninitialized value $m1 in regexp compilation at - line 12.
+Use of uninitialized value $_ in substitution (s///) at - line 12.
+Use of uninitialized value $_ in substitution (s///) at - line 12.
+Use of uninitialized value $g1 in substitution iterator at - line 12.
+Use of uninitialized value $_ in transliteration (tr///) at - line 13.
+Use of uninitialized value $_ in pattern match (m//) at - line 16.
+Use of uninitialized value $m1 in regexp compilation at - line 17.
+Use of uninitialized value $_ in pattern match (m//) at - line 17.
+Use of uninitialized value $g1 in regexp compilation at - line 18.
+Use of uninitialized value $_ in pattern match (m//) at - line 18.
+Use of uninitialized value $_ in substitution (s///) at - line 19.
+Use of uninitialized value $m1 in regexp compilation at - line 20.
+Use of uninitialized value $_ in substitution (s///) at - line 20.
+Use of uninitialized value $_ in substitution (s///) at - line 20.
+Use of uninitialized value $_ in substitution (s///) at - line 21.
+Use of uninitialized value $g1 in substitution (s///) at - line 21.
+Use of uninitialized value $_ in substitution (s///) at - line 21.
+Use of uninitialized value $g1 in substitution (s///) at - line 21.
+Use of uninitialized value $m1 in regexp compilation at - line 22.
+Use of uninitialized value $_ in substitution (s///) at - line 22.
+Use of uninitialized value $_ in substitution (s///) at - line 22.
+Use of uninitialized value $g1 in substitution iterator at - line 22.
+Use of uninitialized value $_ in transliteration (tr///) at - line 23.
+Use of uninitialized value $g2 in pattern match (m//) at - line 25.
+Use of uninitialized value $m1 in regexp compilation at - line 26.
+Use of uninitialized value $g2 in pattern match (m//) at - line 26.
+Use of uninitialized value $g1 in regexp compilation at - line 27.
+Use of uninitialized value $g2 in pattern match (m//) at - line 27.
+Use of uninitialized value $g2 in substitution (s///) at - line 28.
+Use of uninitialized value $m1 in regexp compilation at - line 29.
+Use of uninitialized value $g2 in substitution (s///) at - line 29.
+Use of uninitialized value $g2 in substitution (s///) at - line 29.
+Use of uninitialized value $g2 in substitution (s///) at - line 30.
+Use of uninitialized value $g1 in substitution (s///) at - line 30.
+Use of uninitialized value $g2 in substitution (s///) at - line 30.
+Use of uninitialized value $g1 in substitution (s///) at - line 30.
+Use of uninitialized value $m1 in regexp compilation at - line 31.
+Use of uninitialized value $g2 in substitution (s///) at - line 31.
+Use of uninitialized value $g2 in substitution (s///) at - line 31.
+Use of uninitialized value $g1 in substitution iterator at - line 31.
+Use of uninitialized value in transliteration (tr///) at - line 32.
+Use of uninitialized value $m1 in regexp compilation at - line 35.
+Use of uninitialized value $g1 in regexp compilation at - line 36.
+Use of uninitialized value $m1 in regexp compilation at - line 38.
+Use of uninitialized value $g1 in substitution (s///) at - line 39.
+Use of uninitialized value $m1 in regexp compilation at - line 40.
+Use of uninitialized value $g1 in substitution iterator at - line 40.
+Use of uninitialized value $m1 in substitution iterator at - line 41.
+########
+use warnings 'uninitialized';
+my ($m1);
+
+{ my $foo = "abc"; (substr($foo,0,0)) = ($m1) }
+EXPECT
+Use of uninitialized value $m1 in list assignment at - line 4.
+########
+use warnings 'uninitialized';
+our ($g1);
+
+study;
+study $g1;
+EXPECT
+Use of uninitialized value $_ in study at - line 4.
+Use of uninitialized value $g1 in study at - line 5.
+########
+use warnings 'uninitialized';
+my ($m1);
+
+pos()=0;
+pos($m1)=0;
+EXPECT
+Use of uninitialized value $_ in scalar assignment at - line 4.
+Use of uninitialized value $m1 in scalar assignment at - line 5.
+########
+use warnings 'uninitialized';
+my ($m1);
+our ($g1);
+
+$v = pos($m1) + 1;
+$v = pos($g1) + 1;
+$m1 = 0;
+$g1 = "";
+$v = pos($m1) + 1;
+$v = pos($g1) + 1;
+EXPECT
+Use of uninitialized value in addition (+) at - line 5.
+Use of uninitialized value in addition (+) at - line 6.
+Use of uninitialized value in addition (+) at - line 9.
+Use of uninitialized value in addition (+) at - line 10.
+########
+use warnings 'uninitialized';
+my ($m1);
+
+{ my $x = "a" x $m1 }		# NB LHS of repeat does not warn
+{ my @x = ("a") x $m1 }
+EXPECT
+Use of uninitialized value $m1 in repeat (x) at - line 4.
+Use of uninitialized value $m1 in repeat (x) at - line 5.
+########
+use warnings 'uninitialized';
+my ($m1, $v);
+our ($g1);
+
+$v = "$m1";
+
+$v = $m1 lt $g1;
+$v = $m1 le $g1;
+$v = $m1 gt $g1;
+$v = $m1 ge $g1;
+$v = $m1 eq $g1;
+$v = $m1 ne $g1;
+$v = $m1 cmp $g1;
+EXPECT
+Use of uninitialized value $m1 in string at - line 5.
+Use of uninitialized value $m1 in string lt at - line 7.
+Use of uninitialized value $g1 in string lt at - line 7.
+Use of uninitialized value $m1 in string le at - line 8.
+Use of uninitialized value $g1 in string le at - line 8.
+Use of uninitialized value $m1 in string gt at - line 9.
+Use of uninitialized value $g1 in string gt at - line 9.
+Use of uninitialized value $m1 in string ge at - line 10.
+Use of uninitialized value $g1 in string ge at - line 10.
+Use of uninitialized value $m1 in string eq at - line 11.
+Use of uninitialized value $g1 in string eq at - line 11.
+Use of uninitialized value $m1 in string ne at - line 12.
+Use of uninitialized value $g1 in string ne at - line 12.
+Use of uninitialized value $m1 in string comparison (cmp) at - line 13.
+Use of uninitialized value $g1 in string comparison (cmp) at - line 13.
+########
+use warnings 'uninitialized';
+my ($m1, $v);
+our ($g1);
+
+$v = atan2($m1,$g1);
+$v = sin $m1;
+$v = cos $m1;
+$v = rand $m1;
+$v = srand $m1;
+$v = exp $m1;
+$v = eval {log $m1};
+$v = sqrt $m1;
+$v = hex $m1;
+$v = oct $m1;
+$v = length $m1;
+$v = length;
+EXPECT
+Use of uninitialized value $g1 in atan2 at - line 5.
+Use of uninitialized value $m1 in atan2 at - line 5.
+Use of uninitialized value $m1 in sin at - line 6.
+Use of uninitialized value $m1 in cos at - line 7.
+Use of uninitialized value $m1 in rand at - line 8.
+Use of uninitialized value $m1 in srand at - line 9.
+Use of uninitialized value $m1 in exp at - line 10.
+Use of uninitialized value $m1 in log at - line 11.
+Use of uninitialized value $m1 in sqrt at - line 12.
+Use of uninitialized value $m1 in hex at - line 13.
+Use of uninitialized value $m1 in oct at - line 14.
+Use of uninitialized value $m1 in length at - line 15.
+Use of uninitialized value $_ in length at - line 16.
+########
+use warnings 'uninitialized';
+my ($m1, $v);
+our ($g1);
+
+$v = substr $m1, $g1;
+$v = substr $m1, $g1, $m2;
+$v = substr $m1, $g1, $m2, $g2;	undef $m1;
+substr($m1, $g1) = $g2;		undef $m1; # NB global2
+substr($m1, $g1, $m2) = $g2;	undef $m1; # isn't identified
+
+$v = eval {vec ($m1, $g1, $m2)};
+eval {vec ($m1, $g1, $m2) = $g2};	undef $m1; # ditto
+
+$v = index  $m1, $m2;
+$v = index  $m1, $m2, $g1;
+$v = rindex $m1, $m2;
+$v = rindex $m1, $m2, $g1;
+EXPECT
+Use of uninitialized value $g1 in substr at - line 5.
+Use of uninitialized value $m1 in substr at - line 5.
+Use of uninitialized value $m2 in substr at - line 6.
+Use of uninitialized value $g1 in substr at - line 6.
+Use of uninitialized value $m1 in substr at - line 6.
+Use of uninitialized value $g2 in substr at - line 7.
+Use of uninitialized value $m2 in substr at - line 7.
+Use of uninitialized value $g1 in substr at - line 7.
+Use of uninitialized value $m1 in substr at - line 7.
+Use of uninitialized value $m1 in substr at - line 7.
+Use of uninitialized value $g1 in substr at - line 8.
+Use of uninitialized value $m1 in substr at - line 8.
+Use of uninitialized value in scalar assignment at - line 8.
+Use of uninitialized value $m2 in substr at - line 9.
+Use of uninitialized value $g1 in substr at - line 9.
+Use of uninitialized value $m1 in substr at - line 9.
+Use of uninitialized value in scalar assignment at - line 9.
+Use of uninitialized value $m2 in vec at - line 11.
+Use of uninitialized value $g1 in vec at - line 11.
+Use of uninitialized value $m1 in vec at - line 11.
+Use of uninitialized value $m2 in vec at - line 12.
+Use of uninitialized value $g1 in vec at - line 12.
+Use of uninitialized value $m1 in vec at - line 12.
+Use of uninitialized value $m1 in index at - line 14.
+Use of uninitialized value $m2 in index at - line 14.
+Use of uninitialized value $g1 in index at - line 15.
+Use of uninitialized value $m1 in index at - line 15.
+Use of uninitialized value $m2 in index at - line 15.
+Use of uninitialized value $m1 in rindex at - line 16.
+Use of uninitialized value $m2 in rindex at - line 16.
+Use of uninitialized value $g1 in rindex at - line 17.
+Use of uninitialized value $m1 in rindex at - line 17.
+Use of uninitialized value $m2 in rindex at - line 17.
+########
+use warnings 'uninitialized';
+my ($m1, $v);
+our ($g1);
+
+$v = sprintf $m1;
+$v = sprintf '%d%d%d%d', $m1, $m2, $g1, $g2;
+my $m3; eval {formline $m3 };
+formline '@<<@<<@<<@<<', $m1, $m2, $g1, $g2;
+EXPECT
+Use of uninitialized value $m1 in sprintf at - line 5.
+Use of uninitialized value $m1 in sprintf at - line 6.
+Use of uninitialized value $m2 in sprintf at - line 6.
+Use of uninitialized value $g1 in sprintf at - line 6.
+Use of uninitialized value $g2 in sprintf at - line 6.
+Use of uninitialized value $m3 in formline at - line 7.
+Use of uninitialized value $m1 in formline at - line 8.
+Use of uninitialized value $m2 in formline at - line 8.
+Use of uninitialized value $g1 in formline at - line 8.
+Use of uninitialized value $g2 in formline at - line 8.
+########
+use warnings 'uninitialized';
+my ($m1, $v);
+our ($g1);
+
+$v = crypt $m1, $g1;
+
+$v = ord;
+$v = ord $m1;
+$v = chr;
+$v = chr $m1;
+
+# XXX these functions don't warn!
+$v = ucfirst;
+$v = ucfirst $m1;
+$v = lcfirst;
+$v = lcfirst $m1;
+$v = uc;
+$v = uc $m1;
+$v = lc;
+$v = lc $m1;
+
+$v = quotemeta;
+$v = quotemeta $m1;
+EXPECT
+Use of uninitialized value $m1 in crypt at - line 5.
+Use of uninitialized value $g1 in crypt at - line 5.
+Use of uninitialized value $_ in ord at - line 7.
+Use of uninitialized value $m1 in ord at - line 8.
+Use of uninitialized value $_ in chr at - line 9.
+Use of uninitialized value $m1 in chr at - line 10.
+Use of uninitialized value $_ in quotemeta at - line 22.
+Use of uninitialized value $m1 in quotemeta at - line 23.
+########
+use warnings 'uninitialized';
+my ($m1, $v1, $v2, $v3, $v4);
+our ($g1);
+
+($v1,$v2,$v3,$v4) = split;
+($v1,$v2,$v3,$v4) = split $m1;
+($v1,$v2,$v3,$v4) = split $m1, $m2;
+($v1,$v2,$v3,$v4) = split $m1, $m2, $g1;
+
+$v1 = join $m1;
+$v2 = join $m1, $m2;
+$v3 = join $m1, $m2, $m3;
+EXPECT
+Use of uninitialized value $_ in split at - line 5.
+Use of uninitialized value $m1 in regexp compilation at - line 6.
+Use of uninitialized value $_ in split at - line 6.
+Use of uninitialized value $m1 in regexp compilation at - line 7.
+Use of uninitialized value $m2 in split at - line 7.
+Use of uninitialized value $m1 in regexp compilation at - line 8.
+Use of uninitialized value $g1 in split at - line 8.
+Use of uninitialized value $m2 in split at - line 8.
+Use of uninitialized value $m1 in join or string at - line 10.
+Use of uninitialized value $m1 in join or string at - line 11.
+Use of uninitialized value $m2 in join or string at - line 11.
+Use of uninitialized value $m1 in join or string at - line 12.
+Use of uninitialized value $m2 in join or string at - line 12.
+Use of uninitialized value $m3 in join or string at - line 12.
+########
+use warnings 'uninitialized';
+my ($m1, $m2, @ma, $v);
+
+our @foo1=(1,undef); chomp @foo1;
+my  @foo2=(1,undef); chomp @foo2;
+our @foo3=(1,undef); chop  @foo3;
+my  @foo4=(1,undef); chop  @foo4;
+our @foo5=(1,undef); $v = sprintf "%s%s",@foo5;
+my  @foo6=(1,undef); $v = sprintf "%s%s",@foo6;
+our %foo7=('foo'=>'bar','baz'=>undef); $v = sprintf "%s%s",%foo7;
+my  %foo8=('foo'=>'bar','baz'=>undef); $v = sprintf "%s%s",%foo8;
+our @foo9 =(1,undef); $v = sprintf "%s%s%s%s",$m1,@foo9, $ma[2];
+my  @foo10=(1,undef); $v = sprintf "%s%s%s%s",$m2,@foo10,$ma[2];
+our %foo11=('foo'=>'bar','baz'=>undef); $v = join '', %foo11;
+my  %foo12=('foo'=>'bar','baz'=>undef); $v = join '', %foo12;
+our %foo13=(1..2000,'foo'=>'bar','baz'=>undef); $v = join '', %foo13;
+my  %foo14=(1..2000,'foo'=>'bar','baz'=>undef); $v = join '', %foo14;
+EXPECT
+Use of uninitialized value $foo1[1] in chomp at - line 4.
+Use of uninitialized value $foo2[1] in chomp at - line 5.
+Use of uninitialized value $foo3[1] in chop at - line 6.
+Use of uninitialized value $foo4[1] in chop at - line 7.
+Use of uninitialized value $foo5[1] in sprintf at - line 8.
+Use of uninitialized value $foo6[1] in sprintf at - line 9.
+Use of uninitialized value $foo7{"baz"} in sprintf at - line 10.
+Use of uninitialized value $foo8{"baz"} in sprintf at - line 11.
+Use of uninitialized value $m1 in sprintf at - line 12.
+Use of uninitialized value $foo9[1] in sprintf at - line 12.
+Use of uninitialized value in sprintf at - line 12.
+Use of uninitialized value $m2 in sprintf at - line 13.
+Use of uninitialized value $foo10[1] in sprintf at - line 13.
+Use of uninitialized value in sprintf at - line 13.
+Use of uninitialized value $foo11{"baz"} in join or string at - line 14.
+Use of uninitialized value $foo12{"baz"} in join or string at - line 15.
+Use of uninitialized value within %foo13 in join or string at - line 16.
+Use of uninitialized value within %foo14 in join or string at - line 17.
+########
+use warnings 'uninitialized';
+my ($v);
+
+undef $^A; $v = $^A + ${^FOO}; # should output '^A' not chr(1)
+*GLOB1 = *GLOB2;
+$v = $GLOB1 + 1;
+$v = $GLOB2 + 1;
+EXPECT
+Use of uninitialized value $^FOO in addition (+) at - line 4.
+Use of uninitialized value $^A in addition (+) at - line 4.
+Use of uninitialized value $GLOB1 in addition (+) at - line 6.
+Use of uninitialized value $GLOB2 in addition (+) at - line 7.
+########
+use warnings 'uninitialized';
+my ($v);
+
+# check hash key is sanitised
+my %h = ("\0011\002\r\n\t\f\"\\abcdefghijklmnopqrstuvwxyz", undef);
+$v = join '', %h;
+EXPECT
+Use of uninitialized value $h{"\0011\2\r\n\t\f\"\\abcdefghijklm"...} in join or string at - line 6.
+########
+use warnings 'uninitialized';
+my ($m1, $v);
+our ($g1);
+
+$v = eval { \&$m1 };
+$v = eval { \&$g1 };
+
+my @a;
+@a = splice @a, $m1, $g1;
+$v = 1 + splice @a, $m1, $g1;
+
+my $x = bless [], 'Z';
+eval { $x->$m1() };
+
+eval { &$m1() };
+eval { &$g1() };
+
+warn $m1,$g1,"foo";
+
+eval { die $m1, $g1 };
+
+reset $m1;
+reset $g1;
+EXPECT
+Use of uninitialized value $m1 in subroutine dereference at - line 5.
+Use of uninitialized value $m1 in subroutine dereference at - line 5.
+Use of uninitialized value $g1 in subroutine dereference at - line 6.
+Use of uninitialized value $g1 in subroutine dereference at - line 6.
+Use of uninitialized value $m1 in splice at - line 9.
+Use of uninitialized value $g1 in splice at - line 9.
+Use of uninitialized value $m1 in splice at - line 10.
+Use of uninitialized value $g1 in splice at - line 10.
+Use of uninitialized value in addition (+) at - line 10.
+Use of uninitialized value $m1 in method lookup at - line 13.
+Use of uninitialized value in subroutine entry at - line 15.
+Use of uninitialized value in subroutine entry at - line 16.
+Use of uninitialized value $m1 in warn at - line 18.
+Use of uninitialized value $g1 in warn at - line 18.
+foo at - line 18.
+Use of uninitialized value $m1 in die at - line 20.
+Use of uninitialized value $g1 in die at - line 20.
+Use of uninitialized value $m1 in symbol reset at - line 22.
+Use of uninitialized value $g1 in symbol reset at - line 23.
+########
+use warnings 'uninitialized';
+my ($m1);
+our ($g1);
+
+open FOO;		# accesses $FOO
+my $foo = 'FO';
+open($foo."O");	# accesses $FOO
+open my $x;		# accesses ${*$x}
+open $foobar;	# accesses ${*$foobar}
+my $y;
+open $y, $m1;
+eval { open $y, $m1, $g1 };
+open $y, '<', $g1;
+
+sysopen $y, $m1, $m2;
+sysopen $y, $m1, $g1, $m2;
+
+my $old = umask;
+umask $m1;
+umask $g1;
+umask $old;
+
+binmode STDIN, $m1;
+EXPECT
+Use of uninitialized value $FOO in open at - line 5.
+Use of uninitialized value in open at - line 7.
+Use of uninitialized value in open at - line 8.
+Use of uninitialized value in open at - line 9.
+Use of uninitialized value $m1 in open at - line 11.
+Use of uninitialized value $m1 in open at - line 12.
+Use of uninitialized value $g1 in open at - line 13.
+Use of uninitialized value $m2 in sysopen at - line 15.
+Use of uninitialized value $m1 in sysopen at - line 15.
+Use of uninitialized value $m2 in sysopen at - line 16.
+Use of uninitialized value $g1 in sysopen at - line 16.
+Use of uninitialized value $m1 in sysopen at - line 16.
+Use of uninitialized value $m1 in umask at - line 19.
+Use of uninitialized value $g1 in umask at - line 20.
+Use of uninitialized value $m1 in binmode at - line 23.
+Use of uninitialized value $m1 in binmode at - line 23.
+########
+use warnings 'uninitialized';
+my ($m1);
+our ($g1);
+
+eval { my $x; tie $x, $m1 };
+
+eval { my $x; read    $m1, $x, $g1 };
+eval { my $x; read    $m1, $x, $g1, $g2 };
+eval { my $x; sysread $m1, $x, $g1 };
+eval { my $x; sysread $m1, $x, $g1, $g2 };
+EXPECT
+Use of uninitialized value $m1 in tie at - line 5.
+Use of uninitialized value $m1 in tie at - line 5.
+Use of uninitialized value $m1 in ref-to-glob cast at - line 7.
+Use of uninitialized value $g1 in read at - line 7.
+Use of uninitialized value $m1 in ref-to-glob cast at - line 8.
+Use of uninitialized value $g1 in read at - line 8.
+Use of uninitialized value $g2 in read at - line 8.
+Use of uninitialized value $m1 in ref-to-glob cast at - line 9.
+Use of uninitialized value $g1 in sysread at - line 9.
+Use of uninitialized value $m1 in ref-to-glob cast at - line 10.
+Use of uninitialized value $g1 in sysread at - line 10.
+Use of uninitialized value $g2 in sysread at - line 10.
+########
+use warnings 'uninitialized';
+my ($m1);
+our ($g1, @ga);
+
+printf $m1;
+printf STDERR "%d%d%d%d\n", $m1, $m2, $g1, $g2;
+printf $ga[1000];
+printf STDERR "FOO1:%s\n", $ga[1000];
+printf STDERR "FOO2:%s%s%s%s\n", $m1, $g1, $ga[1],$m2;
+printf STDERR "FOO3:%s%s%s\n", "X", $ga[1],"Y";
+EXPECT
+Use of uninitialized value $m1 in printf at - line 5.
+Use of uninitialized value $m1 in printf at - line 6.
+Use of uninitialized value $m2 in printf at - line 6.
+Use of uninitialized value $g1 in printf at - line 6.
+Use of uninitialized value $g2 in printf at - line 6.
+0000
+Use of uninitialized value $ga[1000] in printf at - line 7.
+Use of uninitialized value $ga[1000] in printf at - line 8.
+FOO1:
+Use of uninitialized value $m1 in printf at - line 9.
+Use of uninitialized value $g1 in printf at - line 9.
+Use of uninitialized value in printf at - line 9.
+Use of uninitialized value $m2 in printf at - line 9.
+FOO2:
+Use of uninitialized value $ga[1] in printf at - line 10.
+FOO3:XY
+########
+use warnings 'uninitialized';
+my ($m1);
+our ($g1);
+
+eval { my $x; seek    $x,$m1, $g1 };
+eval { my $x; sysseek $x,$m1, $g1 };
+eval { syswrite $m1, $g1 }; # logic changed - now won't try $g1 if $m1 is bad
+# eval { syswrite STDERR, $m1 };        # XXX under utf8, can give
+# eval { syswrite STDERR, $m1, $g1 };   # XXX different warnings
+# eval { syswrite STDERR, $m1, $g1, $m2 };
+eval { my $x; socket $x, $m1, $g1, $m2 };
+eval { my ($x,$y); socketpair $x, $y, $m1, $g1, $m2 };
+EXPECT
+Use of uninitialized value $x in ref-to-glob cast at - line 5.
+Use of uninitialized value $g1 in seek at - line 5.
+Use of uninitialized value $m1 in seek at - line 5.
+Use of uninitialized value $x in ref-to-glob cast at - line 6.
+Use of uninitialized value $g1 in sysseek at - line 6.
+Use of uninitialized value $m1 in sysseek at - line 6.
+Use of uninitialized value $m1 in ref-to-glob cast at - line 7.
+Use of uninitialized value $m2 in socket at - line 11.
+Use of uninitialized value $g1 in socket at - line 11.
+Use of uninitialized value $m1 in socket at - line 11.
+Use of uninitialized value $m2 in socketpair at - line 12.
+Use of uninitialized value $g1 in socketpair at - line 12.
+Use of uninitialized value $m1 in socketpair at - line 12.
+########
+use Config; 
+BEGIN { 
+  if ( !$Config{d_flock} &&
+       !$Config{d_fcntl_can_lock} &&
+       !$Config{d_lockf} ) {
+    print <<EOM ;
+SKIPPED
+# flock not present
+EOM
+    exit ;
+  } 
+}
+use warnings 'uninitialized';
+our ($g1);
+
+eval { my $x; flock $x, $g1 };
+EXPECT
+Use of uninitialized value $x in ref-to-glob cast at - line 16.
+Use of uninitialized value $g1 in flock at - line 16.
+########
+use warnings 'uninitialized';
+my ($m1, $v);
+our ($g1);
+
+stat;
+lstat;
+stat $m1;
+lstat $g1;
+
+$v = -R $m1;
+$v = -W $m1;
+$v = -X $m1;
+$v = -r $m1;
+$v = -w $m1;
+$v = -x $m1;
+$v = -e $m1;
+$v = -o $m1;
+$v = -O $m1;
+$v = -z $m1;
+$v = -s $m1;
+$v = -M $m1;
+$v = -A $m1;
+$v = -C $m1;
+$v = -S $m1;
+$v = -c $m1;
+$v = -b $m1;
+$v = -f $m1;
+$v = -d $m1;
+$v = -p $m1;
+$v = -l $m1;
+$v = -u $m1;
+$v = -g $m1;
+# $v = -k $m1; # XXX this is a no-op under win32
+$v = -t $m1;
+$v = -T $m1;
+$v = -B $m1;
+EXPECT
+Use of uninitialized value $_ in stat at - line 5.
+Use of uninitialized value $_ in lstat at - line 6.
+Use of uninitialized value $m1 in stat at - line 7.
+Use of uninitialized value $g1 in lstat at - line 8.
+Use of uninitialized value $m1 in -R at - line 10.
+Use of uninitialized value $m1 in -W at - line 11.
+Use of uninitialized value $m1 in -X at - line 12.
+Use of uninitialized value $m1 in -r at - line 13.
+Use of uninitialized value $m1 in -w at - line 14.
+Use of uninitialized value $m1 in -x at - line 15.
+Use of uninitialized value $m1 in -e at - line 16.
+Use of uninitialized value $m1 in -o at - line 17.
+Use of uninitialized value $m1 in -O at - line 18.
+Use of uninitialized value $m1 in -z at - line 19.
+Use of uninitialized value $m1 in -s at - line 20.
+Use of uninitialized value $m1 in -M at - line 21.
+Use of uninitialized value $m1 in -A at - line 22.
+Use of uninitialized value $m1 in -C at - line 23.
+Use of uninitialized value $m1 in -S at - line 24.
+Use of uninitialized value $m1 in -c at - line 25.
+Use of uninitialized value $m1 in -b at - line 26.
+Use of uninitialized value $m1 in -f at - line 27.
+Use of uninitialized value $m1 in -d at - line 28.
+Use of uninitialized value $m1 in -p at - line 29.
+Use of uninitialized value $m1 in -l at - line 30.
+Use of uninitialized value $m1 in -l at - line 30.
+Use of uninitialized value $m1 in -u at - line 31.
+Use of uninitialized value $m1 in -g at - line 32.
+Use of uninitialized value $m1 in -t at - line 34.
+Use of uninitialized value $m1 in -T at - line 35.
+Use of uninitialized value $m1 in -B at - line 36.
+########
+use warnings 'uninitialized';
+my ($m1, $v);
+our ($g1);
+
+$v = localtime $m1;
+$v = gmtime $g1;
+EXPECT
+Use of uninitialized value $m1 in localtime at - line 5.
+Use of uninitialized value $g1 in gmtime at - line 6.
+########
+use warnings 'uninitialized';
+my ($m1, $v);
+
+$v = eval;
+$v = eval $m1;
+EXPECT
+Use of uninitialized value $_ in eval "string" at - line 4.
+Use of uninitialized value $m1 in eval "string" at - line 5.
+########
+use warnings 'uninitialized';
+my ($m1);
+
+exit $m1;
+EXPECT
+Use of uninitialized value $m1 in exit at - line 4.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/av b/gnu/usr.bin/perl/t/lib/warnings/av
index bc4907af932..79bd3b7600f 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/av
+++ b/gnu/usr.bin/perl/t/lib/warnings/av
@@ -7,24 +7,3 @@
   Attempt to clear deleted array	[av_clear]
   
 __END__
-# av.c
-$struct = [{foo => 1, bar => 2}, "FOO", "BAR"];
-use warnings 'deprecated';
-$a = $struct->{foo}; # This should warn.
-no warnings 'deprecated';
-$b = $struct->{bar}; # This should not warn.
-bless $struct, 'HlagHlag';
-use warnings 'deprecated';
-$a = $struct->{foo}; # This should warn.
-no warnings 'deprecated';
-$b = $struct->{bar}; # This should not warn.
-EXPECT
-Pseudo-hashes are deprecated at - line 4.
-Pseudo-hashes are deprecated at - line 9.
-########
-package Foo;
-use warnings 'deprecated';
-use fields qw(foo bar);
-my $foo = fields::new('Foo');
-$foo->{foo} = 42;
-EXPECT
diff --git a/gnu/usr.bin/perl/t/lib/warnings/doio b/gnu/usr.bin/perl/t/lib/warnings/doio
index 15d4c5e957d..a7165ada686 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/doio
+++ b/gnu/usr.bin/perl/t/lib/warnings/doio
@@ -60,10 +60,10 @@
 __END__
 # doio.c [Perl_do_open9]
 use warnings 'io' ;
-open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
+open(F, '|'."$^X -e 1|");
 close(F);
 no warnings 'io' ;
-open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
+open(G, '|'."$^X -e 1|");
 close(G);
 EXPECT
 Can't open bidirectional pipe at - line 3.
@@ -143,7 +143,7 @@ print $a ;
 no warnings 'uninitialized' ;
 print $b ;
 EXPECT
-Use of uninitialized value in print at - line 3.
+Use of uninitialized value $a in print at - line 3.
 ########
 # doio.c [Perl_my_stat Perl_my_lstat]
 use warnings 'io' ;
diff --git a/gnu/usr.bin/perl/t/lib/warnings/gv b/gnu/usr.bin/perl/t/lib/warnings/gv
index 5ed4eca0180..42565f23250 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/gv
+++ b/gnu/usr.bin/perl/t/lib/warnings/gv
@@ -8,8 +8,8 @@
 	@ISA = qw(Other) ;
 	fred() ;
 
-     Use of $# is deprecated
-     Use of $* is deprecated
+     $# is no longer supported
+     $* is no longer supported
 
 	$a = ${"#"} ;
  	$a = ${"*"} ;
@@ -22,14 +22,14 @@
     
 __END__
 # gv.c
-use warnings 'misc' ;
+use warnings 'syntax' ;
 @ISA = qw(Fred); joe()
 EXPECT
 Can't locate package Fred for @main::ISA at - line 3.
 Undefined subroutine &main::joe called at - line 3.
 ########
 # gv.c
-no warnings 'misc' ;
+no warnings 'syntax' ;
 @ISA = qw(Fred); joe()
 EXPECT
 Undefined subroutine &main::joe called at - line 3.
@@ -43,12 +43,11 @@ EXPECT
 Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5.
 ########
 # gv.c
-use warnings 'deprecated' ;
 $a = ${"#"};
 $a = ${"*"};
 no warnings 'deprecated' ;
 $a = ${"#"};
 $a = ${"*"};
 EXPECT
-Use of $# is deprecated at - line 3.
-Use of $* is deprecated at - line 4.
+$# is no longer supported at - line 2.
+$* is no longer supported at - line 3.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/mg b/gnu/usr.bin/perl/t/lib/warnings/mg
index f7c3ebf435c..2e2d4aa0f3e 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/mg
+++ b/gnu/usr.bin/perl/t/lib/warnings/mg
@@ -48,10 +48,15 @@ use warnings 'uninitialized';
 'foo' =~ /(foo)/;
 length $3;
 EXPECT
-Use of uninitialized value in length at - line 4.
+Use of uninitialized value $3 in length at - line 4.
 ########
 # mg.c
 use warnings 'uninitialized';
 length $3;
 EXPECT
-Use of uninitialized value in length at - line 3.
+Use of uninitialized value $3 in length at - line 3.
+########
+# mg.c
+use warnings 'uninitialized';
+$ENV{FOO} = undef; # should not warn
+EXPECT
diff --git a/gnu/usr.bin/perl/t/lib/warnings/op b/gnu/usr.bin/perl/t/lib/warnings/op
index 6d62d54517c..a7445906e63 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/op
+++ b/gnu/usr.bin/perl/t/lib/warnings/op
@@ -86,9 +86,6 @@
         fred() ; sub fred ($$) {}
 
 
-     Use of "package" with no arguments is deprecated
-	package;
-
     Package `%s' not found (did you use the incorrect case?)
 
     Use of /g modifier is meaningless in split
@@ -531,6 +528,7 @@ use warnings 'void' ;
 5 || print "bad\n";	# test OPpCONST_SHORTCIRCUIT
 use constant U => undef;
 print "boo\n" if U;	# test OPpCONST_SHORTCIRCUIT
+$[ = 2; # should not warn
 no warnings 'void' ;
 "abc"; # OP_CONST
 7 ; # OP_CONST
@@ -681,6 +679,14 @@ EXPECT
 Value of readdir() operator can be "0"; test with defined() at - line 4.
 ########
 # op.c
+use warnings 'misc';
+open FH, "<abc";
+($_ = <FH>) // ($_ = 1);
+opendir DH, ".";
+%a = (1,2,3,4) ;
+EXPECT
+########
+# op.c
 use warnings 'redefine' ;
 sub fred {}
 sub fred {}
@@ -899,16 +905,6 @@ Useless use of push with no values at - line 4.
 Useless use of unshift with no values at - line 5.
 ########
 # op.c
-use warnings 'deprecated' ;
-package;
-no warnings 'deprecated' ;
-package;
-EXPECT
-Use of "package" with no arguments is deprecated at - line 3.
-Global symbol "BEGIN" requires explicit package name at - line 4.
-BEGIN not safe after errors--compilation aborted at - line 4.
-########
-# op.c
 # 20020401 mjd@plover.com at suggestion of jfriedl@yahoo.com
 use warnings 'regexp';
 split /blah/g, "blah";
@@ -970,3 +966,113 @@ Possible precedence problem on bitwise & operator at - line 7.
 Possible precedence problem on bitwise ^ operator at - line 8.
 Possible precedence problem on bitwise | operator at - line 9.
 Possible precedence problem on bitwise & operator at - line 10.
+########
+# op.c
+
+# ok	=> local() has desired effect;
+# ignore=> local() silently ignored
+
+use warnings 'syntax';
+
+local(undef);		# OP_UNDEF		ignore
+sub lval : lvalue {};
+local(lval());		# OP_ENTERSUB
+local($x **= 1);	# OP_POW
+local($x *=  1);	# OP_MULTIPLY
+local($x /=  1);	# OP_DIVIDE
+local($x %=  1);	# OP_MODULO
+local($x x=  1);	# OP_REPEAT
+local($x +=  1);	# OP_ADD
+local($x -=  1);	# OP_SUBTRACT
+local($x .=  1);	# OP_CONCAT
+local($x <<= 1);	# OP_LEFT_SHIFT
+local($x >>= 1);	# OP_RIGHT_SHIFT
+local($x &=  1);	# OP_BIT_AND
+local($x ^=  1);	# OP_BIT_XOR
+local($x |=  1);	# OP_BIT_OR
+{
+    use integer;
+    local($x *= 1);	# OP_I_MULTIPLY
+    local($x /= 1);	# OP_I_DIVIDE
+    local($x %= 1);	# OP_I_MODULO
+    local($x += 1);	# OP_I_ADD
+    local($x -= 1);	# OP_I_SUBTRACT
+}
+local($x?$y:$z) = 1;	# OP_COND_EXPR		ok
+# these two are fatal run-time errors instead
+#local(@$a);		# OP_RV2AV		ok
+#local(%$a);		# OP_RV2HV		ok
+local(*a);		# OP_RV2GV		ok
+local(@a[1,2]);		# OP_ASLICE		ok
+local(@a{1,2});		# OP_HSLICE		ok
+local(@a = (1,2));	# OP_AASSIGN
+local($$x);		# OP_RV2SV		ok
+local($#a);		# OP_AV2ARYLEN
+local($x =   1);	# OP_SASSIGN
+local($x &&= 1);	# OP_ANDASSIGN
+local($x ||= 1);	# OP_ORASSIGN
+local($x //= 1);	# OP_DORASSIGN
+local($a[0]);		# OP_AELEMFAST		ok
+
+local(substr($x,0,1));	# OP_SUBSTR
+local(pos($x));		# OP_POS
+local(vec($x,0,1));	# OP_VEC
+local($a[$b]);		# OP_AELEM		ok
+local($a{$b});		# OP_HELEM		ok
+local($[);		# OP_CONST
+
+no warnings 'syntax';
+EXPECT
+Useless localization of subroutine entry at - line 10.
+Useless localization of exponentiation (**) at - line 11.
+Useless localization of multiplication (*) at - line 12.
+Useless localization of division (/) at - line 13.
+Useless localization of modulus (%) at - line 14.
+Useless localization of repeat (x) at - line 15.
+Useless localization of addition (+) at - line 16.
+Useless localization of subtraction (-) at - line 17.
+Useless localization of concatenation (.) or string at - line 18.
+Useless localization of left bitshift (<<) at - line 19.
+Useless localization of right bitshift (>>) at - line 20.
+Useless localization of bitwise and (&) at - line 21.
+Useless localization of bitwise xor (^) at - line 22.
+Useless localization of bitwise or (|) at - line 23.
+Useless localization of integer multiplication (*) at - line 26.
+Useless localization of integer division (/) at - line 27.
+Useless localization of integer modulus (%) at - line 28.
+Useless localization of integer addition (+) at - line 29.
+Useless localization of integer subtraction (-) at - line 30.
+Useless localization of list assignment at - line 39.
+Useless localization of array length at - line 41.
+Useless localization of scalar assignment at - line 42.
+Useless localization of logical and assignment (&&=) at - line 43.
+Useless localization of logical or assignment (||=) at - line 44.
+Useless localization of defined or assignment (//=) at - line 45.
+Useless localization of substr at - line 48.
+Useless localization of match position at - line 49.
+Useless localization of vec at - line 50.
+########
+# op.c
+use warnings 'deprecated';
+my $x1 if 0;
+my @x2 if 0;
+my %x3 if 0;
+my ($x4) if 0;
+my ($x5,@x6, %x7) if 0;
+0 && my $z1;
+0 && my (%z2);
+# these shouldn't warn
+our $x if 0;
+our $x unless 0;
+if (0) { my $w1 }
+if (my $w2) { $a=1 }
+if ($a && (my $w3 = 1)) {$a = 2}
+
+EXPECT
+Deprecated use of my() in false conditional at - line 3.
+Deprecated use of my() in false conditional at - line 4.
+Deprecated use of my() in false conditional at - line 5.
+Deprecated use of my() in false conditional at - line 6.
+Deprecated use of my() in false conditional at - line 7.
+Deprecated use of my() in false conditional at - line 8.
+Deprecated use of my() in false conditional at - line 9.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/pad b/gnu/usr.bin/perl/t/lib/warnings/pad
index 2359a785112..bf5c367fc94 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/pad
+++ b/gnu/usr.bin/perl/t/lib/warnings/pad
@@ -1,24 +1,24 @@
   pad.c		AOK
 
-     "my" variable %s masks earlier declaration in same scope
+     "%s" variable %s masks earlier declaration in same scope
 	my $x;
 	my $x ;
 
-     Variable "%s" may be unavailable 
+     Variable "%s" will not stay shared 
 	sub x {
       	    my $x;
       	    sub y {
-         	$x
+         	sub { $x }
       	    }
    	}
 
-     Variable "%s" will not stay shared 
 	sub x {
       	    my $x;
       	    sub y {
-         	sub { $x }
+         	$x
       	    }
    	}
+
     "our" variable %s redeclared	(Did you mean "local" instead of "our"?)
 	our $x;
 	{
@@ -33,12 +33,60 @@ use warnings 'misc' ;
 my $x ;
 my $x ;
 my $y = my $y ;
+my $p ;
+package X ;
+my $p ;
+package main ;
 no warnings 'misc' ;
 my $x ;
 my $y ;
+my $p ;
+EXPECT
+"my" variable $x masks earlier declaration in same scope at - line 4.
+"my" variable $y masks earlier declaration in same statement at - line 5.
+"my" variable $p masks earlier declaration in same scope at - line 8.
+########
+# pad.c
+use warnings 'misc' ;
+our $x ;
+my $x ;
+our $y = my $y ;
+our $p ;
+package X ;
+my $p ;
+package main ;
+no warnings 'misc' ;
+our $z ;
+my $z ;
+our $t = my $t ;
+our $q ;
+package X ;
+my $q ;
 EXPECT
 "my" variable $x masks earlier declaration in same scope at - line 4.
 "my" variable $y masks earlier declaration in same statement at - line 5.
+"my" variable $p masks earlier declaration in same scope at - line 8.
+########
+# pad.c
+use warnings 'misc' ;
+my $x ;
+our $x ;
+my $y = our $y ;
+my $p ;
+package X ;
+our $p ;
+package main ;
+no warnings 'misc' ;
+my $z ;
+our $z ;
+my $t = our $t ;
+my $q ;
+package X ;
+our $q ;
+EXPECT
+"our" variable $x masks earlier declaration in same scope at - line 4.
+"our" variable $y masks earlier declaration in same statement at - line 5.
+"our" variable $p masks earlier declaration in same scope at - line 8.
 ########
 # pad.c
 use warnings 'closure' ;
@@ -65,24 +113,108 @@ EXPECT
 # pad.c
 use warnings 'closure' ;
 sub x {
-      our $x;
+      my $x;
       sub y {
-         $x
+         sub { $x }
       }
    }
 EXPECT
+Variable "$x" will not stay shared at - line 6.
+########
+# pad.c
+use warnings 'closure' ;
+sub x {
+    my $x;
+    sub {
+	$x;
+	sub y {
+	    $x
+	}
+    }->();
+}
+EXPECT
+Variable "$x" will not stay shared at - line 9.
+########
+# pad.c
+use warnings 'closure' ;
+my $x;
+sub {
+    $x;
+    sub f {
+	sub { $x }->();
+    }
+}->();
+EXPECT
 
 ########
 # pad.c
 use warnings 'closure' ;
+sub {
+    my $x;
+    sub f { $x }
+}->();
+EXPECT
+Variable "$x" is not available at - line 5.
+########
+# pad.c
+use warnings 'closure' ;
+sub {
+    my $x;
+    eval 'sub f { $x }';
+}->();
+EXPECT
+
+########
+# pad.c
+use warnings 'closure' ;
+sub {
+    my $x;
+    sub f { eval '$x' }
+}->();
+f();
+EXPECT
+Variable "$x" is not available at (eval 1) line 2.
+########
+# pad.c
+use warnings 'closure' ;
 sub x {
-      my $x;
+      our $x;
       sub y {
-         sub { $x }
+         $x
       }
    }
 EXPECT
-Variable "$x" may be unavailable at - line 6.
+
+########
+# pad.c
+# see bugid 1754
+use warnings 'closure' ;
+sub f {
+    my $x;
+    sub { eval '$x' };
+}
+f()->();
+EXPECT
+Variable "$x" is not available at (eval 1) line 2.
+########
+use warnings 'closure' ;
+{
+    my $x = 1;
+    $y = \$x; # force abandonment rather than clear-in-place at scope exit
+    sub f2 { eval '$x' }
+}
+f2();
+EXPECT
+Variable "$x" is not available at (eval 1) line 2.
+########
+use warnings 'closure' ;
+for my $x (1,2,3) {
+    sub f { eval '$x' }
+    f();
+}
+f();
+EXPECT
+Variable "$x" is not available at (eval 4) line 2.
 ########
 # pad.c
 no warnings 'closure' ;
@@ -96,13 +228,84 @@ EXPECT
 
 ########
 use warnings 'misc' ;
+my $x;
+{
+    my $x;
+}
+EXPECT
+########
+# pad.c
+use warnings 'misc' ;
+our $x ;
+our $x ;
+our $y = our $y ;
+our $p ;
+package X ;
+our $p ;
+package main ;
+no warnings 'misc' ;
+our $a ;
+our $a ;
+our $b = our $b ;
+our $c ;
+package X ;
+our $c ;
+EXPECT
+"our" variable $x redeclared at - line 4.
+"our" variable $y redeclared at - line 5.
+########
+use warnings 'misc' ;
 our $x;
 {
     our $x;
 }
+our $x;
+no warnings 'misc' ;
+our $y;
+{
+    our $y;
+}
+our $y;
 EXPECT
 "our" variable $x redeclared at - line 4.
 	(Did you mean "local" instead of "our"?)
+"our" variable $x redeclared at - line 6.
+########
+use warnings 'misc' ;
+our $x;
+{
+    my $x;
+}
+no warnings 'misc' ;
+our $y;
+{
+    my $y;
+}
+EXPECT
+########
+use warnings 'misc' ;
+my $x;
+{
+    our $x;
+}
+no warnings 'misc' ;
+my $y;
+{
+    our $y;
+}
+EXPECT
+########
+use warnings 'misc' ;
+my $x;
+{
+    my $x;
+}
+no warnings 'misc' ;
+my $y;
+{
+    my $y;
+}
+EXPECT
 ########
 # an our var being introduced should suppress errors about global syms
 use strict;
diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp b/gnu/usr.bin/perl/t/lib/warnings/pp
index 5ed7aa08916..d1581446f00 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/pp
+++ b/gnu/usr.bin/perl/t/lib/warnings/pp
@@ -59,7 +59,7 @@ $x = undef; $y = $$x;
 no warnings 'uninitialized' ;
 $u = undef; $v = $$u;
 EXPECT
-Use of uninitialized value in scalar dereference at - line 3.
+Use of uninitialized value $x in scalar dereference at - line 3.
 ########
 # pp.c
 use warnings 'misc' ;
diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp_ctl b/gnu/usr.bin/perl/t/lib/warnings/pp_ctl
index ac01f277b1f..923d54cf109 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/pp_ctl
+++ b/gnu/usr.bin/perl/t/lib/warnings/pp_ctl
@@ -219,7 +219,19 @@ EXPECT
 use warnings;
 eval 'print $foo';
 EXPECT
-Use of uninitialized value in print at (eval 1) line 1.
+Use of uninitialized value $foo in print at (eval 1) line 1.
+########
+# pp_ctl.c
+use warnings 'portable';
+eval 'use 5.6.1';
+EXPECT
+v-string in use/require non-portable at (eval 1) line 2.
+########
+# pp_ctl.c
+use warnings 'portable';
+eval 'use v5.6.1';
+EXPECT
+v-string in use/require non-portable at (eval 1) line 2.
 ########
 # pp_ctl.c
 use warnings;
@@ -228,3 +240,20 @@ use warnings;
     eval 'print $foo';
 }
 EXPECT
+########
+# pp_ctl.c
+use warnings;
+eval 'use 5.006; use 5.10.0';
+EXPECT
+########
+# pp_ctl.c
+use warnings;
+eval '{use 5.006;} use 5.10.0';
+EXPECT
+v-string in use/require non-portable at (eval 1) line 2.
+########
+# pp_ctl.c
+use warnings;
+eval 'use vars; use 5.10.0';
+EXPECT
+v-string in use/require non-portable at (eval 1) line 2.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp_hot b/gnu/usr.bin/perl/t/lib/warnings/pp_hot
index 4e10627325b..a0b9b101392 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/pp_hot
+++ b/gnu/usr.bin/perl/t/lib/warnings/pp_hot
@@ -44,9 +44,6 @@
   Deep recursion on anonymous subroutine 	[Perl_sub_crush_depth]
     $a = sub { &$a if $a++ < 200} &$a
 
-  Possible Y2K bug: about to append an integer to '19' [pp_concat]
-    $x     = "19$yy\n";
-
   Use of reference "%s" as array index [pp_aelem]
     $x[\1]
 
@@ -145,7 +142,7 @@ my @b = @$a;
 no warnings 'uninitialized' ;
 my @c = @$a;
 EXPECT
-Use of uninitialized value in array dereference at - line 4.
+Use of uninitialized value $a in array dereference at - line 4.
 ########
 # pp_hot.c [pp_rv2hv]
 use warnings 'uninitialized' ;
@@ -154,7 +151,7 @@ my %b = %$a;
 no warnings 'uninitialized' ;
 my %c = %$a;
 EXPECT
-Use of uninitialized value in hash dereference at - line 4.
+Use of uninitialized value $a in hash dereference at - line 4.
 ########
 # pp_hot.c [pp_aassign]
 use warnings 'misc' ;
@@ -269,37 +266,11 @@ a($x . $y);	# should warn twice
 $x .= $y;	# should warn once
 $y .= $y;	# should warn once
 EXPECT
-Use of uninitialized value in concatenation (.) or string at - line 5.
-Use of uninitialized value in concatenation (.) or string at - line 6.
-Use of uninitialized value in concatenation (.) or string at - line 6.
-Use of uninitialized value in concatenation (.) or string at - line 7.
-Use of uninitialized value in concatenation (.) or string at - line 8.
-########
-# pp_hot.c [pp_concat]
-use warnings 'y2k';
-use Config;
-BEGIN {
-    unless ($Config{ccflags} =~ /Y2KWARN/) {
-	print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
-	exit 0;
-    }
-}
-my $x;
-my $yy = 78;
-$x     = "19$yy\n";
-$x     = "19" . $yy . "\n";
-$x     = "319$yy\n";
-$x     = "319" . $yy . "\n";
-$yy = 19;
-$x     = "ok $yy\n";
-$yy = 9;
-$x     = 1 . $yy;
-no warnings 'y2k';
-$x     = "19$yy\n";
-$x     = "19" . $yy . "\n";
-EXPECT
-Possible Y2K bug: about to append an integer to '19' at - line 12.
-Possible Y2K bug: about to append an integer to '19' at - line 13.
+Use of uninitialized value $x in concatenation (.) or string at - line 5.
+Use of uninitialized value $x in concatenation (.) or string at - line 6.
+Use of uninitialized value $y in concatenation (.) or string at - line 6.
+Use of uninitialized value $y in concatenation (.) or string at - line 7.
+Use of uninitialized value $y in concatenation (.) or string at - line 8.
 ########
 # pp_hot.c [pp_aelem]
 {
diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp_pack b/gnu/usr.bin/perl/t/lib/warnings/pp_pack
index 0f447c75b69..62ae3a9a89e 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/pp_pack
+++ b/gnu/usr.bin/perl/t/lib/warnings/pp_pack
@@ -28,7 +28,7 @@ my $b = $$a;
 no warnings 'uninitialized' ;
 my $c = $$a;
 EXPECT
-Use of uninitialized value in scalar dereference at - line 4.
+Use of uninitialized value $a in scalar dereference at - line 4.
 ########
 # pp_pack.c
 use warnings 'pack' ;
diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp_sys b/gnu/usr.bin/perl/t/lib/warnings/pp_sys
index d84ff75feaa..2e9c613b028 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/pp_sys
+++ b/gnu/usr.bin/perl/t/lib/warnings/pp_sys
@@ -197,6 +197,14 @@ EXPECT
 Filehandle STDIN opened only for input at - line 3.
 ########
 # pp_sys.c [pp_send]
+use warnings 'io' ;
+syswrite STDIN, "fred";
+no warnings 'io' ;
+syswrite STDIN, "fred";
+EXPECT
+Filehandle STDIN opened only for input at - line 3.
+########
+# pp_sys.c [pp_send]
 use warnings 'closed' ;
 close STDIN; 
 syswrite STDIN, "fred", 1;
@@ -452,8 +460,63 @@ getc() on closed filehandle FH2 at - line 12.
 # pp_sys.c [pp_sselect]
 use warnings 'misc';
 $x = 1;
-select $x, undef, undef, undef;
+select $x, undef, undef, 1;
 no warnings 'misc';
-select $x, undef, undef, undef;
+select $x, undef, undef, 1;
 EXPECT
 Non-string passed as bitmask at - line 4.
+########
+use Config;
+BEGIN {
+    if (!$Config{d_fchdir}) {
+	print <<EOM;
+SKIPPED
+# fchdir not present
+EOM
+	exit;
+    }
+}
+opendir FOO, '.'; closedir FOO;
+open BAR, '.'; close BAR;
+opendir $dh, '.'; closedir $dh;
+open $fh, '.'; close $fh;
+chdir FOO;
+chdir BAR;
+chdir $dh;
+chdir $fh;
+use warnings qw(unopened closed) ;
+chdir FOO;
+chdir BAR;
+chdir $dh;
+chdir $fh;
+EXPECT
+chdir() on unopened filehandle FOO at - line 20.
+chdir() on closed filehandle BAR at - line 21.
+chdir() on unopened filehandle $dh at - line 22.
+chdir() on closed filehandle $fh at - line 23.
+########
+# pp_sys.c [pp_open]
+use warnings;
+opendir FOO, ".";
+opendir my $foo, ".";
+open FOO, "TEST";
+open $foo, "TEST";
+no warnings qw(io deprecated);
+open FOO, "TEST";
+open $foo, "TEST";
+EXPECT
+Opening dirhandle FOO also as a file at - line 5.
+Opening dirhandle $foo also as a file at - line 6.
+########
+# pp_sys.c [pp_open_dir]
+use warnings;
+open FOO, "TEST";
+open my $foo, "TEST";
+opendir FOO, ".";
+opendir $foo, ".";
+no warnings qw(io deprecated);
+opendir FOO, ".";
+opendir $foo, ".";
+EXPECT
+Opening filehandle FOO also as a directory at - line 5.
+Opening filehandle $foo also as a directory at - line 6.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/regcomp b/gnu/usr.bin/perl/t/lib/warnings/regcomp
index 49820165945..f85aa440c42 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/regcomp
+++ b/gnu/usr.bin/perl/t/lib/warnings/regcomp
@@ -2,10 +2,6 @@
 
   Quantifier unexpected on zero-length expression [S_study_chunk] 
 
-  (?p{}) is deprecated - use (??{})  [S_reg]
-    $a =~ /(?p{'x'})/ ;
-    
-
   Useless (%s%c) - %suse /%c modifier [S_reg] 
   Useless (%sc) - %suse /gc modifier [S_reg] 
 
@@ -56,6 +52,17 @@ $a =~ /a$x/ ;
 EXPECT
 Unrecognized escape \m passed through in regex; marked by <-- HERE in m/a\m <-- HERE / at - line 4.
 ########
+# regcomp.c [S_regatom]
+# The \q should warn, the \_ should NOT warn.
+use warnings 'regexp';
+"foo" =~ /\q/;
+"bar" =~ /\_/;
+no warnings 'regexp';
+"foo" =~ /\q/;
+"bar" =~ /\_/;
+EXPECT
+Unrecognized escape \q passed through in regex; marked by <-- HERE in m/\q <-- HERE / at - line 4.
+########
 # regcomp.c [S_regpposixcc S_checkposixcc]
 #
 use warnings 'regexp' ;
@@ -160,22 +167,6 @@ EXPECT
 Unrecognized escape \z in character class passed through in regex; marked by <-- HERE in m/[a\z <-- HERE b]/ at - line 3.
 
 ########
-# regcomp.c [S_study_chunk]
-use warnings 'deprecated' ;
-$a = "xx" ;
-$a =~ /(?p{'x'})/ ;
-no warnings ;
-use warnings 'regexp' ;
-$a =~ /(?p{'x'})/ ;
-use warnings;
-no warnings 'deprecated' ;
-no warnings 'regexp' ;
-no warnings 'syntax' ;
-$a =~ /(?p{'x'})/ ;
-EXPECT
-(?p{}) is deprecated - use (??{}) in regex; marked by <-- HERE in m/(?p <-- HERE {'x'})/ at - line 4.
-(?p{}) is deprecated - use (??{}) in regex; marked by <-- HERE in m/(?p <-- HERE {'x'})/ at - line 7.
-########
 # regcomp.c [S_reg]
 use warnings 'regexp' ;
 $a = qr/(?c)/;
diff --git a/gnu/usr.bin/perl/t/lib/warnings/taint b/gnu/usr.bin/perl/t/lib/warnings/taint
index fd6deed60f9..b0ec91c9383 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/taint
+++ b/gnu/usr.bin/perl/t/lib/warnings/taint
@@ -24,12 +24,20 @@ def
 open(FH, "<abc") ;
 $a = <FH> ;
 close FH ;
+chdir $a;
+no warnings 'taint' ;
 chdir $a ;
 print "xxx\n" ;
+use warnings 'taint' ;
+chdir $a ;
+print "yyy\n" ;
 EXPECT
+Insecure dependency in chdir while running with -T switch at - line 5.
+Insecure dependency in chdir while running with -T switch at - line 10.
 xxx
+yyy
 ########
--TU
+-t
 --FILE-- abc
 def
 --FILE--
@@ -37,13 +45,15 @@ def
 open(FH, "<abc") ;
 $a = <FH> ;
 close FH ;
-use warnings 'taint' ;
+chdir $a;
+no warnings 'taint' ;
 chdir $a ;
 print "xxx\n" ;
-no warnings 'taint' ;
+use warnings 'taint' ;
 chdir $a ;
 print "yyy\n" ;
 EXPECT
-Insecure dependency in chdir while running with -T switch at - line 6.
+Insecure dependency in chdir while running with -t switch at - line 5.
+Insecure dependency in chdir while running with -t switch at - line 10.
 xxx
 yyy
diff --git a/gnu/usr.bin/perl/t/lib/warnings/toke b/gnu/usr.bin/perl/t/lib/warnings/toke
index e49376c92bd..f4842a7d0cb 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/toke
+++ b/gnu/usr.bin/perl/t/lib/warnings/toke
@@ -279,9 +279,14 @@ Possible attempt to put comments in qw() list at - line 3.
 ########
 # toke.c
 use warnings 'syntax' ;
-print ("")
+print ("");
+print ("") and $x = 1;
+print ("") or die;
+print ("") // die;
+print (1+2) * 3 if 0; # only this one should warn
+print (1+2) if 0;
 EXPECT
-print (...) interpreted as function at - line 3.
+print (...) interpreted as function at - line 7.
 ########
 # toke.c
 no warnings 'syntax' ;
@@ -291,9 +296,10 @@ EXPECT
 ########
 # toke.c
 use warnings 'syntax' ;
-printf ("")
+printf ("");
+printf ("") . '';
 EXPECT
-printf (...) interpreted as function at - line 3.
+printf (...) interpreted as function at - line 4.
 ########
 # toke.c
 no warnings 'syntax' ;
@@ -303,9 +309,10 @@ EXPECT
 ########
 # toke.c
 use warnings 'syntax' ;
-sort ("")
+sort ("");
+sort ("") . '';
 EXPECT
-sort (...) interpreted as function at - line 3.
+sort (...) interpreted as function at - line 4.
 ########
 # toke.c
 no warnings 'syntax' ;
@@ -588,6 +595,11 @@ Warning: Use of "rand" without parentheses is ambiguous at - line 8.
 Warning: Use of "rand" without parentheses is ambiguous at - line 10.
 ########
 # toke.c
+use warnings "ambiguous";
+print for keys %+; # should not warn
+EXPECT
+########
+# toke.c
 sub fred {};
 -fred ;
 EXPECT
@@ -737,17 +749,6 @@ EXPECT
 Possible unintended interpolation of @mjd_previously_unused_array in string at - line 3.
 ########
 # toke.c
-# The \q should warn, the \_ should NOT warn.
-use warnings 'misc';
-"foo" =~ /\q/;
-"bar" =~ /\_/;
-no warnings 'misc';
-"foo" =~ /\q/;
-"bar" =~ /\_/;
-EXPECT
-Unrecognized escape \q passed through at - line 4.
-########
-# toke.c
 # 20020328 mjd-perl-patch+@plover.com at behest of jfriedl@yahoo.com
 use warnings 'regexp';
 "foo" =~ /foo/c;
@@ -816,4 +817,38 @@ eval q/5 6/;
 EXPECT
 Number found where operator expected at (eval 1) line 1, near "5 6"
 	(Missing operator before  6?)
-
+########
+# toke.c
+use warnings "syntax";
+$_ = $a = 1;
+$a !=~  /1/;
+$a !=~ m#1#;
+$a !=~/1/;
+$a !=~ ?/?;
+$a !=~ y/1//;
+$a !=~ tr/1//;
+$a !=~ s/1//;
+$a != ~/1/;
+no warnings "syntax";
+$a !=~  /1/;
+$a !=~ m#1#;
+$a !=~/1/;
+$a !=~ ?/?;
+$a !=~ y/1//;
+$a !=~ tr/1//;
+$a !=~ s/1//;
+EXPECT
+!=~ should be !~ at - line 4.
+!=~ should be !~ at - line 5.
+!=~ should be !~ at - line 6.
+!=~ should be !~ at - line 7.
+!=~ should be !~ at - line 8.
+!=~ should be !~ at - line 9.
+!=~ should be !~ at - line 10.
+########
+# toke.c
+our $foo :unique;
+use warnings 'deprecated';
+our $bar :unique;
+EXPECT
+Use of :unique is deprecated at - line 4.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/universal b/gnu/usr.bin/perl/t/lib/warnings/universal
index d9b1883532d..69921cf8fdb 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/universal
+++ b/gnu/usr.bin/perl/t/lib/warnings/universal
@@ -6,6 +6,7 @@
 
 __END__
 # universal.c [S_isa_lookup]
+print("SKIPPED\n# todo fix: overloading triggers spurious warnings\n"),exit;
 use warnings 'misc' ;
 @ISA = qw(Joe) ;
 my $a = bless [] ;
diff --git a/gnu/usr.bin/perl/t/lib/warnings/util b/gnu/usr.bin/perl/t/lib/warnings/util
index 4e960c1ea19..e632d09e0d7 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/util
+++ b/gnu/usr.bin/perl/t/lib/warnings/util
@@ -115,7 +115,7 @@ if ($x) {
 }
 EXPECT
 Name "main::y" used only once: possible typo at - line 5.
-Use of uninitialized value in print at - line 5.
+Use of uninitialized value $y in print at - line 5.
 ########
 # util.c
 use warnings;
@@ -126,7 +126,7 @@ if ($x) {
 }
 EXPECT
 Name "main::y" used only once: possible typo at - line 6.
-Use of uninitialized value in print at - line 6.
+Use of uninitialized value $y in print at - line 6.
 ########
 # util.c
 use warnings;
@@ -140,7 +140,7 @@ if ($x) {
 }
 EXPECT
 Name "main::y" used only once: possible typo at - line 7.
-Use of uninitialized value in print at - line 7.
+Use of uninitialized value $y in print at - line 7.
 ########
 # util.c
 use warnings;
@@ -155,4 +155,4 @@ if ($x) {
 }
 EXPECT
 Name "main::y" used only once: possible typo at - line 8.
-Use of uninitialized value in print at - line 8.
+Use of uninitialized value $y in print at - line 8.