view release on metacpan or  search on metacpan

t/jis.t  view on Meta::CPAN

## ----------------------------------------------------------------------------
# t/jis.t
# -----------------------------------------------------------------------------
# $Id: jis.t 4635 2006-06-14 07:13:04Z hio $
# -----------------------------------------------------------------------------

use strict;
use Test;
BEGIN { plan tests => 20, };

# -----------------------------------------------------------------------------
# load module

use Unicode::Japanese;
use lib 't';
require 'esc.pl';
my $xs = Unicode::Japanese->new();
my $pp = Unicode::Japanese::PurePerl->new();
sub jisToUtf8_xs($){ tt($xs->set($_[0],'jis')->utf8()); }
sub jisToUtf8_pp($){ tt($pp->set($_[0],'jis')->utf8()); }
sub jisToSjis_xs($){ tt($xs->set($_[0],'jis')->sjis()); }
sub jisToSjis_pp($){ tt($pp->set($_[0],'jis')->sjis()); }
sub jisToJis_xs($){ tt($xs->set($_[0],'jis')->jis()); }
sub jisToJis_pp($){ tt($pp->set($_[0],'jis')->jis()); }
sub tt($){ escfull($_[0]) }
sub bin($){ escfull(pack("H*",join('',split(' ',$_[0])))); }

{
  # ASCII : \e(B 
  #
  my $test = "\e(B123ABC\e(B123";
  my $correct = tt("123ABC123");
  ok(jisToUtf8_xs($test),$correct,"escape to ASCII (xs)");
  ok(jisToUtf8_pp($test),$correct,"escape to ASCII (pp)");
}

{
  # jis.roman : \e(J
  #
  my $test = "\e(J123ABC\e(B123";
  my $correct = tt("123ABC123");
  ok(jisToUtf8_xs($test),$correct,"escape to jis.roman (xs)");
  ok(jisToUtf8_pp($test),$correct,"escape to jis.roman (pp)");
}

{
  # jis.kana : \e(I
  #
  my $test = "\e(I123ABC\e(B123";
  my $correct_utf8 = bin("ef bd b1 ef bd b2 ef bd b3 ef be 81 ef be 82 ef be 83 31 32 33");
  my $correct_sjis = bin("b1 b2 b3 c1 c2 c3 31 32 33");
  ok(jisToSjis_xs($test),$correct_sjis,"escape to jis.kana (xs/sjis)");
  ok(jisToSjis_pp($test),$correct_sjis,"escape to jis.kana (pp/sjis)");
  ok(jisToUtf8_xs($test),$correct_utf8,"escape to jis.kana (xs/utf8)");
  ok(jisToUtf8_pp($test),$correct_utf8,"escape to jis.kana (pp/utf8)");
}
{
  # jis.kana(so/si)
  #
  my $test = "\x0e123ABC\x0f123";
  my $correct = bin("ef bd b1 ef bd b2 ef bd b3 ef be 81 ef be 82 ef be 83 31 32 33");
  #skip("so/si not supported yet",jisToUtf8_xs($test),$correct,"escape to jis.roman (xs)");
  #skip("so/si not supported yet",jisToUtf8_pp($test),$correct,"escape to jis.roman (pp)");
}

{
  # jis-c-6226-1979(old-JIS) : \e$@
  # jis-x-0208-1983(new-JIS) : \e$B
  # jis-x-0208-1990 : \e&@\e$B
  my $test_old_jis = "\e\$\@!!\e(B";
  my $test_new_jis = "\e\$B!!\e(B";
  my $test_jis1990 = "\e&\@\e\$B!!\e(B";
  my $correct = tt("\x81\x40");
  ok(jisToSjis_xs($test_old_jis),$correct,"old-jis to sjis (xs)");
  ok(jisToSjis_pp($test_old_jis),$correct,"old-jis to sjis (pp)");
  ok(jisToSjis_xs($test_new_jis),$correct,"new-jis to sjis (xs)");
  ok(jisToSjis_pp($test_new_jis),$correct,"new-jis to sjis (pp)");
  ok(jisToSjis_xs($test_jis1990),$correct,"jis1990 to sjis (xs)");
  ok(jisToSjis_pp($test_jis1990),$correct,"jis1990 to sjis (pp)");
}

{
  # jis-x-0212-1990: \e$(D
  #skip("jis-x-0212 not ready");
  #skip("jis-x-0212 not ready");