BEGIN {
if
(
$ENV
{PERL_CORE}) {
chdir
't'
if
-d
't'
;
@INC
= (
"../lib"
,
"lib/compress"
);
}
}
use
lib
qw(t t/compress)
;
BEGIN {
my
$extra
= 0 ;
$extra
= 1
plan
tests
=> 264 +
$extra
;
use_ok(
'Compress::Zlib'
, 2) ;
use_ok(
'IO::Compress::Gzip::Constants'
) ;
}
{
SKIP: {
skip
"TEST_SKIP_VERSION_CHECK is set"
, 1
if
$ENV
{TEST_SKIP_VERSION_CHECK};
is Compress::Zlib::zlib_version, ZLIB_VERSION,
"ZLIB_VERSION matches Compress::Zlib::zlib_version"
;
}
}
{
my
$lex
= LexFile->new(
my
$name
);
my
$hello
=
<<EOM ;
hello world
this is a test
EOM
my
$len
=
length
$hello
;
my
(
$x
,
$uncomp
) ;
ok
my
$fil
= gzopen(
$name
,
"wb"
) ;
is
$gzerrno
, 0,
'gzerrno is 0'
;
is
$fil
->gzerror(), 0,
"gzerror() returned 0"
;
is
$fil
->gztell(), 0,
"gztell returned 0"
;
is
$gzerrno
, 0,
'gzerrno is 0'
;
is
$fil
->gzwrite(
$hello
),
$len
;
is
$gzerrno
, 0,
'gzerrno is 0'
;
is
$fil
->gztell(),
$len
,
"gztell returned $len"
;
is
$gzerrno
, 0,
'gzerrno is 0'
;
ok !
$fil
->gzclose ;
ok
$fil
= gzopen(
$name
,
"rb"
) ;
ok !
$fil
->gzeof() ;
is
$gzerrno
, 0,
'gzerrno is 0'
;
is
$fil
->gztell(), 0;
is
$fil
->gzread(
$uncomp
),
$len
;
is
$fil
->gztell(),
$len
;
ok
$fil
->gzeof() ;
my
$xyz
=
"123"
;
is
$fil
->gzread(
$xyz
), 0,
"gzread returns 0 on eof"
;
is
$xyz
,
""
,
"gzread on eof zaps the output buffer [Match 1,x behavior]"
;
ok !
$fil
->gzclose ;
ok
$fil
->gzeof() ;
ok
$hello
eq
$uncomp
;
}
{
title
'check that a number can be gzipped'
;
my
$lex
= LexFile->new(
my
$name
);
my
$number
= 7603 ;
my
$num_len
= 4 ;
ok
my
$fil
= gzopen(
$name
,
"wb"
) ;
is
$gzerrno
, 0;
is
$fil
->gzwrite(
$number
),
$num_len
,
"gzwrite returned $num_len"
;
is
$gzerrno
, 0,
'gzerrno is 0'
;
ok !
$fil
->gzflush(Z_FINISH) ;
is
$gzerrno
, 0,
'gzerrno is 0'
;
ok !
$fil
->gzclose ;
cmp_ok
$gzerrno
,
'=='
, 0;
ok
$fil
= gzopen(
$name
,
"rb"
) ;
my
$uncomp
;
ok ((
my
$x
=
$fil
->gzread(
$uncomp
)) ==
$num_len
) ;
ok
$fil
->gzerror() == 0 ||
$fil
->gzerror() == Z_STREAM_END;
ok
$gzerrno
== 0 ||
$gzerrno
== Z_STREAM_END;
ok
$fil
->gzeof() ;
ok !
$fil
->gzclose ;
ok
$fil
->gzeof() ;
ok
$gzerrno
== 0
or
print
"# gzerrno is $gzerrno\n"
;
1
while
unlink
$name
;
ok
$number
==
$uncomp
;
ok
$number
eq
$uncomp
;
}
{
title
"now a bigger gzip test"
;
my
$text
=
'text'
;
my
$lex
= LexFile->new(
my
$file
);
ok
my
$f
= gzopen(
$file
,
"wb"
) ;
my
$contents
=
''
;
foreach
(1 .. 5000)
{
$contents
.=
chr
int
rand
256 }
my
$len
=
length
$contents
;
is
$f
->gzwrite(
$contents
),
$len
;
ok !
$f
->gzclose ;
ok
$f
= gzopen(
$file
,
"rb"
) ;
ok !
$f
->gzeof() ;
my
$uncompressed
;
is
$f
->gzread(
$uncompressed
,
$len
),
$len
;
is
$contents
,
$uncompressed
or
print
"# Length orig $len"
.
", Length uncompressed "
.
length
(
$uncompressed
) .
"\n"
;
ok
$f
->gzeof() ;
ok !
$f
->gzclose ;
}
{
title
"gzip - readline tests"
;
my
$lex
= LexFile->new(
my
$name
);
my
@text
= (
<<EOM, <<EOM, <<EOM, <<EOM) ;
this is line 1
EOM
the second line
EOM
the line
after
the previous line
EOM
the final line
EOM
my
$text
=
join
(
""
,
@text
) ;
ok
my
$fil
= gzopen(
$name
,
"wb"
) ;
is
$fil
->gzwrite(
$text
),
length
(
$text
) ;
ok !
$fil
->gzclose ;
ok
$fil
= gzopen(
$name
,
"rb"
) ;
ok !
$fil
->gzeof() ;
my
$line
=
''
;
for
my
$i
(0 ..
@text
-2)
{
ok
$fil
->gzreadline(
$line
) > 0;
is
$line
,
$text
[
$i
] ;
ok !
$fil
->gzeof() ;
}
ok
$fil
->gzreadline(
$line
) > 0;
is
$line
,
$text
[-1] ;
ok
$fil
->gzeof() ;
is
$fil
->gzreadline(
$line
), 0;
ok
$fil
->gzeof() ;
ok !
$fil
->gzclose ;
ok
$fil
->gzeof() ;
}
{
title
"A text file with a very long line (bigger than the internal buffer)"
;
my
$lex
= LexFile->new(
my
$name
);
my
$line1
= (
"abcdefghijklmnopq"
x 2000) .
"\n"
;
my
$line2
=
"second line\n"
;
my
$text
=
$line1
.
$line2
;
ok
my
$fil
= gzopen(
$name
,
"wb"
),
" gzopen ok"
;
is
$fil
->gzwrite(
$text
),
length
$text
,
" gzwrite ok"
;
ok !
$fil
->gzclose,
" gzclose"
;
ok
$fil
= gzopen(
$name
,
"rb"
),
" gzopen"
;
ok !
$fil
->gzeof(),
"! eof"
;
my
$i
= 0 ;
my
@got
= ();
my
$line
;
while
(
$fil
->gzreadline(
$line
) > 0) {
$got
[
$i
] =
$line
;
++
$i
;
}
is
$i
, 2,
" looped twice"
;
is
$got
[0],
$line1
,
" got line 1"
;
is
$got
[1],
$line2
,
" hot line 2"
;
ok
$fil
->gzeof(),
" gzeof"
;
ok !
$fil
->gzclose,
" gzclose"
;
ok
$fil
->gzeof(),
" gzeof"
;
}
{
title
"a text file which is not terminated by an EOL"
;
my
$lex
= LexFile->new(
my
$name
);
my
$line1
=
"hello hello, I'm back again\n"
;
my
$line2
=
"there is no end in sight"
;
my
$text
=
$line1
.
$line2
;
ok
my
$fil
= gzopen(
$name
,
"wb"
),
" gzopen"
;
is
$fil
->gzwrite(
$text
),
length
$text
,
" gzwrite"
;
ok !
$fil
->gzclose,
" gzclose"
;
ok
$fil
= gzopen(
$name
,
"rb"
),
" gzopen"
;
my
@got
= () ;
my
$i
= 0 ;
my
$line
;
while
(
$fil
->gzreadline(
$line
) > 0) {
$got
[
$i
] =
$line
;
++
$i
;
}
is
$i
, 2,
" got 2 lines"
;
is
$got
[0],
$line1
,
" line 1 ok"
;
is
$got
[1],
$line2
,
" line 2 ok"
;
ok
$fil
->gzeof(),
" gzeof"
;
ok !
$fil
->gzclose,
" gzclose"
;
}
{
title
'mix gzread and gzreadline'
;
my
$lex
= LexFile->new(
my
$name
);
my
$line1
=
"hello hello, I'm back again\n"
;
my
$line2
=
"abc"
x 200 ;
my
$line3
=
"def"
x 200 ;
my
$line
;
my
$text
=
$line1
.
$line2
.
$line3
;
my
$fil
;
ok
$fil
= gzopen(
$name
,
"wb"
),
' gzopen for write ok'
;
is
$fil
->gzwrite(
$text
),
length
$text
,
' gzwrite ok'
;
is
$fil
->gztell(),
length
$text
,
' gztell ok'
;
ok !
$fil
->gzclose,
' gzclose ok'
;
ok
$fil
= gzopen(
$name
,
"rb"
),
' gzopen for read ok'
;
ok !
$fil
->gzeof(),
' !gzeof'
;
cmp_ok
$fil
->gzreadline(
$line
),
'>'
, 0,
' gzreadline'
;
is
$fil
->gztell(),
length
$line1
,
' gztell ok'
;
ok !
$fil
->gzeof(),
' !gzeof'
;
is
$line
,
$line1
,
' got expected line'
;
cmp_ok
$fil
->gzread(
$line
,
length
$line2
),
'>'
, 0,
' gzread ok'
;
is
$fil
->gztell(),
length
(
$line1
)+
length
(
$line2
),
' gztell ok'
;
ok !
$fil
->gzeof(),
' !gzeof'
;
is
$line
,
$line2
,
' read expected block'
;
cmp_ok
$fil
->gzread(
$line
,
length
$line3
),
'>'
, 0,
' gzread ok'
;
is
$fil
->gztell(),
length
(
$text
),
' gztell ok'
;
ok
$fil
->gzeof(),
' !gzeof'
;
is
$line
,
$line3
,
' read expected block'
;
ok !
$fil
->gzclose,
' gzclose'
;
}
{
title
"Pass gzopen a filehandle - use IO::File"
;
my
$lex
= LexFile->new(
my
$name
);
my
$hello
=
"hello"
;
my
$len
=
length
$hello
;
my
$f
= IO::File->new(
">$name"
);
ok
$f
;
my
$fil
;
ok
$fil
= gzopen(
$f
,
"wb"
) ;
ok
$fil
->gzwrite(
$hello
) ==
$len
;
ok !
$fil
->gzclose ;
$f
= IO::File->new(
"<$name"
);
ok
$fil
= gzopen(
$name
,
"rb"
) ;
my
$uncomp
;
my
$x
;
ok ((
$x
=
$fil
->gzread(
$uncomp
)) ==
$len
)
or
print
"# length $x, expected $len\n"
;
ok
$fil
->gzeof() ;
ok !
$fil
->gzclose ;
ok
$fil
->gzeof() ;
is
$uncomp
,
$hello
,
"got expected output"
;
}
{
title
"Pass gzopen a filehandle - use open"
;
my
$lex
= LexFile->new(
my
$name
);
my
$hello
=
"hello"
;
my
$len
=
length
$hello
;
open
F,
">$name"
;
my
$fil
;
ok
$fil
= gzopen(
*F
,
"wb"
) ;
is
$fil
->gzwrite(
$hello
),
$len
;
ok !
$fil
->gzclose ;
open
F,
"<$name"
;
ok
$fil
= gzopen(
*F
,
"rb"
) ;
my
$uncomp
;
my
$x
;
$x
=
$fil
->gzread(
$uncomp
);
is
$x
,
$len
;
ok
$fil
->gzeof() ;
ok !
$fil
->gzclose ;
ok
$fil
->gzeof() ;
is
$uncomp
,
$hello
;
}
foreach
my
$stdio
( [
'-'
,
'-'
], [
*STDIN
,
*STDOUT
])
{
my
$stdin
=
$stdio
->[0];
my
$stdout
=
$stdio
->[1];
title
"Pass gzopen a filehandle - use $stdin"
;
my
$lex
= LexFile->new(
my
$name
);
my
$hello
=
"hello"
;
my
$len
=
length
$hello
;
ok
open
(SAVEOUT,
">&STDOUT"
),
" save STDOUT"
;
my
$dummy
=
fileno
SAVEOUT;
ok
open
(STDOUT,
">$name"
),
" redirect STDOUT"
;
my
$status
= 0 ;
my
$fil
= gzopen(
$stdout
,
"wb"
) ;
$status
=
$fil
&&
(
$fil
->gzwrite(
$hello
) ==
$len
) &&
(
$fil
->gzclose == 0) ;
open
(STDOUT,
">&SAVEOUT"
);
ok
$status
,
" wrote to stdout"
;
open
(SAVEIN,
"<&STDIN"
);
ok
open
(STDIN,
"<$name"
),
" redirect STDIN"
;
$dummy
=
fileno
SAVEIN;
ok
$fil
= gzopen(
$stdin
,
"rb"
) ;
my
$uncomp
;
my
$x
;
ok ((
$x
=
$fil
->gzread(
$uncomp
)) ==
$len
)
or
print
"# length $x, expected $len\n"
;
ok
$fil
->gzeof() ;
ok !
$fil
->gzclose ;
ok
$fil
->gzeof() ;
open
(STDIN,
"<&SAVEIN"
);
is
$uncomp
,
$hello
;
}
{
title
'test parameters for gzopen'
;
my
$lex
= LexFile->new(
my
$name
);
my
$fil
;
eval
' $fil = gzopen() '
;
like $@, mkEvalErr(
'Not enough arguments .*? Compress::Zlib::gzopen'
),
' gzopen with missing mode fails'
;
$fil
= gzopen(
$name
,
"xy"
) ;
ok !
defined
$fil
,
' gzopen with unknown mode fails'
;
$fil
= gzopen(
$name
,
"ab"
) ;
ok
$fil
,
' gzopen with mode "ab" is ok'
;
$fil
= gzopen(
$name
,
"wb6"
) ;
ok
$fil
,
' gzopen with mode "wb6" is ok'
;
$fil
= gzopen(
$name
,
"wbf"
) ;
ok
$fil
,
' gzopen with mode "wbf" is ok'
;
$fil
= gzopen(
$name
,
"wbh"
) ;
ok
$fil
,
' gzopen with mode "wbh" is ok'
;
}
{
title
'Read operations when opened for writing'
;
my
$lex
= LexFile->new(
my
$name
);
my
$fil
;
ok
$fil
= gzopen(
$name
,
"wb"
),
' gzopen for writing'
;
ok !
$fil
->gzeof(),
' !eof'
; ;
is
$fil
->gzread(), Z_STREAM_ERROR,
" gzread returns Z_STREAM_ERROR"
;
ok !
$fil
->gzclose,
" gzclose ok"
;
}
{
title
'write operations when opened for reading'
;
my
$lex
= LexFile->new(
my
$name
);
my
$text
=
"hello"
;
my
$fil
;
ok
$fil
= gzopen(
$name
,
"wb"
),
" gzopen for writing"
;
is
$fil
->gzwrite(
$text
),
length
$text
,
" gzwrite ok"
;
ok !
$fil
->gzclose,
" gzclose ok"
;
ok
$fil
= gzopen(
$name
,
"rb"
),
" gzopen for reading"
;
is
$fil
->gzwrite(), Z_STREAM_ERROR,
" gzwrite returns Z_STREAM_ERROR"
;
}
{
title
'read/write a non-readable/writable file'
;
SKIP:
{
skip
"Cannot create non-writable file"
, 3
if
$^O eq
'cygwin'
;
my
$lex
= LexFile->new(
my
$name
);
writeFile(
$name
,
"abc"
);
chmod
0444,
$name
or skip
"Cannot create non-writable file"
, 3 ;
skip
"Cannot create non-writable file"
, 3
if
-w
$name
;
my
$written
=
do
{
no
warnings;
my
$fh
;
open
$fh
,
'>'
,
$name
&&
print
$fh
"hello world"
};
skip
"Cannot create non-writable file"
, 3
if
$written
;
ok ! -w
$name
,
" input file not writable"
;
my
$fil
= gzopen(
$name
,
"wb"
) ;
ok !
$fil
,
" gzopen returns undef"
;
ok
$gzerrno
,
" gzerrno ok"
or
diag
" gzerrno $gzerrno\n"
;
chmod
0777,
$name
;
}
SKIP:
{
my
$lex
= LexFile->new(
my
$name
);
skip
"Cannot create non-readable file"
, 3
if
$^O eq
'cygwin'
;
writeFile(
$name
,
"abc"
);
chmod
0222,
$name
;
skip
"Cannot create non-readable file"
, 3
if
-r
$name
;
my
$readable
=
do
{
no
warnings;
my
$fh
;
open
$fh
,
'<'
,
$name
&&
read
$fh
,
my
$data
, 1
};
skip
"Cannot create non-writable file"
, 3
if
$readable
;
ok ! -r
$name
,
" input file not readable"
;
$gzerrno
= 0;
my
$fil
= gzopen(
$name
,
"rb"
) ;
ok !
$fil
,
" gzopen returns undef"
;
ok
$gzerrno
,
" gzerrno ok"
;
chmod
0777,
$name
;
}
}
{
title
"gzseek"
;
my
$buff
;
my
$lex
= LexFile->new(
my
$name
);
my
$first
=
"beginning"
;
my
$last
=
"the end"
;
my
$iow
= gzopen(
$name
,
"w"
);
$iow
->gzwrite(
$first
) ;
ok
$iow
->gzseek(5, SEEK_CUR) ;
is
$iow
->gztell(),
length
(
$first
)+5;
ok
$iow
->gzseek(0, SEEK_CUR) ;
is
$iow
->gztell(),
length
(
$first
)+5;
ok
$iow
->gzseek(
length
(
$first
)+10, SEEK_SET) ;
is
$iow
->gztell(),
length
(
$first
)+10;
$iow
->gzwrite(
$last
) ;
$iow
->gzclose ;
ok GZreadFile(
$name
) eq
$first
.
"\x00"
x 10 .
$last
;
my
$io
= gzopen(
$name
,
"r"
);
ok
$io
->gzseek(
length
(
$first
), SEEK_CUR) ;
ok !
$io
->gzeof;
is
$io
->gztell(),
length
(
$first
);
ok
$io
->gzread(
$buff
, 5) ;
is
$buff
,
"\x00"
x 5 ;
is
$io
->gztell(),
length
(
$first
) + 5;
is
$io
->gzread(
$buff
, 0), 0 ;
is
$io
->gztell(),
length
(
$first
) + 5;
ok
$io
->gzseek(0, SEEK_CUR) ;
my
$here
=
$io
->gztell() ;
is
$here
,
length
(
$first
)+5;
ok
$io
->gzseek(
$here
+5, SEEK_SET) ;
is
$io
->gztell(),
$here
+5 ;
ok
$io
->gzread(
$buff
, 100) ;
ok
$buff
eq
$last
;
ok
$io
->gzeof;
}
{
my
$lex
= LexFile->new(
my
$name
);
my
$a
= gzopen(
$name
,
"w"
);
ok !
$a
->gzerror()
or
print
"# gzerrno is $Compress::Zlib::gzerrno \n"
;
eval
{
$a
->gzseek(-1, 10) ; };
like $@, mkErr(
"gzseek: unknown value, 10, for whence parameter"
);
eval
{
$a
->gzseek(-1, SEEK_END) ; };
like $@, mkErr(
"gzseek: cannot seek backwards"
);
$a
->gzwrite(
"fred"
);
$a
->gzclose ;
my
$u
= gzopen(
$name
,
"r"
);
eval
{
$u
->gzseek(-1, 10) ; };
like $@, mkErr(
"gzseek: unknown value, 10, for whence parameter"
);
eval
{
$u
->gzseek(-1, SEEK_END) ; };
like $@, mkErr(
"gzseek: SEEK_END not allowed"
);
eval
{
$u
->gzseek(-1, SEEK_CUR) ; };
like $@, mkErr(
"gzseek: cannot seek backwards"
);
}
{
title
"gzread ver 1.x compat -- the output buffer is always zapped."
;
my
$lex
= LexFile->new(
my
$name
);
my
$a
= gzopen(
$name
,
"w"
);
$a
->gzwrite(
"fred"
);
$a
->gzclose ;
my
$u
= gzopen(
$name
,
"r"
);
my
$buf1
;
is
$u
->gzread(
$buf1
, 0), 0,
" gzread returns 0"
;
ok
defined
$buf1
,
" output buffer defined"
;
is
$buf1
,
""
,
" output buffer empty string"
;
my
$buf2
=
"qwerty"
;
is
$u
->gzread(
$buf2
, 0), 0,
" gzread returns 0"
;
ok
defined
$buf2
,
" output buffer defined"
;
is
$buf2
,
""
,
" output buffer empty string"
;
}
{
title
'gzreadline does not support $/'
;
my
$lex
= LexFile->new(
my
$name
);
my
$a
= gzopen(
$name
,
"w"
);
my
$text
=
"fred\n"
;
my
$len
=
length
$text
;
$a
->gzwrite(
$text
);
$a
->gzwrite(
"\n\n"
);
$a
->gzclose ;
for
my
$delim
(
undef
,
""
, 0, 1,
"abc"
,
$text
,
"\n\n"
,
"\n"
)
{
local
$/ =
$delim
;
my
$u
= gzopen(
$name
,
"r"
);
my
$line
;
is
$u
->gzreadline(
$line
),
length
$text
,
" read $len bytes"
;
is
$line
,
$text
,
" got expected line"
;
ok !
$u
->gzclose,
" closed"
;
is $/,
$delim
,
' $/ unchanged by gzreadline'
;
}
}
{
title
'gzflush called twice with Z_SYNC_FLUSH - no compression'
;
my
$lex
= LexFile->new(
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
= LexFile->new(
my
$name
);
ok
my
$a
= gzopen(
$name
,
"w"
);
my
$text
=
"fred\n"
;
my
$len
=
length
$text
;
is
$a
->gzwrite(
$text
),
length
(
$text
),
"gzwrite ok"
;
is
$a
->gzflush(Z_SYNC_FLUSH), Z_OK,
"gzflush returns Z_OK"
;
is
$a
->gzflush(Z_SYNC_FLUSH), Z_OK,
"gzflush returns Z_OK"
;
}