Commit | Line | Data |
85982a32 |
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 | } |
982a4085 |
11 | if (ord("A") == 193) { |
d1256cb1 |
12 | print "1..0 # Skip: EBCDIC\n"; |
13 | exit 0; |
982a4085 |
14 | } |
85982a32 |
15 | $| = 1; |
16 | } |
17 | |
18 | use strict; |
19 | #use Test::More qw(no_plan); |
7828f908 |
20 | use Test::More tests => 48; |
85982a32 |
21 | use Encode q(:all); |
22 | |
f9d05ba3 |
23 | my $uo = ''; |
24 | my $nf = ''; |
8e180e82 |
25 | my ($af, $aq, $ap, $ah, $ax, $uf, $uq, $up, $uh, $ux, $ac, $uc); |
85982a32 |
26 | for my $i (0x20..0x7e){ |
f9d05ba3 |
27 | $uo .= chr($i); |
85982a32 |
28 | } |
8e180e82 |
29 | $af = $aq = $ap = $ah = $ax = $ac = |
30 | $uf = $uq = $up = $uh = $ux = $uc = |
f9d05ba3 |
31 | $nf = $uo; |
85982a32 |
32 | |
33 | my $residue = ''; |
34 | for my $i (0x80..0xff){ |
f9d05ba3 |
35 | $uo .= chr($i); |
85982a32 |
36 | $residue .= chr($i); |
f9d05ba3 |
37 | $af .= '?'; |
38 | $uf .= "\x{FFFD}"; |
39 | $ap .= sprintf("\\x{%04x}", $i); |
40 | $up .= sprintf("\\x%02X", $i); |
41 | $ah .= sprintf("&#%d;", $i); |
8e180e82 |
42 | $uh .= sprintf("\\x%02X", $i); |
f9d05ba3 |
43 | $ax .= sprintf("&#x%x;", $i); |
8e180e82 |
44 | $ux .= sprintf("\\x%02X", $i); |
45 | $ac .= sprintf("<U+%04X>", $i); |
46 | $uc .= sprintf("[%02X]", $i); |
85982a32 |
47 | } |
85982a32 |
48 | |
f9d05ba3 |
49 | my $ao = $uo; |
50 | utf8::upgrade($uo); |
85982a32 |
51 | |
f9d05ba3 |
52 | my $ascii = find_encoding('ascii'); |
53 | my $utf8 = find_encoding('utf8'); |
85982a32 |
54 | |
f9d05ba3 |
55 | my $src = $uo; |
56 | my $dst = $ascii->encode($src, FB_DEFAULT); |
57 | is($dst, $af, "FB_DEFAULT ascii"); |
58 | is($src, $uo, "FB_DEFAULT residue ascii"); |
85982a32 |
59 | |
f9d05ba3 |
60 | $src = $ao; |
61 | $dst = $utf8->decode($src, FB_DEFAULT); |
62 | is($dst, $uf, "FB_DEFAULT utf8"); |
63 | is($src, $ao, "FB_DEFAULT residue utf8"); |
85982a32 |
64 | |
f9d05ba3 |
65 | $src = $uo; |
66 | eval{ $dst = $ascii->encode($src, FB_CROAK) }; |
67 | like($@, qr/does not map to ascii/o, "FB_CROAK ascii"); |
68 | is($src, $uo, "FB_CROAK residue ascii"); |
85982a32 |
69 | |
f9d05ba3 |
70 | $src = $ao; |
71 | eval{ $dst = $utf8->decode($src, FB_CROAK) }; |
72 | like($@, qr/does not map to Unicode/o, "FB_CROAK utf8"); |
73 | is($src, $ao, "FB_CROAK residue utf8"); |
74 | |
75 | $src = $nf; |
76 | eval{ $dst = $ascii->encode($src, FB_CROAK) }; |
77 | is($@, '', "FB_CROAK on success ascii"); |
78 | is($src, '', "FB_CROAK on success residue ascii"); |
79 | |
80 | $src = $nf; |
81 | eval{ $dst = $utf8->decode($src, FB_CROAK) }; |
82 | is($@, '', "FB_CROAK on success utf8"); |
83 | is($src, '', "FB_CROAK on success residue utf8"); |
84 | |
85 | $src = $uo; |
86 | $dst = $ascii->encode($src, FB_QUIET); |
87 | is($dst, $aq, "FB_QUIET ascii"); |
88 | is($src, $residue, "FB_QUIET residue ascii"); |
89 | |
90 | $src = $ao; |
91 | $dst = $utf8->decode($src, FB_QUIET); |
92 | is($dst, $uq, "FB_QUIET utf8"); |
93 | is($src, $residue, "FB_QUIET residue utf8"); |
85982a32 |
94 | |
95 | { |
f9d05ba3 |
96 | my $message = ''; |
85982a32 |
97 | local $SIG{__WARN__} = sub { $message = $_[0] }; |
f9d05ba3 |
98 | |
99 | $src = $uo; |
100 | $dst = $ascii->encode($src, FB_WARN); |
101 | is($dst, $aq, "FB_WARN ascii"); |
102 | is($src, $residue, "FB_WARN residue ascii"); |
103 | like($message, qr/does not map to ascii/o, "FB_WARN message ascii"); |
4089adc4 |
104 | |
105 | $message = ''; |
f9d05ba3 |
106 | $src = $ao; |
107 | $dst = $utf8->decode($src, FB_WARN); |
108 | is($dst, $uq, "FB_WARN utf8"); |
109 | is($src, $residue, "FB_WARN residue utf8"); |
110 | like($message, qr/does not map to Unicode/o, "FB_WARN message utf8"); |
4089adc4 |
111 | |
f9d05ba3 |
112 | $message = ''; |
113 | $src = $uo; |
114 | $dst = $ascii->encode($src, WARN_ON_ERR); |
115 | is($dst, $af, "WARN_ON_ERR ascii"); |
116 | is($src, '', "WARN_ON_ERR residue ascii"); |
117 | like($message, qr/does not map to ascii/o, "WARN_ON_ERR message ascii"); |
4089adc4 |
118 | |
f9d05ba3 |
119 | $message = ''; |
120 | $src = $ao; |
121 | $dst = $utf8->decode($src, WARN_ON_ERR); |
122 | is($dst, $uf, "WARN_ON_ERR utf8"); |
123 | is($src, '', "WARN_ON_ERR residue utf8"); |
124 | like($message, qr/does not map to Unicode/o, "WARN_ON_ERR message ascii"); |
85982a32 |
125 | } |
126 | |
f9d05ba3 |
127 | $src = $uo; |
128 | $dst = $ascii->encode($src, FB_PERLQQ); |
8e180e82 |
129 | is($dst, $ap, "FB_PERLQQ encode"); |
130 | is($src, $uo, "FB_PERLQQ residue encode"); |
f9d05ba3 |
131 | |
132 | $src = $ao; |
8e180e82 |
133 | $dst = $ascii->decode($src, FB_PERLQQ); |
134 | is($dst, $up, "FB_PERLQQ decode"); |
135 | is($src, $ao, "FB_PERLQQ residue decode"); |
f9d05ba3 |
136 | |
137 | $src = $uo; |
138 | $dst = $ascii->encode($src, FB_HTMLCREF); |
8e180e82 |
139 | is($dst, $ah, "FB_HTMLCREF encode"); |
140 | is($src, $uo, "FB_HTMLCREF residue encode"); |
f9d05ba3 |
141 | |
78589665 |
142 | $src = $ao; |
8e180e82 |
143 | $dst = $ascii->decode($src, FB_HTMLCREF); |
144 | is($dst, $uh, "FB_HTMLCREF decode"); |
145 | is($src, $ao, "FB_HTMLCREF residue decode"); |
f9d05ba3 |
146 | |
147 | $src = $uo; |
148 | $dst = $ascii->encode($src, FB_XMLCREF); |
8e180e82 |
149 | is($dst, $ax, "FB_XMLCREF encode"); |
150 | is($src, $uo, "FB_XMLCREF residue encode"); |
f9d05ba3 |
151 | |
78589665 |
152 | $src = $ao; |
8e180e82 |
153 | $dst = $ascii->decode($src, FB_XMLCREF); |
154 | is($dst, $ux, "FB_XMLCREF decode"); |
155 | is($src, $ao, "FB_XMLCREF residue decode"); |
156 | |
157 | $src = $uo; |
158 | $dst = $ascii->encode($src, sub{ sprintf "<U+%04X>", shift }); |
159 | is($dst, $ac, "coderef encode"); |
160 | is($src, $uo, "coderef residue encode"); |
161 | |
162 | $src = $ao; |
163 | $dst = $ascii->decode($src, sub{ sprintf "[%02X]", shift }); |
164 | is($dst, $uc, "coderef decode"); |
165 | is($src, $ao, "coderef residue decode"); |
7828f908 |
166 | |
167 | $src = "\x{3000}"; |
168 | $dst = $ascii->encode($src, sub{ $_[0] }); |
169 | is $dst, 0x3000."", qq{$ascii->encode(\$src, sub{ \$_[0] } )}; |
170 | $dst = encode("ascii", "\x{3000}", sub{ $_[0] }); |
171 | is $dst, 0x3000."", qq{encode("ascii", "\\x{3000}", sub{ \$_[0] })}; |
172 | |
173 | $src = pack "C*", 0xFF; |
174 | $dst = $ascii->decode($src, sub{ $_[0] }); |
175 | is $dst, 0xFF."", qq{$ascii->encode(\$src, sub{ \$_[0] } )}; |
176 | $dst = decode("ascii", (pack "C*", 0xFF), sub{ $_[0] }); |
177 | is $dst, 0xFF."", qq{decode("ascii", (pack "C*", 0xFF), sub{ \$_[0] })}; |