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