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";
16 eval { require PerlIO::encoding };
17 unless ($INC{"PerlIO/encoding.pm"}
18 and PerlIO::encoding->VERSION >= 0.02
20 print "1..0 # Skip:: PerlIO::encoding 0.02 or better required\n";
23 # warn "PerlIO::encoding->VERSION == ", PerlIO::encoding->VERSION, "\n";
34 #use Test::More qw(no_plan);
35 use Test::More tests => 20;
41 @ARGV and $DEBUG = shift;
42 require Encode::JP::JIS7;
43 $Encode::JP::JIS7::DEBUG = $DEBUG;
46 Encode->import(":all");
48 my $dir = dirname(__FILE__);
49 my $ufile = File::Spec->catfile($dir,"jisx0208.ref");
50 open my $fh, "<:utf8", $ufile or die "$ufile : $!";
52 my $utext = join('' => @uline);
56 for my $e (qw/euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1/){
57 my $sfile = File::Spec->catfile($dir,"$$.sio");
58 my $pfile = File::Spec->catfile($dir,"$$.pio");
60 # first create a file without perlio
61 dump2file($sfile, &encode($e, $utext, 0));
63 # then create a file via perlio without autoflush
66 skip "$e: !perlio_ok", 1 unless perlio_ok($e) or $DEBUG;
67 open $fh, ">:encoding($e)", $pfile or die "$sfile : $!";
72 unless (is(compare($sfile, $pfile), 0 => ">:encoding($e)")){
73 copy $sfile, "$sfile.$seq";
74 copy $pfile, "$pfile.$seq";
78 # this time print line by line.
79 # works even for ISO-2022!
80 open $fh, ">:encoding($e)", $pfile or die "$sfile : $!";
87 unless(is(compare($sfile, $pfile), 0
88 => ">:encoding($e); by lines")){
89 copy $sfile, "$sfile.$seq";
90 copy $pfile, "$pfile.$seq";
94 skip "$e: !perlio_ok", 2 unless perlio_ok($e) or $DEBUG;
95 open $fh, "<:encoding($e)", $pfile or die "$pfile : $!";
97 my $dtext = join('' => <$fh>);
100 unless(ok($utext eq $dtext, "<:encoding($e)")){
101 dump2file("$sfile.$seq", $utext);
102 dump2file("$pfile.$seq", $dtext);
105 open $fh, "<:encoding($e)", $pfile or die "$pfile : $!";
106 while(defined(my $l = <$fh>)) {
111 unless (ok($utext eq $dtext, "<:encoding($e); by lines")) {
112 dump2file("$sfile.$seq", $utext);
113 dump2file("$pfile.$seq", $dtext);
116 $DEBUG or unlink ($sfile, $pfile);
121 open my $fh, ">", $_[0] or die "$_[0]: $!";