Import perl-5.18.2

OK espie@ sthen@ deraadt@

5 files changed, 218 insertions, 68 deletions

diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/t/000prereq.t b/gnu/usr.bin/perl/cpan/IO-Compress/t/000prereq.t
index d8618117209..764821e9e29 100755
--- a/gnu/usr.bin/perl/cpan/IO-Compress/t/000prereq.t
+++ b/gnu/usr.bin/perl/cpan/IO-Compress/t/000prereq.t
@@ -25,7 +25,7 @@ BEGIN
         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
 
 
-    my $VERSION = '2.048';
+    my $VERSION = '2.060';
     my @NAMES = qw(
 			Compress::Raw::Bzip2
 			Compress::Raw::Zlib
diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/t/006zip.t b/gnu/usr.bin/perl/cpan/IO-Compress/t/006zip.t
index b4d1e649fbe..ad05cef376e 100755
--- a/gnu/usr.bin/perl/cpan/IO-Compress/t/006zip.t
+++ b/gnu/usr.bin/perl/cpan/IO-Compress/t/006zip.t
@@ -19,7 +19,7 @@ BEGIN {
     $extra = 1
         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
 
-    plan tests => 95 + $extra ;
+    plan tests => 101 + $extra ;
 
     use_ok('IO::Compress::Zip', qw(:all)) ;
     use_ok('IO::Uncompress::Unzip', qw(unzip $UnzipError)) ;
@@ -330,3 +330,31 @@ for my $method (ZIP_CM_DEFLATE, ZIP_CM_STORE, ZIP_CM_BZIP2)
     
     ok ! IO::Compress::Zip::isMethodAvailable(999), "999 not available";    
 }
+
+{
+    title "Memember & Comment 0";
+
+    my $lex = new LexFile my $file1;
+
+    my $content = 'hello' ;
+                 
+
+    my $zip = new IO::Compress::Zip $file1,
+                    Name => "0", Comment => "0" ;
+    isa_ok $zip, "IO::Compress::Zip";
+
+    is $zip->write($content), length($content), "write"; 
+
+    ok $zip->close(), "closed";                    
+
+
+
+    my $u = new IO::Uncompress::Unzip $file1, Append => 1, @_
+        or die "Cannot open $file1: $UnzipError";
+
+    isa_ok $u, "IO::Uncompress::Unzip";
+
+    my $name = $u->getHeaderInfo()->{Name};
+    
+    is $u->getHeaderInfo()->{Name}, "0", "Name is '0'";
+}
diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/t/01misc.t b/gnu/usr.bin/perl/cpan/IO-Compress/t/01misc.t
index 528b71f0342..150fb69bd6b 100755
--- a/gnu/usr.bin/perl/cpan/IO-Compress/t/01misc.t
+++ b/gnu/usr.bin/perl/cpan/IO-Compress/t/01misc.t
@@ -19,7 +19,7 @@ BEGIN {
     $extra = 1
         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
 
-    plan tests => 140 + $extra ;
+    plan tests => 163 + $extra ;
 
     use_ok('Scalar::Util');
     use_ok('IO::Compress::Base::Common');
@@ -47,24 +47,24 @@ sub My::testParseParameters()
     like $@, mkErr(': Expected even number of parameters, got 1'), 
             "Trap odd number of params";
 
-    eval { ParseParameters(1, {'Fred' => [1, 1, Parse_boolean, 0]}, Fred => 'joe') ; };
-    like $@, mkErr("Parameter 'Fred' must be an int, got 'joe'"), 
+    eval { ParseParameters(1, {'fred' => [Parse_boolean, 0]}, fred => 'joe') ; };
+    like $@, mkErr("Parameter 'fred' must be an int, got 'joe'"), 
             "wanted unsigned, got undef";
 
-    eval { ParseParameters(1, {'Fred' => [1, 1, Parse_unsigned, 0]}, Fred => undef) ; };
-    like $@, mkErr("Parameter 'Fred' must be an unsigned int, got 'undef'"), 
+    eval { ParseParameters(1, {'fred' => [Parse_unsigned, 0]}, fred => undef) ; };
+    like $@, mkErr("Parameter 'fred' must be an unsigned int, got 'undef'"), 
             "wanted unsigned, got undef";
 
-    eval { ParseParameters(1, {'Fred' => [1, 1, Parse_signed, 0]}, Fred => undef) ; };
-    like $@, mkErr("Parameter 'Fred' must be a signed int, got 'undef'"), 
+    eval { ParseParameters(1, {'fred' => [Parse_signed, 0]}, fred => undef) ; };
+    like $@, mkErr("Parameter 'fred' must be a signed int, got 'undef'"), 
             "wanted signed, got undef";
 
-    eval { ParseParameters(1, {'Fred' => [1, 1, Parse_signed, 0]}, Fred => 'abc') ; };
-    like $@, mkErr("Parameter 'Fred' must be a signed int, got 'abc'"), 
+    eval { ParseParameters(1, {'fred' => [Parse_signed, 0]}, fred => 'abc') ; };
+    like $@, mkErr("Parameter 'fred' must be a signed int, got 'abc'"), 
             "wanted signed, got 'abc'";
 
-    eval { ParseParameters(1, {'Fred' => [1, 1, Parse_code, undef]}, Fred => 'abc') ; };
-    like $@, mkErr("Parameter 'Fred' must be a code reference, got 'abc'"), 
+    eval { ParseParameters(1, {'fred' => [Parse_code, undef]}, fred => 'abc') ; };
+    like $@, mkErr("Parameter 'fred' must be a code reference, got 'abc'"), 
             "wanted code, got 'abc'";
 
 
@@ -72,89 +72,120 @@ sub My::testParseParameters()
     {
         use Config;
 
-        skip 'readonly + threads', 1
+        skip 'readonly + threads', 2
             if $Config{useithreads};
 
-        eval { ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, 0]}, Fred => 'abc') ; };
-        like $@, mkErr("Parameter 'Fred' not writable"), 
+        eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => 'abc') ; };
+        like $@, mkErr("Parameter 'fred' not writable"), 
+                "wanted writable, got readonly";
+
+        eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => \'abc') ; };
+        like $@, mkErr("Parameter 'fred' not writable"), 
                 "wanted writable, got readonly";
     }
 
     my @xx;
