ext/Encode/t/enc_module.t

   1 # $Id: enc_module.t,v 2.0 2004/05/16 20:55:18 dankogai Exp $
   2 # This file is in euc-jp
   3 BEGIN {
   4     require Config; import Config;
   5     if ($Config{'extensions'} !~ /\bEncode\b/) {
   6       print "1..0 # Skip: Encode was not built\n";
   7       exit 0;
   8     }
   9     unless (find PerlIO::Layer 'perlio') {
  10         print "1..0 # Skip: PerlIO was not built\n";
  11         exit 0;
  12     }
  13     if (defined ${^UNICODE} and ${^UNICODE} != 0){
  14         print "1..0 # Skip: \${^UNICODE} == ${^UNICODE}\n";
  15         exit 0;
  16     }
  17     if (ord("A") == 193) {
  18         print "1..0 # encoding pragma does not support EBCDIC platforms\n";
  19         exit(0);
  20     }
  21 }
  22 use lib qw(t ext/Encode/t ../ext/Encode/t); # latter 2 for perl core
  23 use Mod_EUCJP;
  24 use encoding "euc-jp";
  25 use Test::More tests => 3;
  26 use File::Basename;
  27 use File::Spec;
  28 use File::Compare qw(compare_text);
  29
  30 my $DEBUG = shift || 0;
  31 my $dir = dirname(__FILE__);
  32 my $file0 = File::Spec->catfile($dir,"enc_module.enc");
  33 my $file1 = File::Spec->catfile($dir,"$$.enc");
  34
  35 my $obj = Mod_EUCJP->new;
  36 local $SIG{__WARN__} = sub{ $DEBUG and print STDERR @_ };
  37 # to silence reopening STD(IN|OUT) w/o closing unless $DEBUG
  38
  39 open STDOUT, ">", $file1 or die "$file1:$!";
  40 print $obj->str, "\n";
  41 $obj->set("¥Æ¥¹¥ÈÊ¸»úÎó");
  42 print $obj->str, "\n";
  43
  44 # Please do not move this to a point after the comparison -- Craig Berry
  45 # and "unless $^O eq 'freebsd'" is needed for FreeBSD (toy-)?thread
  46 # -- dankogai
  47 close STDOUT unless $^O eq 'freebsd';
  48
  49 my $cmp = compare_text($file0, $file1);
  50 is($cmp, 0, "encoding vs. STDOUT");
  51
  52 my @cmp = qw/½é´üÊ¸»úÎó ¥Æ¥¹¥ÈÊ¸»úÎó/;
  53 open STDIN, "<", $file0 or die "$file0:$!";
  54 $obj = Mod_EUCJP->new;
  55 my $i = 0;
  56 while(<STDIN>){
  57     s/\r?\n\z//;
  58     is ($cmp[$i++], $_, "encoding vs. STDIN - $i");
  59 }
  60
  61 unlink $file1 unless $cmp;
  62 __END__
  63