Blame t/perlio.t

Packit d0f5c2
BEGIN {
Packit d0f5c2
    require Config; import Config;
Packit d0f5c2
    if ($Config{'extensions'} !~ /\bEncode\b/) {
Packit d0f5c2
      print "1..0 # Skip: Encode was not built\n";
Packit d0f5c2
      exit 0;
Packit d0f5c2
    }
Packit d0f5c2
    if (ord("A") == 193) {
Packit d0f5c2
    print "1..0 # Skip: EBCDIC\n";
Packit d0f5c2
    exit 0;
Packit d0f5c2
    }
Packit d0f5c2
    unless (PerlIO::Layer->find('perlio')){
Packit d0f5c2
        print "1..0 # Skip: PerlIO required\n";
Packit d0f5c2
        exit 0;
Packit d0f5c2
    }
Packit d0f5c2
    $| = 1;
Packit d0f5c2
}
Packit d0f5c2
Packit d0f5c2
use strict;
Packit d0f5c2
use File::Basename;
Packit d0f5c2
use File::Spec;
Packit d0f5c2
use File::Compare qw(compare_text);
Packit d0f5c2
use File::Copy;
Packit d0f5c2
use FileHandle;
Packit d0f5c2
Packit d0f5c2
#use Test::More qw(no_plan);
Packit d0f5c2
use Test::More tests => 38;
Packit d0f5c2
Packit d0f5c2
our $DEBUG = 0;
Packit d0f5c2
Packit d0f5c2
use Encode (":all");
Packit d0f5c2
{
Packit d0f5c2
    no warnings;
Packit d0f5c2
    @ARGV and $DEBUG = shift;
Packit d0f5c2
    #require Encode::JP::JIS7;
Packit d0f5c2
    #require Encode::KR::2022_KR;
Packit d0f5c2
    #$Encode::JP::JIS7::DEBUG = $DEBUG;
Packit d0f5c2
}
Packit d0f5c2
Packit d0f5c2
my $seq = 0;
Packit d0f5c2
my $dir = dirname(__FILE__);
Packit d0f5c2
Packit d0f5c2
my %e = 
Packit d0f5c2
    (
Packit d0f5c2
     jisx0208 => [ qw/euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1/],
Packit d0f5c2
     ksc5601  => [ qw/euc-kr/],
Packit d0f5c2
     gb2312   => [ qw/euc-cn hz/],
Packit d0f5c2
    );