-    eval { ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, 0]}, Fred => \@xx) ; };
-    like $@, mkErr("Parameter 'Fred' not a scalar reference"), 
+    eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => \@xx) ; };
+    like $@, mkErr("Parameter 'fred' not a scalar reference"), 
             "wanted scalar reference";
 
     local *ABC;
-    eval { ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, 0]}, Fred => *ABC) ; };
-    like $@, mkErr("Parameter 'Fred' not a scalar"), 
+    eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => *ABC) ; };
+    like $@, mkErr("Parameter 'fred' not a scalar"), 
             "wanted scalar";
 
-    eval { ParseParameters(1, {'Fred' => [1, 1, Parse_any, 0]}, Fred => 1, Fred => 2) ; };
-    like $@, mkErr("Muliple instances of 'Fred' found"),
+    eval { ParseParameters(1, {'fred' => [Parse_any, 0]}, fred => 1, fred => 2) ; };
+    like $@, mkErr("Muliple instances of 'fred' found"),
         "multiple instances";
 
-    my $g = ParseParameters(1, {'Fred' => [1, 1, Parse_unsigned|Parse_multiple, 7]}, Fred => 1, Fred => 2) ;
-    is_deeply $g->value('Fred'), [ 1, 2 ] ;
+#    my $g = ParseParameters(1, {'fred' => [Parse_unsigned|Parse_multiple, 7]}, fred => 1, fred => 2) ;
+#    is_deeply $g->value('fred'), [ 1, 2 ] ;
+    ok 1;
 
     #ok 1;
 
-    my $got = ParseParameters(1, {'Fred' => [1, 1, 0x1000000, 0]}, Fred => 'abc') ;
-    is $got->value('Fred'), "abc", "other" ;
+    my $got = ParseParameters(1, {'fred' => [0x1000000, 0]}, fred => 'abc') ;
+    is $got->getValue('fred'), "abc", "other" ;
 
-    $got = ParseParameters(1, {'Fred' => [0, 1, Parse_any, undef]}, Fred => undef) ;
-    ok $got->parsed('Fred'), "undef" ;
-    ok ! defined $got->value('Fred'), "undef" ;
+    $got = ParseParameters(1, {'fred' => [Parse_any, undef]}, fred => undef) ;
+    ok $got->parsed('fred'), "undef" ;
+    ok ! defined $got->getValue('fred'), "undef" ;
 
