2 if ($ENV{'PERL_CORE'}){
4 unshift @INC, '../lib';
6 require Config; import Config;
7 if ($Config{'extensions'} !~ /\bEncode\b/) {
8 print "1..0 # Skip: Encode was not built\n";
11 if (ord("A") == 193) {
12 print "1..0 # Skip: EBCDIC\n";
15 unless (PerlIO::Layer->find('perlio')){
16 print "1..0 # Skip: PerlIO required\n";
25 use File::Compare qw(compare_text);
29 #use Test::More qw(no_plan);
30 use Test::More tests => 38;
37 @ARGV and $DEBUG = shift;
38 #require Encode::JP::JIS7;
39 #require Encode::KR::2022_KR;
40 #$Encode::JP::JIS7::DEBUG = $DEBUG;
44 my $dir = dirname(__FILE__);
48 jisx0208 => [ qw/euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1/],
49 ksc5601 => [ qw/euc-kr/],
50 gb2312 => [ qw/euc-cn hz/],
53 $/ = "\x0a"; # may fix VMS problem for test #28 and #29
55 for my $src (sort keys %e) {
56 my $ufile = File::Spec->catfile($dir,"$src.utf");
57 open my $fh, "<:utf8", $ufile or die "$ufile : $!";
59 my $utext = join('' => @uline);
62 for my $e (@{$e{$src}}){
63 my $sfile = File::Spec->catfile($dir,"$$.sio");
64 my $pfile = File::Spec->catfile($dir,"$$.pio");
66 # first create a file without perlio
67 dump2file($sfile, &encode($e, $utext, 0));
69 # then create a file via perlio without autoflush
72 skip "$e: !perlio_ok", 4 unless (perlio_ok($e) or $DEBUG);
73 no warnings 'uninitialized';
74 open $fh, ">:encoding($e)", $pfile or die "$sfile : $!";
79 is(compare_text($sfile, $pfile), 0 => ">:encoding($e)");
81 copy $sfile, "$sfile.$seq";
82 copy $pfile, "$pfile.$seq";
85 # this time print line by line.
86 # works even for ISO-2022 but not ISO-2022-KR
87 open $fh, ">:encoding($e)", $pfile or die "$sfile : $!";
94 is(compare_text($sfile, $pfile), 0 => ">:encoding($e) by lines");
96 copy $sfile, "$sfile.$seq";
97 copy $pfile, "$pfile.$seq";
100 open $fh, "<:encoding($e)", $pfile or die "$pfile : $!";
102 $dtext = join('' => <$fh>);
105 ok($utext eq $dtext, "<:encoding($e)");
107 dump2file("$sfile.$seq", $utext);
108 dump2file("$pfile.$seq", $dtext);
110 if (perlio_ok($e) or $DEBUG){
112 open $fh, "<:encoding($e)", $pfile or die "$pfile : $!";
113 while(defined(my $l = <$fh>)) {
119 ok($utext eq $dtext, "<:encoding($e) by lines");
121 dump2file("$sfile.$seq", $utext);
122 dump2file("$pfile.$seq", $dtext);
126 1 while unlink ($sfile);
127 1 while unlink ($pfile);
135 my $pev = PerlIO::encoding->VERSION;
136 skip "PerlIO::encoding->VERSION = $pev <= 0.07 ", 6
137 unless ($pev >= 0.07 or $DEBUG);
139 my $file = File::Spec->catfile($dir,"jisx0208.utf");
140 open my $fh, "<:utf8", $file or die "$file : $!";
141 my $str = join('' => <$fh>);
144 'UTF-16BE' => pack('n', 0xFeFF),
145 'UTF-16LE' => pack('v', 0xFeFF),
146 'UTF-32BE' => pack('N', 0xFeFF),
147 'UTF-32LE' => pack('V', 0xFeFF),
150 for my $utf (sort keys %bom){
151 my $bomed = $bom{$utf} . encode($utf, $str);
152 my $sfile = File::Spec->catfile($dir,".${utf}_${seq}_$$");
153 dump2file($sfile, $bomed);
154 my $utf_nobom = $utf; $utf_nobom =~ s/(LE|BE)$//o;
156 open $fh, "<:encoding($utf_nobom)", $sfile or die "$sfile : $!";
157 my $cmp = join '' => <$fh>;
159 is($str, $cmp, "<:encoding($utf_nobom) eq $utf");
160 unlink $sfile; $seq++;
163 for my $utf_nobom (qw/UTF-16 UTF-32/){
164 my $utf = $utf_nobom . 'BE';
165 my $sfile = File::Spec->catfile($dir,".${utf_nobom}_${seq}_$$");
166 my $bomed = $bom{$utf} . encode($utf, $str);
167 open $fh, ">:encoding($utf_nobom)", $sfile or die "$sfile : $!";
170 open my $fh, "<", $sfile or die "$sfile : $!";
171 read $fh, my $cmp, -s $sfile;
174 ok($bomed eq $cmp, ">:encoding($utf_nobom) eq $utf");
175 unlink $sfile; $seq++;
180 open my $fh, ">", $_[0] or die "$_[0]: $!";