Packit d0f5c2
Packit d0f5c2
$/ = "\x0a"; # may fix VMS problem for test #28 and #29
Packit d0f5c2
Packit d0f5c2
for my $src (sort keys %e) {
Packit d0f5c2
    my $ufile = File::Spec->catfile($dir,"$src.utf");
Packit d0f5c2
    open my $fh, "<:utf8", $ufile or die "$ufile : $!";
Packit d0f5c2
    my @uline = <$fh>;
Packit d0f5c2
    my $utext = join('' => @uline);
Packit d0f5c2
    close $fh;
Packit d0f5c2
Packit d0f5c2
    for my $e (@{$e{$src}}){
Packit d0f5c2
    my $sfile = File::Spec->catfile($dir,"$$.sio");
Packit d0f5c2
    my $pfile = File::Spec->catfile($dir,"$$.pio");
Packit d0f5c2
    
Packit d0f5c2
    # first create a file without perlio
Packit d0f5c2
    dump2file($sfile, &encode($e, $utext, 0));
Packit d0f5c2
    
Packit d0f5c2
    # then create a file via perlio without autoflush
Packit d0f5c2
Packit d0f5c2
    SKIP:{
Packit d0f5c2
        skip "$e: !perlio_ok", 4 unless (perlio_ok($e) or $DEBUG);
Packit d0f5c2
        no warnings 'uninitialized';
Packit d0f5c2
        open $fh, ">:encoding($e)", $pfile or die "$sfile : $!";
Packit d0f5c2
        $fh->autoflush(0);
Packit d0f5c2
        print $fh $utext;
Packit d0f5c2
        close $fh;
Packit d0f5c2
        $seq++;
Packit d0f5c2
        is(compare_text($sfile, $pfile), 0 => ">:encoding($e)");
Packit d0f5c2
        if ($DEBUG){
Packit d0f5c2
        copy $sfile, "$sfile.$seq";
Packit d0f5c2
        copy $pfile, "$pfile.$seq";
Packit d0f5c2
        }
Packit d0f5c2
        
Packit d0f5c2
        # this time print line by line.
Packit d0f5c2
        # works even for ISO-2022 but not ISO-2022-KR
Packit d0f5c2
        open $fh, ">:encoding($e)", $pfile or die "$sfile : $!";
Packit d0f5c2
        $fh->autoflush(1);
Packit d0f5c2
        for my $l (@uline) {
Packit d0f5c2
        print $fh $l;
Packit d0f5c2
        }
Packit d0f5c2
        close $fh;
Packit d0f5c2
        $seq++;
Packit d0f5c2
        is(compare_text($sfile, $pfile), 0 => ">:encoding($e) by lines");
Packit d0f5c2
        if ($DEBUG){
Packit d0f5c2
        copy $sfile, "$sfile.$seq";
Packit d0f5c2
        copy $pfile, "$pfile.$seq";
Packit d0f5c2
        }
Packit d0f5c2
        my $dtext;
Packit d0f5c2
        open $fh, "<:encoding($e)", $pfile or die "$pfile : $!";
Packit d0f5c2
        $fh->autoflush(0);
Packit d0f5c2
        $dtext = join('' => <$fh>);
Packit d0f5c2
        close $fh;
Packit d0f5c2
        $seq++;
Packit d0f5c2
        ok($utext eq $dtext, "<:encoding($e)");
Packit d0f5c2
        if ($DEBUG){
Packit d0f5c2
        dump2file("$sfile.$seq", $utext);
Packit d0f5c2
        dump2file("$pfile.$seq", $dtext);
Packit d0f5c2
        }
Packit d0f5c2
        if (perlio_ok($e) or $DEBUG){
Packit d0f5c2
        $dtext = '';
Packit d0f5c2
        open $fh, "<:encoding($e)", $pfile or die "$pfile : $!";
Packit d0f5c2
        while(defined(my $l = <$fh>)) {
Packit d0f5c2
            $dtext .= $l;
Packit d0f5c2
        }
Packit d0f5c2
        close $fh;
Packit d0f5c2
        }
Packit d0f5c2
        $seq++;
Packit d0f5c2
        ok($utext eq $dtext,  "<:encoding($e) by lines");
Packit d0f5c2
        if ($DEBUG){
Packit d0f5c2
        dump2file("$sfile.$seq", $utext);
Packit d0f5c2
        dump2file("$pfile.$seq", $dtext);
Packit d0f5c2
        }
Packit d0f5c2
    }
Packit d0f5c2
     if ( ! $DEBUG ) {
Packit d0f5c2
            1 while unlink ($sfile);
Packit d0f5c2
            1 while unlink ($pfile);
Packit d0f5c2
        }
Packit d0f5c2
    }
Packit d0f5c2
}
Packit d0f5c2
Packit d0f5c2
# BOM Test
Packit d0f5c2
Packit d0f5c2
SKIP:{
Packit d0f5c2
    my $pev = PerlIO::encoding->VERSION;
Packit d0f5c2
    skip "PerlIO::encoding->VERSION = $pev <= 0.07 ", 6
Packit d0f5c2
    unless ($pev >= 0.07 or $DEBUG);
Packit d0f5c2
Packit d0f5c2
    my $file = File::Spec->catfile($dir,"jisx0208.utf");
Packit d0f5c2
    open my $fh, "<:utf8", $file or die "$file : $!";
Packit d0f5c2
    my $str = join('' => <$fh>);
Packit d0f5c2
    close $fh;
Packit d0f5c2
    my %bom = (
Packit d0f5c2
           'UTF-16BE' => pack('n', 0xFeFF),
Packit d0f5c2
           'UTF-16LE' => pack('v', 0xFeFF),
Packit d0f5c2
           'UTF-32BE' => pack('N', 0xFeFF),
Packit d0f5c2
           'UTF-32LE' => pack('V', 0xFeFF),
Packit d0f5c2
          );
Packit d0f5c2
    # reading
Packit d0f5c2
    for my $utf (sort keys %bom){
Packit d0f5c2
    my $bomed = $bom{$utf} . encode($utf, $str);
Packit d0f5c2
    my $sfile = File::Spec->catfile($dir,".${utf}_${seq}_$$");
Packit d0f5c2
    dump2file($sfile, $bomed);
Packit d0f5c2
    my $utf_nobom = $utf; $utf_nobom =~ s/(LE|BE)$//o;
Packit d0f5c2
    # reading
Packit d0f5c2
    open $fh, "<:encoding($utf_nobom)", $sfile or die "$sfile : $!";
Packit d0f5c2
    my $cmp = join '' => <$fh>;
Packit d0f5c2
    close $fh;
Packit d0f5c2
    is($str, $cmp, "<:encoding($utf_nobom) eq $utf");
Packit d0f5c2
    unlink $sfile;  $seq++;
Packit d0f5c2
    }
Packit d0f5c2
    # writing
Packit d0f5c2
    for my $utf_nobom (qw/UTF-16 UTF-32/){
Packit d0f5c2
    my $utf = $utf_nobom . 'BE';
Packit d0f5c2
    my $sfile = File::Spec->catfile($dir,".${utf_nobom}_${seq}_$$");
Packit d0f5c2
    my $bomed = $bom{$utf} . encode($utf, $str);
Packit d0f5c2
    open  $fh, ">:encoding($utf_nobom)", $sfile or die "$sfile : $!";
Packit d0f5c2
    print $fh $str;
Packit d0f5c2
    close $fh;
Packit d0f5c2
    open my $fh, "<:bytes", $sfile or die "$sfile : $!";
Packit d0f5c2
    read $fh, my $cmp, -s $sfile;
Packit d0f5c2
    close $fh;
Packit d0f5c2
    use bytes ();
Packit d0f5c2
    ok($bomed eq $cmp, ">:encoding($utf_nobom) eq $utf");
Packit d0f5c2
    unlink $sfile; $seq++;
Packit d0f5c2
    }
Packit d0f5c2
}
Packit d0f5c2
sub dump2file{
Packit d0f5c2
    no warnings;
Packit d0f5c2
    open my $fh, ">", $_[0] or die "$_[0]: $!";
Packit d0f5c2
    binmode $fh;
Packit d0f5c2
    print $fh $_[1];
Packit d0f5c2
    close $fh;
Packit d0f5c2
}