1
2BEGIN {
3    if ($ENV{PERL_CORE}) {
4        chdir('t') if -d 't';
5        @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
6    }
7}
8
9BEGIN {
10    unless (5.006001 <= $]) {
11	print "1..0 # skipped: Perl 5.6.1 or later".
12		" needed for this test\n";
13	exit;
14    }
15}
16
17#########################
18
19use strict;
20use warnings;
21BEGIN { $| = 1; print "1..34\n"; }
22my $count = 0;
23sub ok { Unicode::Normalize::ok(\$count, @_) }
24
25use Unicode::Normalize qw(:all);
26
27ok(1);
28
29sub _pack_U   { Unicode::Normalize::dot_t_pack_U(@_) }
30sub _unpack_U { Unicode::Normalize::dot_t_unpack_U(@_) }
31
32#########################
33
34our $proc;    # before the last starter
35our $unproc;  # the last starter and after
36# If string has no starter, entire string is set to $unproc.
37
38($proc, $unproc) = splitOnLastStarter("");
39ok($proc,   "");
40ok($unproc, "");
41
42($proc, $unproc) = splitOnLastStarter("A");
43ok($proc,   "");
44ok($unproc, "A");
45
46($proc, $unproc) = splitOnLastStarter(_pack_U(0x41, 0x300, 0x327, 0x42));
47ok($proc,   _pack_U(0x41, 0x300, 0x327));
48ok($unproc, "B");
49
50($proc, $unproc) = splitOnLastStarter(_pack_U(0x4E00, 0x41, 0x301));
51ok($proc,   _pack_U(0x4E00));
52ok($unproc, _pack_U(0x41, 0x301));
53
54($proc, $unproc) = splitOnLastStarter(_pack_U(0x302, 0x301, 0x300));
55ok($proc,   "");
56ok($unproc, _pack_U(0x302, 0x301, 0x300));
57
58our $ka_grave = _pack_U(0x41, 0, 0x42, 0x304B, 0x300);
59our $dakuten  = _pack_U(0x3099);
60our $ga_grave = _pack_U(0x41, 0, 0x42, 0x304C, 0x300);
61
62our ($p, $u) = splitOnLastStarter($ka_grave);
63our $concat = $p . NFC($u.$dakuten);
64
65ok(NFC($ka_grave.$dakuten) eq $ga_grave);
66ok(NFC($ka_grave).NFC($dakuten) ne $ga_grave);
67ok($concat eq $ga_grave);
68
69# 14
70
71sub arraynorm {
72    my $form   = shift;
73    my @string = @_;
74    my $result = "";
75    my $unproc = "";
76    foreach my $str (@string) {
77        $unproc .= $str;
78        my $n = normalize($form, $unproc);
79        my($p, $u) = splitOnLastStarter($n);
80        $result .= $p;
81        $unproc  = $u;
82    }
83    $result .= $unproc;
84    return $result;
85}
86
87my $strD = "\x{3C9}\x{301}\x{1100}\x{1161}\x{11A8}\x{1100}\x{1161}\x{11AA}";
88my $strC = "\x{3CE}\x{AC01}\x{AC03}";
89my @str1 = (substr($strD,0,3), substr($strD,3,4), substr($strD,7));
90my @str2 = (substr($strD,0,1), substr($strD,1,3), substr($strD,4));
91ok($strC eq NFC($strD));
92ok($strD eq join('', @str1));
93ok($strC eq arraynorm('NFC', @str1));
94ok($strD eq join('', @str2));
95ok($strC eq arraynorm('NFC', @str2));
96
97my @strX = ("\x{300}\x{AC00}", "\x{11A8}");
98my $strX =  "\x{300}\x{AC01}";
99ok($strX eq NFC(join('', @strX)));
100ok($strX eq arraynorm('NFC', @strX));
101ok($strX eq NFKC(join('', @strX)));
102ok($strX eq arraynorm('NFKC', @strX));
103
104my @strY = ("\x{304B}\x{0308}", "\x{0323}\x{3099}");
105my $strY = ("\x{304C}\x{0323}\x{0308}");
106ok($strY eq NFC(join('', @strY)));
107ok($strY eq arraynorm('NFC', @strY));
108ok($strY eq NFKC(join('', @strY)));
109ok($strY eq arraynorm('NFKC', @strY));
110
111my @strZ = ("\x{304B}\x{0308}", "\x{0323}", "\x{3099}");
112my $strZ = ("\x{304B}\x{3099}\x{0323}\x{0308}");
113ok($strZ eq NFD(join('', @strZ)));
114ok($strZ eq arraynorm('NFD', @strZ));
115ok($strZ eq NFKD(join('', @strZ)));
116ok($strZ eq arraynorm('NFKD', @strZ));
117
118# 31
119
120# don't modify the source
121
122my $source = "ABC";
123($proc, $unproc) = splitOnLastStarter($source);
124ok($proc,   "AB");
125ok($unproc, "C");
126ok($source, "ABC");
127
128# 34
129
130