xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/t/uni/tr_utf8.t (revision 0:68f95e015346)
1#
2# $Id$
3#
4# This script is written intentionally in UTF-8
5# Requires Encode 1.83 or better
6# -- dankogai
7
8BEGIN {
9    if ($ENV{'PERL_CORE'}){
10        chdir 't';
11        unshift @INC, '../lib';
12    }
13    require Config; import Config;
14    if ($Config{'extensions'} !~ /\bEncode\b/) {
15      print "1..0 # Skip: Encode was not built\n";
16      exit 0;
17    }
18    if (ord("A") == 193) {
19        print "1..0 # Skip: EBCDIC\n";
20        exit 0;
21    }
22    unless (PerlIO::Layer->find('perlio')){
23        print "1..0 # Skip: PerlIO required\n";
24        exit 0;
25    }
26    if ($ENV{PERL_CORE_MINITEST}) {
27        print "1..0 # Skip: no dynamic loading on miniperl, no Encode\n";
28        exit 0;
29    }
30    $| = 1;
31}
32
33use strict;
34#use Test::More qw(no_plan);
35use Test::More tests => 7;
36
37use encoding 'utf8';
38
39my @hiragana =  map {chr} ord("ぁ")..ord("ん");
40my @katakana =  map {chr} ord("ァ")..ord("ン");
41my $hiragana = join('' => @hiragana);
42my $katakana = join('' => @katakana);
43my %h2k; @h2k{@hiragana} = @katakana;
44my %k2h; @k2h{@katakana} = @hiragana;
45
46# print @hiragana, "\n";
47
48my $str;
49
50$str = $hiragana; $str =~ tr/ぁ-ん/ァ-ン/;
51is($str, $katakana, "tr// # hiragana -> katakana");
52$str = $katakana; $str =~ tr/ァ-ン/ぁ-ん/;
53is($str, $hiragana, "tr// # hiragana -> katakana");
54
55$str = $hiragana; eval qq(\$str =~ tr/ぁ-ん/ァ-ン/);
56is($str, $katakana, "eval qq(tr//) # hiragana -> katakana");
57$str = $katakana; eval qq(\$str =~ tr/ァ-ン/ぁ-ん/);
58is($str, $hiragana, "eval qq(tr//) # hiragana -> katakana");
59
60$str = $hiragana; $str =~ s/([ぁ-ん])/$h2k{$1}/go;
61is($str, $katakana, "s/// # hiragana -> katakana");
62$str = $katakana; $str =~ s/([ァ-ン])/$k2h{$1}/go;
63is($str, $hiragana, "s/// # hiragana -> katakana");
64
65{
66  # [perl 16843]
67  my $line = 'abcdefghijklmnopqrstuvwxyz$0123456789';
68  $line =~ tr/bcdeghijklmnprstvwxyz$02578/בצדעגהיײקלמנפּרסטװשכיזשױתײחא/;
69  is($line, "aבצדעfגהיײקלמנoפqּרסuטװשכיזש1ױ34ת6ײח9", "[perl #16843]");
70}
71__END__
72