Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
CompTestUtils.pm	18.11 KB	-r--r--r--	2014-12-27 11:48
any.pl	2.97 KB	-r--r--r--	2014-12-27 11:48
anyunc.pl	2.59 KB	-r--r--r--	2014-12-27 11:48
destroy.pl	2.28 KB	-r--r--r--	2014-12-27 11:48
encode.pl	4.74 KB	-r--r--r--	2014-12-27 11:48
generic.pl	50.95 KB	-r--r--r--	2014-12-27 11:48
merge.pl	9.24 KB	-r--r--r--	2014-12-27 11:48
multi.pl	9.4 KB	-r--r--r--	2014-12-27 11:48
newtied.pl	9.71 KB	-r--r--r--	2014-12-27 11:48
oneshot.pl	53.35 KB	-r--r--r--	2014-12-27 11:49
prime.pl	2.29 KB	-r--r--r--	2014-12-27 11:49
tied.pl	13.02 KB	-r--r--r--	2014-12-27 11:48
truncate.pl	10.03 KB	-r--r--r--	2014-12-27 11:48
zlib-generic.pl	4.68 KB	-r--r--r--	2014-12-27 11:48

Rename

use strict;
use warnings;
#use bytes;

use Test::More ;
use CompTestUtils;

BEGIN 
{ 
    plan skip_all => "Encode is not available"
        if $] < 5.006 ;

eval { require Encode; Encode->import(); };

plan skip_all => "Encode is not available"
        if $@ ;
    
    # use Test::NoWarnings, if available
    my $extra = 0 ;

my $st = eval { require Test::NoWarnings ;  import Test::NoWarnings; 1; };
    $extra = 1
        if $st ;

plan(tests => 29 + $extra) ;
}

sub run
{
    my $CompressClass   = identify();
    my $UncompressClass = getInverse($CompressClass);
    my $Error           = getErrorRef($CompressClass);
    my $UnError         = getErrorRef($UncompressClass);

my $string = "\x{df}\x{100}\x80"; 
    my $encString = Encode::encode_utf8($string);
    my $buffer = $encString;

#for my $from ( qw(filename filehandle buffer) )
    {
#        my $input ;
#        my $lex = new LexFile my $name ;
#
#        
#        if ($from eq 'buffer')
#          { $input = \$buffer }
#        elsif ($from eq 'filename')
#        {
#            $input = $name ;
#            writeFile($name, $buffer);
#        }
#        elsif ($from eq 'filehandle')
#        {
#            $input = new IO::File "<$name" ;
#        }

for my $to ( qw(filehandle buffer))
        {
            title "OO Mode: To $to, Encode by hand";

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);
            $cs->print($encString);
            $cs->close();

my $input;
            if ($to eq 'buffer')
              { $input = \$buffer }
            else 
            {
                $input = $name2 ;
            }

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 $decode, $string, "  Expected output";

}
    }

{
        title "Catch wide characters";

my $out;
        my $cs = new $CompressClass(\$out);
        my $a = "a\xFF\x{100}";
        eval { $cs->syswrite($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";
#            }            
        }        
    }

}