Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
Aliases.t	5.68 KB	-r--r--r--	2014-12-27 11:48
CJKT.t	3.01 KB	-r--r--r--	2014-12-27 11:48
Encode.t	5.03 KB	-r--r--r--	2014-12-27 11:48
Encoder.t	1006 B	-r--r--r--	2014-12-27 11:48
Mod_EUCJP.pm	442 B	-r--r--r--	2014-12-27 11:48
Unicode.t	5.83 KB	-r--r--r--	2014-12-27 11:48
at-cn.t	3.99 KB	-r--r--r--	2014-12-27 11:48
at-tw.t	2.54 KB	-r--r--r--	2014-12-27 11:48
big5-eten.enc	31.35 KB	-r--r--r--	2014-12-27 11:48
big5-eten.utf	44.79 KB	-r--r--r--	2014-12-27 11:48
big5-hkscs.enc	41.53 KB	-r--r--r--	2014-12-27 11:48
big5-hkscs.utf	59.27 KB	-r--r--r--	2014-12-27 11:48
cow.t	385 B	-r--r--r--	2014-12-27 11:48
decode.t	514 B	-r--r--r--	2014-12-27 11:48
enc_data.t	1020 B	-r--r--r--	2014-12-27 11:48
enc_eucjp.t	2.08 KB	-r--r--r--	2014-12-27 11:48
enc_module.enc	24 B	-r--r--r--	2014-12-27 11:48
enc_module.t	1.73 KB	-r--r--r--	2014-12-27 11:48
enc_utf8.t	1.9 KB	-r--r--r--	2014-12-27 11:48
encoding.t	5.14 KB	-r--r--r--	2014-12-27 11:48
fallback.t	5.08 KB	-r--r--r--	2014-12-27 11:48
from_to.t	357 B	-r--r--r--	2014-12-27 11:48
gb2312.enc	16.96 KB	-r--r--r--	2014-12-27 11:48
gb2312.utf	24.08 KB	-r--r--r--	2014-12-27 11:48
grow.t	820 B	-r--r--r--	2014-12-27 11:48
gsm0338.t	3.55 KB	-r--r--r--	2014-12-27 11:48
guess.t	3.68 KB	-r--r--r--	2014-12-27 11:48
jis7-fallback.t	337 B	-r--r--r--	2014-12-27 11:48
jisx0201.enc	145 B	-r--r--r--	2014-12-27 11:48
jisx0201.utf	208 B	-r--r--r--	2014-12-27 11:48
jisx0208.enc	15.77 KB	-r--r--r--	2014-12-27 11:48
jisx0208.utf	22.36 KB	-r--r--r--	2014-12-27 11:48
jisx0212.enc	19.86 KB	-r--r--r--	2014-12-27 11:48
jisx0212.utf	19.6 KB	-r--r--r--	2014-12-27 11:48
jperl.t	2.63 KB	-r--r--r--	2014-12-27 11:48
ksc5601.enc	18.72 KB	-r--r--r--	2014-12-27 11:48
ksc5601.utf	26.59 KB	-r--r--r--	2014-12-27 11:48
mime-header.t	4.54 KB	-r--r--r--	2014-12-27 11:48
mime-name.t	836 B	-r--r--r--	2014-12-27 11:48
mime_header_iso2022jp.t	1.02 KB	-r--r--r--	2014-12-27 11:48
perlio.t	4.83 KB	-r--r--r--	2014-12-27 11:48
piconv.t	2.55 KB	-r--r--r--	2014-12-27 11:48
rt.pl	1.69 KB	-r--r--r--	2014-12-27 11:48
taint.t	393 B	-r--r--r--	2014-12-27 11:49
unibench.pl	1.81 KB	-r--r--r--	2014-12-27 11:48
utf8ref.t	368 B	-r--r--r--	2014-12-27 11:48
utf8strict.t	2.54 KB	-r--r--r--	2014-12-27 11:48

Rename

BEGIN {
    require Config; import Config;
    if ($Config{'extensions'} !~ /\bEncode\b/) {
      print "1..0 # Skip: Encode was not built\n";
      exit 0;
    }
    if (ord("A") == 193) {
    print "1..0 # Skip: EBCDIC\n";
    exit 0;
    }
    unless (PerlIO::Layer->find('perlio')){
        print "1..0 # Skip: PerlIO required\n";
        exit 0;
    }
    $| = 1;
}

use strict;
use File::Basename;
use File::Spec;
use File::Compare qw(compare_text);
use File::Copy;
use FileHandle;

#use Test::More qw(no_plan);
use Test::More tests => 38;

our $DEBUG = 0;

use Encode (":all");
{
    no warnings;
    @ARGV and $DEBUG = shift;
    #require Encode::JP::JIS7;
    #require Encode::KR::2022_KR;
    #$Encode::JP::JIS7::DEBUG = $DEBUG;
}

my $seq = 0;
my $dir = dirname(__FILE__);

my %e = 
    (
     jisx0208 => [ qw/euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1/],
     ksc5601  => [ qw/euc-kr/],
     gb2312   => [ qw/euc-cn hz/],
    );