-    $got = ParseParameters(1, {'Fred' => [0, 1, Parse_string, undef]}, Fred => undef) ;
-    ok $got->parsed('Fred'), "undef" ;
-    is $got->value('Fred'), "", "empty string" ;
+    $got = ParseParameters(1, {'fred' => [Parse_string, undef]}, fred => undef) ;
+    ok $got->parsed('fred'), "undef" ;
+    is $got->getValue('fred'), "", "empty string" ;
 
     my $xx;
-    $got = ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, undef]}, Fred => $xx) ;
+    $got = ParseParameters(1, {'fred' => [Parse_writable_scalar, undef]}, fred => $xx) ;
 
-    ok $got->parsed('Fred'), "parsed" ;
-    my $xx_ref = $got->value('Fred');
+    ok $got->parsed('fred'), "parsed" ;
+    my $xx_ref = $got->getValue('fred');
     $$xx_ref = 77 ;
     is $xx, 77;
 
-    $got = ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, undef]}, Fred => \$xx) ;
+    $got = ParseParameters(1, {'fred' => [Parse_writable_scalar, undef]}, fred => \$xx) ;
 
-    ok $got->parsed('Fred'), "parsed" ;
-    $xx_ref = $got->value('Fred');
+    ok $got->parsed('fred'), "parsed" ;
+    $xx_ref = $got->getValue('fred');
 
     $$xx_ref = 666 ;
     is $xx, 666;
 
     {
-        my $got1 = ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, undef]}, $got) ;
+        my $got1 = ParseParameters(1, {'fred' => [Parse_writable_scalar, undef]}, $got) ;
         is $got1, $got, "Same object";
     
-        ok $got1->parsed('Fred'), "parsed" ;
-        $xx_ref = $got1->value('Fred');
+        ok $got1->parsed('fred'), "parsed" ;
+        $xx_ref = $got1->getValue('fred');
         
         $$xx_ref = 777 ;
         is $xx, 777;
     }
+
+    for my $type (Parse_unsigned, Parse_signed, Parse_any)    
+    {
+        my $value = 0;
+        my $got1 ;
+        eval { $got1 = ParseParameters(1, {'fred' => [$type, 1]}, fred => $value) } ;
+    
+        ok ! $@;
+        ok $got1->parsed('fred'), "parsed ok" ;
+        is $got1->getValue('fred'), 0;
+    }    
+
+    {
+        # setValue/getValue
+        my $value = 0;
+        my $got1 ;
+        eval { $got1 = ParseParameters(1, {'fred' => [Parse_any, 1]}, fred => $value) } ;
     
-##    my $got2 = ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, undef]}, '__xxx__' => $got) ;
-##    isnt $got2, $got, "not the Same object";
-##
-##    ok $got2->parsed('Fred'), "parsed" ;
-##    $xx_ref = $got2->value('Fred');
-##    $$xx_ref = 888 ;
-##    is $xx, 888;  
-##      
-##    my $other;
-##    my $got3 = ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, undef]}, '__xxx__' => $got, Fred => \$other) ;
-##    isnt $got3, $got, "not the Same object";
-##
-##        exit;
-##    ok $got3->parsed('Fred'), "parsed" ;
-##    $xx_ref = $got3->value('Fred');
-##    $$xx_ref = 999 ;
-##    is $other, 999;  
-##    is $xx, 888;  
+        ok ! $@;
+        ok $got1->parsed('fred'), "parsed ok" ;
+        is $got1->getValue('fred'), 0;
+        $got1->setValue('fred' => undef);
+        is $got1->getValue('fred'), undef;        
+    }  
+    
+    {
+        # twice
+        my $value = 0;
+        
+        my $got = IO::Compress::Base::Parameters::new();
+
+       
+        ok $got->parse({'fred' => [Parse_any, 1]}, fred => $value) ;
+
+        ok $got->parsed('fred'), "parsed ok" ;
+        is $got->getValue('fred'), 0;
+        
+        ok $got->parse({'fred' => [Parse_any, 1]}, fred => undef) ;  
+        ok $got->parsed('fred'), "parsed ok" ;
+        is $got->getValue('fred'), undef;   
+        
+        ok $got->parse({'fred' => [Parse_any, 1]}, fred => 7) ;  
+        ok $got->parsed('fred'), "parsed ok" ;
+        is $got->getValue('fred'), 7;   
+    }      
 }
 
 
diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/t/compress/encode.pl b/gnu/usr.bin/perl/cpan/IO-Compress/t/compress/encode.pl
index 142bd08e596..875f0ceab71 100644
--- a/gnu/usr.bin/perl/cpan/IO-Compress/t/compress/encode.pl
+++ b/gnu/usr.bin/perl/cpan/IO-Compress/t/compress/encode.pl
@@ -1,7 +1,7 @@
 
 use strict;
 use warnings;
