BEGIN {    if ($ENV{PERL_CORE}) {	chdir 't' if -d 't';	@INC = ("../lib", "lib/compress");    }}use lib qw(t t/compress);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 => 910 + $extra ;    use_ok('Compress::Raw::Zlib') ;    use_ok('IO::Compress::Gzip::Constants') ;    use_ok('IO::Compress::Gzip', qw($GzipError)) ;    use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ;}# Check the Gzip Header Parameters#========================================my $ThisOS_code = $Compress::Raw::Zlib::gzip_os_code;my $lex = new LexFile my $name ;{    title "Check Defaults";    # Check Name defaults undef, no name, no comment    # and Time can be explicitly set.    my $hdr = readHeaderInfo($name, -Time => 1234);    is $hdr->{Time}, 1234;    ok ! defined $hdr->{Name};    is $hdr->{MethodName}, 'Deflated';    is $hdr->{ExtraFlags}, 0;    is $hdr->{MethodID}, Z_DEFLATED;    is $hdr->{OsID}, $ThisOS_code ;    ok ! defined $hdr->{Comment} ;    ok ! defined $hdr->{ExtraFieldRaw} ;    ok ! defined $hdr->{HeaderCRC} ;    ok ! $hdr->{isMinimalHeader} ;}{    title "Check name can be different from filename" ;    # Check Name can be different from filename    # Comment and Extra can be set    # Can specify a zero Time     my $comment = "This is a Comment" ;    my $extra = "A little something extra" ;    my $aname = "a new name" ;    my $hdr = readHeaderInfo $name, 				      -Strict     => 0,				      -Name       => $aname,    				  -Comment    => $comment,    				  -ExtraField => $extra,    				  -Time       => 0 ;    ok $hdr->{Time} == 0;    ok $hdr->{Name} eq $aname;    ok $hdr->{MethodName} eq 'Deflated';    ok $hdr->{MethodID} == 8;    is $hdr->{ExtraFlags}, 0;    ok $hdr->{Comment} eq $comment ;    is $hdr->{OsID}, $ThisOS_code ;    ok ! $hdr->{isMinimalHeader} ;    ok ! defined $hdr->{HeaderCRC} ;}{    title "Check Time defaults to now" ;    # Check Time defaults to now    # and that can have empty name, comment and extrafield    my $before = time ;    my $hdr = readHeaderInfo $name, 		          -TextFlag   => 1,		          -Name       => "",    		      -Comment    => "",    		      -ExtraField => "";    my $after = time ;    ok $hdr->{Time} >= $before ;    ok $hdr->{Time} <= $after ;    ok defined $hdr->{Name} ;    ok $hdr->{Name} eq "";    ok defined $hdr->{Comment} ;    ok $hdr->{Comment} eq "";    ok defined $hdr->{ExtraFieldRaw} ;    ok $hdr->{ExtraFieldRaw} eq "";    is $hdr->{ExtraFlags}, 0;    ok ! $hdr->{isMinimalHeader} ;    ok   $hdr->{TextFlag} ;    ok ! defined $hdr->{HeaderCRC} ;    is $hdr->{OsID}, $ThisOS_code ;}{    title "can have null extrafield" ;    my $before = time ;    my $hdr = readHeaderInfo $name, 				      -strict     => 0,		              -Name       => "a",    			      -Comment    => "b",    			      -ExtraField => "\x00";    my $after = time ;    ok $hdr->{Time} >= $before ;    ok $hdr->{Time} <= $after ;    ok $hdr->{Name} eq "a";    ok $hdr->{Comment} eq "b";    is $hdr->{ExtraFlags}, 0;    ok $hdr->{ExtraFieldRaw} eq "\x00";    ok ! $hdr->{isMinimalHeader} ;    ok ! $hdr->{TextFlag} ;    ok ! defined $hdr->{HeaderCRC} ;    is $hdr->{OsID}, $ThisOS_code ;}{    title "can have undef name, comment, time and extrafield" ;    my $hdr = readHeaderInfo $name, 	                  -Name       => undef,    		          -Comment    => undef,    		          -ExtraField => undef,                      -Time       => undef;    ok $hdr->{Time} == 0;    ok ! defined $hdr->{Name} ;    ok ! defined $hdr->{Comment} ;    ok ! defined $hdr->{ExtraFieldRaw} ;    ok ! $hdr->{isMinimalHeader} ;    ok ! $hdr->{TextFlag} ;    ok ! defined $hdr->{HeaderCRC} ;    is $hdr->{OsID}, $ThisOS_code ;}for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D"){    title "Comment with $value" ;    my $v = pack "h*", $value;    my $comment = "my${v}comment$v";    my $hdr = readHeaderInfo $name,                     Time => 0,                  -TextFlag   => 1,                   -Name       => "",                  -Comment    => $comment,                  -ExtraField => "";    my $after = time ;    is $hdr->{Time}, 0 ;    ok defined $hdr->{Name} ;    ok $hdr->{Name} eq "";    ok defined $hdr->{Comment} ;    is $hdr->{Comment}, $comment;    ok defined $hdr->{ExtraFieldRaw} ;    ok $hdr->{ExtraFieldRaw} eq "";    is $hdr->{ExtraFlags}, 0;    ok ! $hdr->{isMinimalHeader} ;    ok   $hdr->{TextFlag} ;    ok ! defined $hdr->{HeaderCRC} ;    is $hdr->{OsID}, $ThisOS_code ;}{    title "Check crchdr" ;    my $hdr = readHeaderInfo $name, -HeaderCRC  => 1;    ok ! defined $hdr->{Name};    is $hdr->{ExtraFlags}, 0;    ok ! defined $hdr->{ExtraFieldRaw} ;    ok ! defined $hdr->{Comment} ;    ok ! $hdr->{isMinimalHeader} ;    ok ! $hdr->{TextFlag} ;    ok   defined $hdr->{HeaderCRC} ;    is $hdr->{OsID}, $ThisOS_code ;}{    title "Check ExtraFlags" ;    my $hdr = readHeaderInfo $name, -Level  => Z_BEST_SPEED;    ok ! defined $hdr->{Name};    is $hdr->{ExtraFlags}, 2;    ok ! defined $hdr->{ExtraFieldRaw} ;    ok ! defined $hdr->{Comment} ;    ok ! $hdr->{isMinimalHeader} ;    ok ! $hdr->{TextFlag} ;    ok ! defined $hdr->{HeaderCRC} ;    $hdr = readHeaderInfo $name, -Level  => Z_BEST_COMPRESSION;    ok ! defined $hdr->{Name};    is $hdr->{ExtraFlags}, 4;    ok ! defined $hdr->{ExtraFieldRaw} ;    ok ! defined $hdr->{Comment} ;    ok ! $hdr->{isMinimalHeader} ;    ok ! $hdr->{TextFlag} ;    ok ! defined $hdr->{HeaderCRC} ;    $hdr = readHeaderInfo $name, -Level  => Z_BEST_COMPRESSION,                                 -ExtraFlags => 42;    ok ! defined $hdr->{Name};    is $hdr->{ExtraFlags}, 42;    ok ! defined $hdr->{ExtraFieldRaw} ;    ok ! defined $hdr->{Comment} ;    ok ! $hdr->{isMinimalHeader} ;    ok ! $hdr->{TextFlag} ;    ok ! defined $hdr->{HeaderCRC} ;}{    title "OS Code" ;    for my $code ( -1, undef, '', 'fred' )    {        my $code_name = defined $code ? "'$code'" : "'undef'";        eval { new IO::Compress::Gzip $name, -OS_Code => $code } ;        like $@, mkErr("^IO::Compress::Gzip: Parameter 'OS_Code' must be an unsigned int, got $code_name"),            " Trap OS Code $code_name";    }    for my $code ( qw( 256 ) )    {        eval { ok ! new IO::Compress::Gzip($name, OS_Code => $code) };        like $@, mkErr("OS_Code must be between 0 and 255, got '$code'"),            " Trap OS Code $code";        like $GzipError, "/OS_Code must be between 0 and 255, got '$code'/",            " Trap OS Code $code";    }    for my $code ( qw(0 1 12 254 255) )    {        my $hdr = readHeaderInfo $name, OS_Code => $code;        is $hdr->{OsID}, $code, "  Code is $code" ;    }}{    title 'Check ExtraField';    my @tests = (        [1, ['AB' => '']                   => [['AB'=>'']] ],        [1, {'AB' => ''}                   => [['AB'=>'']] ],        [1, ['AB' => 'Fred']               => [['AB'=>'Fred']] ],        [1, {'AB' => 'Fred'}               => [['AB'=>'Fred']] ],        [1, ['Xx' => '','AB' => 'Fred']    => [['Xx' => ''],['AB'=>'Fred']] ],        [1, ['Xx' => '','Xx' => 'Fred']    => [['Xx' => ''],['Xx'=>'Fred']] ],        [1, ['Xx' => '',             'Xx' => 'Fred',              'Xx' => 'Fred']               => [['Xx' => ''],['Xx'=>'Fred'],                                               ['Xx'=>'Fred']] ],        [1, [ ['Xx' => 'a'],              ['AB' => 'Fred'] ]           => [['Xx' => 'a'],['AB'=>'Fred']] ],        [0, {'AB' => 'Fred',              'Pq' => 'r',              "\x01\x02" => "\x03"}         => [['AB'=>'Fred'],                                               ['Pq'=>'r'],                                                ["\x01\x02"=>"\x03"]] ],        [1, ['AB' => 'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE] =>                             [['AB'=>'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE]] ],                );    foreach my $test (@tests) {        my ($order, $input, $result) = @$test ;        ok my $x = new IO::Compress::Gzip $name,                                -ExtraField  => $input,                                -HeaderCRC   => 1            or diag "GzipError is $GzipError" ;                            ;        my $string = "abcd" ;        ok $x->write($string) ;        ok $x->close ;        #is GZreadFile($name), $string ;        ok $x = new IO::Uncompress::Gunzip $name,                              #-Strict     => 1,                               -ParseExtra => 1            or diag "GunzipError is $GunzipError" ;                            ;        my $hdr = $x->getHeaderInfo();        ok $hdr;        ok ! defined $hdr->{Name};        ok ! defined $hdr->{Comment} ;        ok ! $hdr->{isMinimalHeader} ;        ok ! $hdr->{TextFlag} ;        ok   defined $hdr->{HeaderCRC} ;        ok   defined $hdr->{ExtraFieldRaw} ;        ok   defined $hdr->{ExtraField} ;        my $extra = $hdr->{ExtraField} ;        if ($order) {            eq_array $extra, $result;        } else {            eq_set $extra, $result;        }     }}{    title 'Write Invalid ExtraField';    my $prefix = 'Error with ExtraField Parameter: ';    my @tests = (            [ sub{ "abc" }        => "Not a scalar, array ref or hash ref"],            [ [ "a" ]             => "Not even number of elements"],            [ [ "a" => "fred" ]   => 'SubField ID not two chars long'],            [ [ "a\x00" => "fred" ]   => 'SubField ID 2nd byte is 0x00'],            [ [ [ {}, "abc" ]]    => "SubField ID is a reference"],            [ [ [ "ab", \1 ]]     => "SubField Data is a reference"],            [ [ {"a" => "fred"} ] => "Not list of lists"],            [ [ ['ab'=>'x'],{"a" => "fred"} ] => "Not list of lists"],            [ [ ["aa"] ]          => "SubField must have two parts"],            [ [ ["aa", "b", "c"] ] => "SubField must have two parts"],            [ [ ["ab" => 'x' x (GZIP_FEXTRA_SUBFIELD_MAX_SIZE + 1) ] ]                                    => "SubField Data too long"],            [ { 'abc', 1 }        => "SubField ID not two chars long"],            [ { \1 , "abc" }    => "SubField ID not two chars long"],            [ { "ab", \1 }     => "SubField Data is a reference"],        );        foreach my $test (@tests) {        my ($input, $string) = @$test ;        my $buffer ;        my $x ;        eval { $x = new IO::Compress::Gzip \$buffer, -ExtraField  => $input; };        like $@, mkErr("$prefix$string");          like $GzipError, "/$prefix$string/";          ok ! $x ;    }}{    # Corrupt ExtraField    my @tests = (        ["Sub-field truncated",                       "Error with ExtraField Parameter: Truncated in FEXTRA Body Section",            "Header Error: Truncated in FEXTRA Body Section",            ['a', undef, undef]              ],        ["Length of field incorrect",                 "Error with ExtraField Parameter: Truncated in FEXTRA Body Section",            "Header Error: Truncated in FEXTRA Body Section",            ["ab", 255, "abc"]               ],        ["Length of 2nd field incorrect",             "Error with ExtraField Parameter: Truncated in FEXTRA Body Section",            "Header Error: Truncated in FEXTRA Body Section",            ["ab", 3, "abc"], ["de", 7, "x"] ],        ["Length of 2nd field incorrect",             "Error with ExtraField Parameter: SubField ID 2nd byte is 0x00",            "Header Error: SubField ID 2nd byte is 0x00",            ["a\x00", 3, "abc"], ["de", 7, "x"] ],        );    foreach my $test (@tests)    {        my $name = shift @$test;        my $gzip_error = shift @$test;        my $gunzip_error = shift @$test;        title "Read Corrupt ExtraField - $name" ;        my $input = '';        for my $field (@$test)        {            my ($id, $len, $data) = @$field;            $input .= $id if defined $id ;            $input .= pack("v", $len) if defined $len ;            $input .= $data if defined $data;        }        #hexDump(\$input);        my $buffer ;        my $x ;        eval {$x = new IO::Compress::Gzip \$buffer, -ExtraField  => $input, Strict => 1; };        like $@, mkErr("$gzip_error"), "  $name";          like $GzipError, "/$gzip_error/", "  $name";          ok ! $x, "  IO::Compress::Gzip fails";        like $GzipError, "/$gzip_error/", "  $name";          foreach my $check (0, 1)            {            ok $x = new IO::Compress::Gzip \$buffer,                                            ExtraField => $input,                                            Strict     => 0                or diag "GzipError is $GzipError" ;            my $string = "abcd" ;            $x->write($string) ;            $x->close ;            is anyUncompress(\$buffer), $string ;            $x = new IO::Uncompress::Gunzip \$buffer,                                        Strict      => 0,                                       Transparent => 0,                                       ParseExtra  => $check;            if ($check) {                ok ! $x ;                like $GunzipError, "/^$gunzip_error/";              }            else {                ok $x ;            }        }    }}{    title 'Check Minimal';    ok my $x = new IO::Compress::Gzip $name, -Minimal => 1;    my $string = "abcd" ;    ok $x->write($string) ;    ok $x->close ;    #is GZreadFile($name), $string ;    ok $x = new IO::Uncompress::Gunzip $name  ;    my $hdr = $x->getHeaderInfo();    ok $hdr;    ok $hdr->{Time} == 0;    is $hdr->{ExtraFlags}, 0;    ok ! defined $hdr->{Name} ;    ok ! defined $hdr->{ExtraFieldRaw} ;    ok ! defined $hdr->{Comment} ;    is $hdr->{OsName}, 'Unknown' ;    is $hdr->{MethodName}, "Deflated";    is $hdr->{Flags}, 0;    ok $hdr->{isMinimalHeader} ;    ok ! $hdr->{TextFlag} ;    ok $x->close ;}{    # Check Minimal + no comressed data