ext/Encode/t/perlio.t

   1 BEGIN {
   2     if ($ENV{'PERL_CORE'}){
   3         chdir 't';
   4         unshift @INC, '../lib';
   5     }
   6     require Config; import Config;
   7     if ($Config{'extensions'} !~ /\bEncode\b/) {
   8       print "1..0 # Skip: Encode was not built\n";
   9       exit 0;
  10     }
  11     if (ord("A") == 193) {
  12         print "1..0 # Skip: EBCDIC\n";
  13         exit 0;
  14     }
  15     require Encode;
  16     unless ($INC{"PerlIO/encoding.pm"}
  17             and PerlIO::encoding->VERSION >= 0.02
  18            ){
  19         print "1..0 # Skip:: PerlIO::encoding 0.02 or better required\n";
  20         exit 0;
  21     }
  22     # warn "PerlIO::encoding->VERSION == ", PerlIO::encoding->VERSION, "\n";
  23     $| = 1;
  24 }
  25
  26 use strict;
  27 use File::Basename;
  28 use File::Spec;
  29 use File::Compare;
  30 use FileHandle;
  31
  32 #use Test::More qw(no_plan);
  33 use Test::More tests => 20;
  34
  35 our $DEBUG = 0;
  36
  37 {
  38     no warnings;
  39     @ARGV and $DEBUG = shift;
  40     require Encode::JP::JIS7;
  41     $Encode::JP::JIS7::DEBUG = $DEBUG;
  42 }
  43
  44 Encode->import(":all");
  45
  46 my $dir = dirname(__FILE__);
  47 my $ufile = File::Spec->catfile($dir,"jisx0208.ref");
  48 open my $fh, "<:utf8", $ufile or die "$ufile : $!";
  49 my @uline = <$fh>;
  50 my $utext = join('' => @uline);
  51 close $fh;
  52
  53 for my $e (qw/euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1/){
  54     my $sfile = File::Spec->catfile($dir,"$$.sio");
  55     my $pfile = File::Spec->catfile($dir,"$$.pio");
  56
  57     # first create a file without perlio
  58     open $fh, ">", $sfile or die "$sfile :$!";
  59     binmode $fh;
  60     print $fh &encode($e, $utext, 0);
  61     close $fh;
  62
  63     # then create a file via perlio without autoflush
  64
  65  TODO:{
  66         todo_skip "$e: !perlio_ok", 1  unless perlio_ok($e);
  67         open $fh, ">:encoding($e)", $pfile or die "$sfile : $!";
  68         $fh->autoflush(0);
  69         print $fh $utext;
  70         close $fh;
  71         ok(compare($sfile, $pfile) == 0 => ">:encoding($e)");
  72     }
  73
  74     # this time print line by line.
  75     # works even for ISO-2022!
  76     open $fh, ">:encoding($e)", $pfile or die "$sfile : $!";
  77     $fh->autoflush(1);
  78     for my $l (@uline) {
  79         print $fh $l;
  80     }
  81     close $fh;
  82     is(compare($sfile, $pfile), 0 => ">:encoding($e); line-by-line");
  83
  84  TODO:{
  85         todo_skip "$e: !perlio_ok", 2 unless perlio_ok($e);
  86         open $fh, "<:encoding($e)", $pfile or die "$pfile : $!";
  87         $fh->autoflush(0);
  88         my $dtext = join('' => <$fh>);
  89         close $fh;
  90         ok($utext eq $dtext, "<:encoding($e)");
  91         $dtext = '';
  92         open $fh, "<:encoding($e)", $pfile or die "$pfile : $!";
  93         while(defined(my $l = <$fh>)) {
  94             $dtext .= $l;
  95         }
  96         close $fh;
  97         ok($utext eq $dtext, "<:encoding($e); line-by-line");
  98     }
  99     $DEBUG or unlink ($sfile, $pfile);
 100 }
 101