-use bytes;
+#use bytes;
 
 use Test::More ;
 use CompTestUtils;
@@ -23,7 +23,7 @@ BEGIN
     $extra = 1
         if $st ;
 
-    plan(tests => 7 + $extra) ;
+    plan(tests => 29 + $extra) ;
 }
 
 sub run
@@ -34,7 +34,7 @@ sub run
     my $UnError         = getErrorRef($UncompressClass);
 
 
-    my $string = "\x{df}\x{100}"; 
+    my $string = "\x{df}\x{100}\x80"; 
     my $encString = Encode::encode_utf8($string);
     my $buffer = $encString;
 
@@ -92,10 +92,13 @@ sub run
             my $ucs = new $UncompressClass($input, Append => 1);
             my $got;
             1 while $ucs->read($got) > 0 ;
+            
+            is  $got, $encString, "  Expected output";
+            
             my $decode = Encode::decode_utf8($got);
 
 
-            is $string, $decode, "  Expected output";
+            is $decode, $string, "  Expected output";
 
 
         }
@@ -110,9 +113,81 @@ sub run
         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");
+
+    }
+    
+    {
+        title "Unknown encoding";
+        my $output;
+        eval { my $cs = new $CompressClass(\$output, Encode => 'fred'); } ;
+        like($@, qr/${CompressClass}: Encoding 'fred' is not available/, 
+                 "  Encoding 'fred' is not available");
+    }
+    
+    {
+        title "Encode option";
+        
+        for my $to ( qw(filehandle filename buffer))
+        {
+            title "Encode: To $to, Encode option";
+
+            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, Encode => 'utf8');
+            ok $cs->print($string);
+            ok $cs->close();
+
+            my $input;
+            if ($to eq 'buffer')
+            { 
+                $input = \$buffer 
+            }
+            elsif ($to eq 'filename')
+            {
+                $input = $name2 ;
+            }
+            else
+            {
+                $input = new IO::File "<$name2" ;
+            }
+            
+            {
+                my $ucs = new $UncompressClass($input, AutoClose =>1, Append => 1);
+                my $got;
+                1 while $ucs->read($got) > 0 ;
+                ok length($got) > 0;
+                is  $got, $encString, "  Expected output";
+                
+                my $decode = Encode::decode_utf8($got);
+    
+                is  $decode, $string, "  Expected output";
+            }
+            
+     
+#            {
+#                my $ucs = new $UncompressClass($input, Append => 1, Decode => 'utf8');
+#                my $got;
+#                1 while $ucs->read($got) > 0 ;
+#                ok length($got) > 0;    
+#                is  $got, $string, "  Expected output";
+#            }            
+        }        
     }
 
 }
diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/t/cz-14gzopen.t b/gnu/usr.bin/perl/cpan/IO-Compress/t/cz-14gzopen.t
index 0918ce5482c..01d2d65a2bc 100755
--- a/gnu/usr.bin/perl/cpan/IO-Compress/t/cz-14gzopen.t
+++ b/gnu/usr.bin/perl/cpan/IO-Compress/t/cz-14gzopen.t
@@ -20,7 +20,7 @@ BEGIN {
     $extra = 1
         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
 
-    plan tests => 260 + $extra ;
+    plan tests => 264 + $extra ;
 
     use_ok('Compress::Zlib', 2) ;
     use_ok('IO::Compress::Gzip::Constants') ;
@@ -489,6 +489,9 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT])
 
     SKIP:
     {
+        skip "Cannot create non-writable file", 3 
+            if $^O eq 'cygwin';
+
         my $lex = new LexFile my $name ;
         writeFile($name, "abc");
         chmod 0444, $name 
@@ -651,7 +654,20 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT])
 }
 
 {
-    title 'gzflush called twice';
+    title 'gzflush called twice with Z_SYNC_FLUSH - no compression';
+
+    my $lex = new LexFile my $name ;
+
+    ok my $a = gzopen($name, "w");
+    
+    is $a->gzflush(Z_SYNC_FLUSH), Z_OK, "gzflush returns Z_OK";
+    is $a->gzflush(Z_SYNC_FLUSH), Z_OK, "gzflush returns Z_OK";    
+}
+
+
+
+{
+    title 'gzflush called twice - after compression';
 
     my $lex = new LexFile my $name ;