|
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 |
}
|