1package CompTestUtils;
2
3package main ;
4
5use strict ;
6use warnings;
7use bytes;
8
9#use lib qw(t t/compress);
10
11use Carp ;
12#use Test::More ;
13
14
15
16sub title
17{
18    #diag "" ;
19    ok 1, $_[0] ;
20    #diag "" ;
21}
22
23sub like_eval
24{
25    like $@, @_ ;
26}
27
28{
29    package LexFile ;
30
31    our ($index);
32    $index = '00000';
33
34    sub new
35    {
36        my $self = shift ;
37        foreach (@_)
38        {
39            # autogenerate the name unless if none supplied
40            $_ = "tst" . $index ++ . ".tmp"
41                unless defined $_;
42        }
43        chmod 0777, @_;
44        for (@_) { 1 while unlink $_ } ;
45        bless [ @_ ], $self ;
46    }
47
48    sub DESTROY
49    {
50        my $self = shift ;
51        chmod 0777, @{ $self } ;
52        for (@$self) { 1 while unlink $_ } ;
53    }
54
55}
56
57{
58    package LexDir ;
59
60    use File::Path;
61    sub new
62    {
63        my $self = shift ;
64        foreach (@_) { rmtree $_ }
65        bless [ @_ ], $self ;
66    }
67
68    sub DESTROY
69    {
70        my $self = shift ;
71        foreach (@$self) { rmtree $_ }
72    }
73}
74sub readFile
75{
76    my $f = shift ;
77
78    my @strings ;
79
80    if (IO::Compress::Base::Common::isaFilehandle($f))
81    {
82        my $pos = tell($f);
83        seek($f, 0,0);
84        @strings = <$f> ;
85        seek($f, 0, $pos);
86    }
87    else
88    {
89        open (F, "<$f")
90            or croak "Cannot open $f: $!\n" ;
91        binmode F;
92        @strings = <F> ;
93        close F ;
94    }
95
96    return @strings if wantarray ;
97    return join "", @strings ;
98}
99
100sub touch
101{
102    foreach (@_) { writeFile($_, '') }
103}
104
105sub writeFile
106{
107    my($filename, @strings) = @_ ;
108    1 while unlink $filename ;
109    open (F, ">$filename")
110        or croak "Cannot open $filename: $!\n" ;
111    binmode F;
112    foreach (@strings) {
113        no warnings ;
114        print F $_ ;
115    }
116    close F ;
117}
118
119sub GZreadFile
120{
121    my ($filename) = shift ;
122
123    my ($uncomp) = "" ;
124    my $line = "" ;
125    my $fil = gzopen($filename, "rb")
126        or croak "Cannopt open '$filename': $Compress::Zlib::gzerrno" ;
127
128    $uncomp .= $line
129        while $fil->gzread($line) > 0;
130
131    $fil->gzclose ;
132    return $uncomp ;
133}
134
135sub hexDump
136{
137    my $d = shift ;
138
139    if (IO::Compress::Base::Common::isaFilehandle($d))
140    {
141        $d = readFile($d);
142    }
143    elsif (IO::Compress::Base::Common::isaFilename($d))
144    {
145        $d = readFile($d);
146    }
147    else
148    {
149        $d = $$d ;
150    }
151
152    my $offset = 0 ;
153
154    $d = '' unless defined $d ;
155    #while (read(STDIN, $data, 16)) {
156    while (my $data = substr($d, 0, 16)) {
157        substr($d, 0, 16) = '' ;
158        printf "# %8.8lx    ", $offset;
159        $offset += 16;
160
161        my @array = unpack('C*', $data);
162        foreach (@array) {
163            printf('%2.2x ', $_);
164        }
165        print "   " x (16 - @array)
166            if @array < 16 ;
167        $data =~ tr/\0-\37\177-\377/./;
168        print "  $data\n";
169    }
170
171}
172
173sub readHeaderInfo
174{
175    my $name = shift ;
176    my %opts = @_ ;
177
178    my $string = <<EOM;
179some text
180EOM
181
182    ok my $x = new IO::Compress::Gzip $name, %opts
183        or diag "GzipError is $IO::Compress::Gzip::GzipError" ;
184    ok $x->write($string) ;
185    ok $x->close ;
186
187    #is GZreadFile($name), $string ;
188
189    ok my $gunz = new IO::Uncompress::Gunzip $name, Strict => 0
190        or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ;
191    ok my $hdr = $gunz->getHeaderInfo();
192    my $uncomp ;
193    ok $gunz->read($uncomp) ;
194    ok $uncomp eq $string;
195    ok $gunz->close ;
196
197    return $hdr ;
198}
199
200sub cmpFile
201{
202    my ($filename, $uue) = @_ ;
203    return readFile($filename) eq unpack("u", $uue) ;
204}
205
206sub isRawFormat
207{
208    my $class = shift;
209    my %raw = map { $_ => 1 } qw( RawDeflate );
210
211    return defined $raw{$class};
212}
213
214sub uncompressBuffer
215{
216    my $compWith = shift ;
217    my $buffer = shift ;
218
219    my %mapping = ( 'IO::Compress::Gzip'                     => 'IO::Uncompress::Gunzip',
220                    'IO::Compress::Gzip::gzip'               => 'IO::Uncompress::Gunzip',
221                    'IO::Compress::Deflate'                  => 'IO::Uncompress::Inflate',
222                    'IO::Compress::Deflate::deflate'         => 'IO::Uncompress::Inflate',
223                    'IO::Compress::RawDeflate'               => 'IO::Uncompress::RawInflate',
224                    'IO::Compress::RawDeflate::rawdeflate'   => 'IO::Uncompress::RawInflate',
225                    'IO::Compress::Bzip2'                    => 'IO::Uncompress::Bunzip2',
226                    'IO::Compress::Bzip2::bzip2'             => 'IO::Uncompress::Bunzip2',
227                    'IO::Compress::Zip'                      => 'IO::Uncompress::Unzip',
228                    'IO::Compress::Zip::zip'                 => 'IO::Uncompress::Unzip',
229                    'IO::Compress::Lzop'                     => 'IO::Uncompress::UnLzop',
230                    'IO::Compress::Lzop::lzop'               => 'IO::Uncompress::UnLzop',
231                    'IO::Compress::Lzf'                      => 'IO::Uncompress::UnLzf' ,
232                    'IO::Compress::Lzf::lzf'                 => 'IO::Uncompress::UnLzf',
233                    'IO::Compress::PPMd'                     => 'IO::Uncompress::UnPPMd' ,
234                    'IO::Compress::PPMd::ppmd'               => 'IO::Uncompress::UnPPMd',
235                    'IO::Compress::Lzma'                     => 'IO::Uncompress::UnLzma',
236                    'IO::Compress::Lzma::lzma'               => 'IO::Uncompress::UnLzma',
237                    'IO::Compress::DummyComp'                => 'IO::Uncompress::DummyUncomp',
238                    'IO::Compress::DummyComp::dummycomp'     => 'IO::Uncompress::DummyUncomp',
239                );
240
241    my $out ;
242    my $obj = $mapping{$compWith}->new( \$buffer, -Append => 1);
243    1 while $obj->read($out) > 0 ;
244    return $out ;
245
246}
247
248my %ErrorMap = (    'IO::Compress::Gzip'                => \$IO::Compress::Gzip::GzipError,
249                    'IO::Compress::Gzip::gzip'          => \$IO::Compress::Gzip::GzipError,
250                    'IO::Uncompress::Gunzip'            => \$IO::Uncompress::Gunzip::GunzipError,
251                    'IO::Uncompress::Gunzip::gunzip'    => \$IO::Uncompress::Gunzip::GunzipError,
252                    'IO::Uncompress::Inflate'           => \$IO::Uncompress::Inflate::InflateError,
253                    'IO::Uncompress::Inflate::inflate'  => \$IO::Uncompress::Inflate::InflateError,
254                    'IO::Compress::Deflate'             => \$IO::Compress::Deflate::DeflateError,
255                    'IO::Compress::Deflate::deflate'    => \$IO::Compress::Deflate::DeflateError,
256                    'IO::Uncompress::RawInflate'        => \$IO::Uncompress::RawInflate::RawInflateError,
257                    'IO::Uncompress::RawInflate::rawinflate'  => \$IO::Uncompress::RawInflate::RawInflateError,
258                    'IO::Uncompress::AnyInflate'        => \$IO::Uncompress::AnyInflate::AnyInflateError,
259                    'IO::Uncompress::AnyInflate::anyinflate'  => \$IO::Uncompress::AnyInflate::AnyInflateError,
260                    'IO::Uncompress::AnyUncompress'        => \$IO::Uncompress::AnyUncompress::AnyUncompressError,
261                    'IO::Uncompress::AnyUncompress::anyUncompress'  => \$IO::Uncompress::AnyUncompress::AnyUncompressError,
262                    'IO::Compress::RawDeflate'          => \$IO::Compress::RawDeflate::RawDeflateError,
263                    'IO::Compress::RawDeflate::rawdeflate'  => \$IO::Compress::RawDeflate::RawDeflateError,
264                    'IO::Compress::Bzip2'               => \$IO::Compress::Bzip2::Bzip2Error,
265                    'IO::Compress::Bzip2::bzip2'        => \$IO::Compress::Bzip2::Bzip2Error,
266                    'IO::Uncompress::Bunzip2'           => \$IO::Uncompress::Bunzip2::Bunzip2Error,
267                    'IO::Uncompress::Bunzip2::bunzip2'  => \$IO::Uncompress::Bunzip2::Bunzip2Error,
268                    'IO::Compress::Zip'                 => \$IO::Compress::Zip::ZipError,
269                    'IO::Compress::Zip::zip'            => \$IO::Compress::Zip::ZipError,
270                    'IO::Uncompress::Unzip'             => \$IO::Uncompress::Unzip::UnzipError,
271                    'IO::Uncompress::Unzip::unzip'      => \$IO::Uncompress::Unzip::UnzipError,
272                    'IO::Compress::Lzop'                => \$IO::Compress::Lzop::LzopError,
273                    'IO::Compress::Lzop::lzop'          => \$IO::Compress::Lzop::LzopError,
274                    'IO::Uncompress::UnLzop'            => \$IO::Uncompress::UnLzop::UnLzopError,
275                    'IO::Uncompress::UnLzop::unlzop'    => \$IO::Uncompress::UnLzop::UnLzopError,
276                    'IO::Compress::Lzf'                 => \$IO::Compress::Lzf::LzfError,
277                    'IO::Compress::Lzf::lzf'            => \$IO::Compress::Lzf::LzfError,
278                    'IO::Uncompress::UnLzf'             => \$IO::Uncompress::UnLzf::UnLzfError,
279                    'IO::Uncompress::UnLzf::unlzf'      => \$IO::Uncompress::UnLzf::UnLzfError,
280                    'IO::Compress::PPMd'                => \$IO::Compress::PPMd::PPMdError,
281                    'IO::Compress::PPMd::ppmd'          => \$IO::Compress::PPMd::PPMdError,
282                    'IO::Uncompress::UnPPMd'            => \$IO::Uncompress::UnPPMd::UnPPMdError,
283                    'IO::Uncompress::UnPPMd::unppmd'    => \$IO::Uncompress::UnPPMd::UnPPMdError,
284                    'IO::Compress::Lzma'                => \$IO::Compress::Lzma::LzmaError,
285                    'IO::Compress::Lzma::lzma'          => \$IO::Compress::Lzma::LzmaError,
286                    'IO::Uncompress::UnLzma'            => \$IO::Uncompress::UnLzma::UnLzmaError,
287                    'IO::Uncompress::UnLzma::unlzma'    => \$IO::Uncompress::UnLzma::UnLzmaError,
288
289                    'IO::Compress::DummyComp'           => \$IO::Compress::DummyComp::DummyCompError,
290                    'IO::Compress::DummyComp::dummycomp'=> \$IO::Compress::DummyComp::DummyCompError,
291                    'IO::Uncompress::DummyUncomp'       => \$IO::Uncompress::DummyUncomp::DummyUncompError,
292                    'IO::Uncompress::DummyUncomp::dummyuncomp' => \$IO::Uncompress::DummyUncomp::DummyUncompError,
293               );
294
295my %TopFuncMap = (  'IO::Compress::Gzip'          => 'IO::Compress::Gzip::gzip',
296                    'IO::Uncompress::Gunzip'      => 'IO::Uncompress::Gunzip::gunzip',
297
298                    'IO::Compress::Deflate'       => 'IO::Compress::Deflate::deflate',
299                    'IO::Uncompress::Inflate'     => 'IO::Uncompress::Inflate::inflate',
300
301                    'IO::Compress::RawDeflate'    => 'IO::Compress::RawDeflate::rawdeflate',
302                    'IO::Uncompress::RawInflate'  => 'IO::Uncompress::RawInflate::rawinflate',
303
304                    'IO::Uncompress::AnyInflate'  => 'IO::Uncompress::AnyInflate::anyinflate',
305                    'IO::Uncompress::AnyUncompress'  => 'IO::Uncompress::AnyUncompress::anyuncompress',
306
307                    'IO::Compress::Bzip2'         => 'IO::Compress::Bzip2::bzip2',
308                    'IO::Uncompress::Bunzip2'     => 'IO::Uncompress::Bunzip2::bunzip2',
309
310                    'IO::Compress::Zip'           => 'IO::Compress::Zip::zip',
311                    'IO::Uncompress::Unzip'       => 'IO::Uncompress::Unzip::unzip',
312                    'IO::Compress::Lzop'          => 'IO::Compress::Lzop::lzop',
313                    'IO::Uncompress::UnLzop'      => 'IO::Uncompress::UnLzop::unlzop',
314                    'IO::Compress::Lzf'           => 'IO::Compress::Lzf::lzf',
315                    'IO::Uncompress::UnLzf'       => 'IO::Uncompress::UnLzf::unlzf',
316                    'IO::Compress::PPMd'          => 'IO::Compress::PPMd::ppmd',
317                    'IO::Uncompress::UnPPMd'      => 'IO::Uncompress::UnPPMd::unppmd',
318
319                    'IO::Compress::Lzma'          => 'IO::Compress::Lzma::lzma',
320                    'IO::Uncompress::UnLzma'      => 'IO::Uncompress::UnLzma::unlzma',
321
322                    'IO::Compress::DummyComp'     => 'IO::Compress::DummyComp::dummyuncomp',
323                    'IO::Uncompress::DummyUncomp' => 'IO::Uncompress::DummyUncomp::dummyuncomp',
324                 );
325
326   %TopFuncMap = map { ($_              => $TopFuncMap{$_},
327                        $TopFuncMap{$_} => $TopFuncMap{$_}) }
328                 keys %TopFuncMap ;
329
330 #%TopFuncMap = map { ($_              => \&{ $TopFuncMap{$_} ) }
331                 #keys %TopFuncMap ;
332
333
334my %inverse  = ( 'IO::Compress::Gzip'                    => 'IO::Uncompress::Gunzip',
335                 'IO::Compress::Gzip::gzip'              => 'IO::Uncompress::Gunzip::gunzip',
336                 'IO::Compress::Deflate'                 => 'IO::Uncompress::Inflate',
337                 'IO::Compress::Deflate::deflate'        => 'IO::Uncompress::Inflate::inflate',
338                 'IO::Compress::RawDeflate'              => 'IO::Uncompress::RawInflate',
339                 'IO::Compress::RawDeflate::rawdeflate'  => 'IO::Uncompress::RawInflate::rawinflate',
340                 'IO::Compress::Bzip2::bzip2'            => 'IO::Uncompress::Bunzip2::bunzip2',
341                 'IO::Compress::Bzip2'                   => 'IO::Uncompress::Bunzip2',
342                 'IO::Compress::Zip::zip'                => 'IO::Uncompress::Unzip::unzip',
343                 'IO::Compress::Zip'                     => 'IO::Uncompress::Unzip',
344                 'IO::Compress::Lzop::lzop'              => 'IO::Uncompress::UnLzop::unlzop',
345                 'IO::Compress::Lzop'                    => 'IO::Uncompress::UnLzop',
346                 'IO::Compress::Lzf::lzf'                => 'IO::Uncompress::UnLzf::unlzf',
347                 'IO::Compress::Lzf'                     => 'IO::Uncompress::UnLzf',
348                 'IO::Compress::PPMd::ppmd'              => 'IO::Uncompress::UnPPMd::unppmd',
349                 'IO::Compress::PPMd'                    => 'IO::Uncompress::UnPPMd',
350                 'IO::Compress::Lzma::lzma'              => 'IO::Uncompress::UnLzma::unlzma',
351                 'IO::Compress::Lzma'                    => 'IO::Uncompress::UnLzma',
352                 'IO::Compress::DummyComp::dummycomp'    => 'IO::Uncompress::DummyUncomp::dummyuncomp',
353                 'IO::Compress::DummyComp'               => 'IO::Uncompress::DummyUncomp',
354             );
355
356%inverse  = map { ($_ => $inverse{$_}, $inverse{$_} => $_) } keys %inverse;
357
358sub getInverse
359{
360    my $class = shift ;
361
362    return $inverse{$class} ;
363}
364
365sub getErrorRef
366{
367    my $class = shift ;
368
369    return $ErrorMap{$class} ;
370}
371
372sub getTopFuncRef
373{
374    my $class = shift ;
375
376    return \&{ $TopFuncMap{$class} } ;
377}
378
379sub getTopFuncName
380{
381    my $class = shift ;
382
383    return $TopFuncMap{$class}  ;
384}
385
386sub compressBuffer
387{
388    my $compWith = shift ;
389    my $buffer = shift ;
390
391    my %mapping = ( 'IO::Uncompress::Gunzip'                  => 'IO::Compress::Gzip',
392                    'IO::Uncompress::Gunzip::gunzip'          => 'IO::Compress::Gzip',
393                    'IO::Uncompress::Inflate'                 => 'IO::Compress::Deflate',
394                    'IO::Uncompress::Inflate::inflate'        => 'IO::Compress::Deflate',
395                    'IO::Uncompress::RawInflate'              => 'IO::Compress::RawDeflate',
396                    'IO::Uncompress::RawInflate::rawinflate'  => 'IO::Compress::RawDeflate',
397                    'IO::Uncompress::Bunzip2'                 => 'IO::Compress::Bzip2',
398                    'IO::Uncompress::Bunzip2::bunzip2'        => 'IO::Compress::Bzip2',
399                    'IO::Uncompress::Unzip'                   => 'IO::Compress::Zip',
400                    'IO::Uncompress::Unzip::unzip'            => 'IO::Compress::Zip',
401                    'IO::Uncompress::UnLzop'                  => 'IO::Compress::Lzop',
402                    'IO::Uncompress::UnLzop::unlzop'          => 'IO::Compress::Lzop',
403                    'IO::Uncompress::UnLzp'                   => 'IO::Compress::Lzf',
404                    'IO::Uncompress::UnLzf::unlzf'            => 'IO::Compress::Lzf',
405                    'IO::Uncompress::UnPPMd'                  => 'IO::Compress::PPMd',
406                    'IO::Uncompress::UnPPMd::unppmd'          => 'IO::Compress::PPMd',
407                    'IO::Uncompress::AnyInflate'              => 'IO::Compress::Gzip',
408                    'IO::Uncompress::AnyInflate::anyinflate'  => 'IO::Compress::Gzip',
409                    'IO::Uncompress::AnyUncompress'           => 'IO::Compress::Gzip',
410                    'IO::Uncompress::AnyUncompress::anyuncompress'  => 'IO::Compress::Gzip',
411                    'IO::Uncompress::UnLzma'                  => 'IO::Compress::Lzma',
412                    'IO::Uncompress::UnLzma::unlzma'          => 'IO::Compress::Lzma',
413                    'IO::Uncompress::DummyUncomp'             => 'IO::Compress::DummyComp',
414                    'IO::Uncompress::DummyUncomp::dummyuncomp'=> 'IO::Compress::DummyComp',
415                );
416
417    my $out ;
418    my $obj = $mapping{$compWith}->new( \$out);
419    $obj->write($buffer) ;
420    $obj->close();
421    return $out ;
422}
423
424our ($AnyUncompressError);
425BEGIN
426{
427    eval ' use IO::Uncompress::AnyUncompress qw($AnyUncompressError); ';
428}
429
430sub anyUncompress
431{
432    my $buffer = shift ;
433    my $already = shift;
434
435    my @opts = ();
436    if (ref $buffer && ref $buffer eq 'ARRAY')
437    {
438        @opts = @$buffer;
439        $buffer = shift @opts;
440    }
441
442    if (ref $buffer)
443    {
444        croak "buffer is undef" unless defined $$buffer;
445        croak "buffer is empty" unless length $$buffer;
446
447    }
448
449
450    my $data ;
451    if (IO::Compress::Base::Common::isaFilehandle($buffer))
452    {
453        $data = readFile($buffer);
454    }
455    elsif (IO::Compress::Base::Common::isaFilename($buffer))
456    {
457        $data = readFile($buffer);
458    }
459    else
460    {
461        $data = $$buffer ;
462    }
463
464    if (defined $already && length $already)
465    {
466
467        my $got = substr($data, 0, length($already));
468        substr($data, 0, length($already)) = '';
469
470        is $got, $already, '  Already OK' ;
471    }
472
473    my $out = '';
474    my $o = new IO::Uncompress::AnyUncompress \$data,
475                    Append => 1,
476                    Transparent => 0,
477                    RawInflate => 1,
478                    @opts
479        or croak "Cannot open buffer/file: $AnyUncompressError" ;
480
481    1 while $o->read($out) > 0 ;
482
483    croak "Error uncompressing -- " . $o->error()
484        if $o->error() ;
485
486    return $out ;
487
488}
489
490sub getHeaders
491{
492    my $buffer = shift ;
493    my $already = shift;
494
495    my @opts = ();
496    if (ref $buffer && ref $buffer eq 'ARRAY')
497    {
498        @opts = @$buffer;
499        $buffer = shift @opts;
500    }
501
502    if (ref $buffer)
503    {
504        croak "buffer is undef" unless defined $$buffer;
505        croak "buffer is empty" unless length $$buffer;
506
507    }
508
509
510    my $data ;
511    if (IO::Compress::Base::Common::isaFilehandle($buffer))
512    {
513        $data = readFile($buffer);
514    }
515    elsif (IO::Compress::Base::Common::isaFilename($buffer))
516    {
517        $data = readFile($buffer);
518    }
519    else
520    {
521        $data = $$buffer ;
522    }
523
524    if (defined $already && length $already)
525    {
526
527        my $got = substr($data, 0, length($already));
528        substr($data, 0, length($already)) = '';
529
530        is $got, $already, '  Already OK' ;
531    }
532
533    my $out = '';
534    my $o = new IO::Uncompress::AnyUncompress \$data,
535                MultiStream => 1,
536                Append => 1,
537                Transparent => 0,
538                RawInflate => 1,
539                @opts
540        or croak "Cannot open buffer/file: $AnyUncompressError" ;
541
542    1 while $o->read($out) > 0 ;
543
544    croak "Error uncompressing -- " . $o->error()
545        if $o->error() ;
546
547    return ($o->getHeaderInfo()) ;
548
549}
550
551sub mkComplete
552{
553    my $class = shift ;
554    my $data = shift;
555    my $Error = getErrorRef($class);
556
557    my $buffer ;
558    my %params = ();
559
560    if ($class eq 'IO::Compress::Gzip') {
561        %params = (
562            Name       => "My name",
563            Comment    => "a comment",
564            ExtraField => ['ab' => "extra"],
565            HeaderCRC  => 1);
566    }
567    elsif ($class eq 'IO::Compress::Zip'){
568        %params = (
569            Name              => "My name",
570            Comment           => "a comment",
571            ZipComment        => "last comment",
572            exTime            => [100, 200, 300],
573            ExtraFieldLocal   => ["ab" => "extra1"],
574            ExtraFieldCentral => ["cd" => "extra2"],
575        );
576    }
577
578    my $z = new $class( \$buffer, %params)
579        or croak "Cannot create $class object: $$Error";
580    $z->write($data);
581    $z->close();
582
583    my $unc = getInverse($class);
584    anyUncompress(\$buffer) eq $data
585        or die "bad bad bad";
586    my $u = new $unc( \$buffer);
587    my $info = $u->getHeaderInfo() ;
588
589
590    return wantarray ? ($info, $buffer) : $buffer ;
591}
592
593sub mkErr
594{
595    my $string = shift ;
596    my ($dummy, $file, $line) = caller ;
597    -- $line ;
598
599    $file = quotemeta($file);
600
601    #return "/$string\\s+at $file line $line/" if $] >= 5.006 ;
602    return "/$string\\s+at /" ;
603}
604
605sub mkEvalErr
606{
607    my $string = shift ;
608
609    return "/$string\\s+at \\(eval /" if $] > 5.006 ;
610    return "/$string\\s+at /" ;
611}
612
613sub dumpObj
614{
615    my $obj = shift ;
616
617    my ($dummy, $file, $line) = caller ;
618
619    if (@_)
620    {
621        print "#\n# dumpOBJ from $file line $line @_\n" ;
622    }
623    else
624    {
625        print "#\n# dumpOBJ from $file line $line \n" ;
626    }
627
628    my $max = 0 ;;
629    foreach my $k (keys %{ *$obj })
630    {
631        $max = length $k if length $k > $max ;
632    }
633
634    foreach my $k (sort keys %{ *$obj })
635    {
636        my $v = $obj->{$k} ;
637        $v = '-undef-' unless defined $v;
638        my $pad = ' ' x ($max - length($k) + 2) ;
639        print "# $k$pad: [$v]\n";
640    }
641    print "#\n" ;
642}
643
644
645sub getMultiValues
646{
647    my $class = shift ;
648
649    return (0,0) if $class =~ /lzf/i;
650    return (1,0);
651}
652
653
654sub gotScalarUtilXS
655{
656    eval ' use Scalar::Util "dualvar" ';
657    return $@ ? 0 : 1 ;
658}
659
660sub currmem {
661
662    # From https://github.com/eserte/srezic-repository/blob/master/perl/currmem#L14
663
664    my $pid = shift || $$;
665
666    no warnings 'portable'; # because of possible large hex values on 64bit systems
667
668    if ($^O eq 'freebsd' && open(MAP, "dd if=/proc/$pid/map bs=64k 2>/dev/null |")) { # FreeBSD
669        my $mem = 0;
670        my $realmem = 0;
671        while(<MAP>) {
672            my(@l) = split /\s+/;
673            my $delta = (hex($l[1])-hex($l[0]));
674            $mem += $delta;
675            if ($l[11] ne 'vnode') {
676                $realmem += $delta;
677            }
678
679        }
680
681        close MAP;
682        ($mem, $realmem);
683
684    } elsif ($^O eq 'linux' && open(MAP, "/proc/$pid/maps")) { # Linux
685
686        my $mem = 0;
687        my $realmem = 0;
688        while(<MAP>) {
689            my(@l) = split /\s+/;
690            my($start,$end) = split /-/, $l[0];
691            my $delta = (hex($end)-hex($start));
692            $mem += $delta;
693            if (!defined $l[5] || $l[5] eq '' || $l[5] eq '[heap]') {
694                $realmem += $delta;
695            }
696        }
697        close MAP;
698        ($mem, $realmem);
699    } else {
700	    undef;
701    }
702}
703
704sub displayMemoryUsage
705{
706    my $message = shift;
707
708    my ($mem, $realmem) = currmem();
709    print "$message:\t$mem\t$realmem\n";
710}
711
712package CompTestUtils;
713
7141;
715__END__
716	t/Test/Builder.pm
717	t/Test/More.pm
718	t/Test/Simple.pm
719	t/compress/CompTestUtils.pm
720	t/compress/any.pl
721	t/compress/anyunc.pl
722	t/compress/destroy.pl
723	t/compress/generic.pl
724	t/compress/merge.pl
725	t/compress/multi.pl
726	t/compress/newtied.pl
727	t/compress/oneshot.pl
728	t/compress/prime.pl
729	t/compress/tied.pl
730	t/compress/truncate.pl
731	t/compress/zlib-generic.plParsing config.in...
732Building Zlib enabled
733Auto Detect Gzip OS Code..
734Setting Gzip OS Code to 3 [Unix/Default]
735Looks Good.
736