BEGIN {

if ($ENV{'PERL_CORE'}){

chdir 't';

unshift @INC, '../lib';

}

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, "<", $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;

}