"Fossies" - the Fresh Open Source Software Archive

Member "perl-5.32.1/cpan/IO-Compress/t/002any-transparent.t" (18 Dec 2020, 1436 Bytes) of package /linux/misc/perl-5.32.1.tar.xz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 BEGIN {
    2     if ($ENV{PERL_CORE}) {
    3         chdir 't' if -d 't';
    4         @INC = ("../lib", "lib/compress");
    5     }
    6 }
    7 
    8 use lib qw(t t/compress);
    9  
   10 use strict;
   11 use warnings;
   12 use bytes;
   13 
   14 use Test::More ;
   15 use CompTestUtils;
   16 
   17 BEGIN {
   18     # use Test::NoWarnings, if available
   19     my $extra = 0 ;
   20     $extra = 1
   21         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
   22 
   23     plan tests => 15 + $extra ;
   24 
   25     use_ok('IO::Uncompress::AnyInflate', qw($AnyInflateError)) ;
   26 
   27 }
   28 
   29 {
   30 
   31     my $string = <<EOM;
   32 This is not compressed data
   33 EOM
   34 
   35     my $buffer = $string ;
   36 
   37     for my $file (0, 1)
   38     {
   39         title "AnyInflate with Non-compressed data (File $file)" ;
   40 
   41         my $lex = new LexFile my $output;
   42         my $input ;
   43 
   44         if ($file) {
   45             writeFile($output, $buffer);
   46             $input = $output;
   47         }
   48         else {
   49             $input = \$buffer;
   50         }
   51 
   52 
   53         my $unc ;
   54         my $keep = $buffer ;
   55         $unc = new IO::Uncompress::AnyInflate $input, -Transparent => 0 ;
   56         ok ! $unc,"  no AnyInflate object when -Transparent => 0" ;
   57         is $buffer, $keep ;
   58 
   59         $buffer = $keep ;
   60         $unc = new IO::Uncompress::AnyInflate \$buffer, -Transparent => 1 ;
   61         ok $unc, "  AnyInflate object when -Transparent => 1"  ;
   62 
   63         my $uncomp ;
   64         ok $unc->read($uncomp) > 0 ;
   65         ok $unc->eof() ;
   66         #ok $unc->type eq $Type;
   67 
   68         is $uncomp, $string ;
   69     }
   70 }
   71 
   72 1;