$/ = "\x0a"; # may fix VMS problem for test #28 and #29

for my $src (sort keys %e) {
    my $ufile = File::Spec->catfile($dir,"$src.utf");
    open my $fh, "<:utf8", $ufile or die "$ufile : $!";
    my @uline = <$fh>;
    my $utext = join('' => @uline);
    close $fh;

for my $e (@{$e{$src}}){
    my $sfile = File::Spec->catfile($dir,"$$.sio");
    my $pfile = File::Spec->catfile($dir,"$$.pio");
    
    # first create a file without perlio
    dump2file($sfile, &encode($e, $utext, 0));
    
    # then create a file via perlio without autoflush

SKIP:{
        skip "$e: !perlio_ok", 4 unless (perlio_ok($e) or $DEBUG);
        no warnings 'uninitialized';
        open $fh, ">:encoding($e)", $pfile or die "$sfile : $!";
        $fh->autoflush(0);
        print $fh $utext;
        close $fh;
        $seq++;
        is(compare_text($sfile, $pfile), 0 => ">:encoding($e)");
        if ($DEBUG){
        copy $sfile, "$sfile.$seq";
        copy $pfile, "$pfile.$seq";
        }
        
        # this time print line by line.
        # works even for ISO-2022 but not ISO-2022-KR
        open $fh, ">:encoding($e)", $pfile or die "$sfile : $!";
        $fh->autoflush(1);
        for my $l (@uline) {
        print $fh $l;
        }
        close $fh;
        $seq++;
        is(compare_text($sfile, $pfile), 0 => ">:encoding($e) by lines");
        if ($DEBUG){
        copy $sfile, "$sfile.$seq";
        copy $pfile, "$pfile.$seq";
        }
        my $dtext;
        open $fh, "<:encoding($e)", $pfile or die "$pfile : $!";
        $fh->autoflush(0);
        $dtext = join('' => <$fh>);
        close $fh;
        $seq++;
        ok($utext eq $dtext, "<:encoding($e)");
        if ($DEBUG){
        dump2file("$sfile.$seq", $utext);
        dump2file("$pfile.$seq", $dtext);
        }
        if (perlio_ok($e) or $DEBUG){
        $dtext = '';
        open $fh, "<:encoding($e)", $pfile or die "$pfile : $!";
        while(defined(my $l = <$fh>)) {
            $dtext .= $l;
        }
        close $fh;
        }
        $seq++;
        ok($utext eq $dtext,  "<:encoding($e) by lines");
        if ($DEBUG){
        dump2file("$sfile.$seq", $utext);
        dump2file("$pfile.$seq", $dtext);
        }
    }
     if ( ! $DEBUG ) {
            1 while unlink ($sfile);
            1 while unlink ($pfile);
        }
    }
}

# BOM Test

SKIP:{
    my $pev = PerlIO::encoding->VERSION;
    skip "PerlIO::encoding->VERSION = $pev <= 0.07 ", 6
    unless ($pev >= 0.07 or $DEBUG);

my $file = File::Spec->catfile($dir,"jisx0208.utf");
    open my $fh, "<:utf8", $file or die "$file : $!";
    my $str = join('' => <$fh>);
    close $fh;
    my %bom = (
           'UTF-16BE' => pack('n', 0xFeFF),
           'UTF-16LE' => pack('v', 0xFeFF),
           'UTF-32BE' => pack('N', 0xFeFF),
           'UTF-32LE' => pack('V', 0xFeFF),
          );
    # reading
    for my $utf (sort keys %bom){
    my $bomed = $bom{$utf} . encode($utf, $str);
    my $sfile = File::Spec->catfile($dir,".${utf}_${seq}_$$");
    dump2file($sfile, $bomed);
    my $utf_nobom = $utf; $utf_nobom =~ s/(LE|BE)$//o;
    # reading
    open $fh, "<:encoding($utf_nobom)", $sfile or die "$sfile : $!";
    my $cmp = join '' => <$fh>;
    close $fh;
    is($str, $cmp, "<:encoding($utf_nobom) eq $utf");
    unlink $sfile;  $seq++;
    }
    # writing
    for my $utf_nobom (qw/UTF-16 UTF-32/){
    my $utf = $utf_nobom . 'BE';
    my $sfile = File::Spec->catfile($dir,".${utf_nobom}_${seq}_$$");
    my $bomed = $bom{$utf} . encode($utf, $str);
    open  $fh, ">:encoding($utf_nobom)", $sfile or die "$sfile : $!";
    print $fh $str;
    close $fh;
    open my $fh, "<:bytes", $sfile or die "$sfile : $!";
    read $fh, my $cmp, -s $sfile;
    close $fh;
    use bytes ();
    ok($bomed eq $cmp, ">:encoding($utf_nobom) eq $utf");
    unlink $sfile; $seq++;
    }
}
sub dump2file{
    no warnings;
    open my $fh, ">", $_[0] or die "$_[0]: $!";
    binmode $fh;
    print $fh $_[1];
    close $fh;
}