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) { |
12 | print "1..0 # Skip: EBCDIC\n"; |
13 | exit 0; |
14 | } |
85982a32 |
15 | $| = 1; |
16 | } |
17 | |
18 | use strict; |
19 | #use Test::More qw(no_plan); |
78589665 |
20 | use Test::More tests => 40; |
85982a32 |
21 | use Encode q(:all); |
22 | |
f9d05ba3 |
23 | my $uo = ''; |
24 | my $nf = ''; |
25 | my ($af, $aq, $ap, $ah, $ax, $uf, $uq, $up, $uh, $ux); |
85982a32 |
26 | for my $i (0x20..0x7e){ |
f9d05ba3 |
27 | $uo .= chr($i); |
85982a32 |
28 | } |
f9d05ba3 |
29 | $af = $aq = $ap = $ah = $ax = |
30 | $uf = $uq = $up = $uh = $ux = |
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); |
42 | $uh .= sprintf("&#%d;", $i); |
43 | $ax .= sprintf("&#x%x;", $i); |
44 | $ux .= sprintf("&#x%x;", $i); |
85982a32 |
45 | } |
85982a32 |
46 | |
f9d05ba3 |
47 | my $ao = $uo; |
48 | utf8::upgrade($uo); |
85982a32 |
49 | |
f9d05ba3 |
50 | my $ascii = find_encoding('ascii'); |
51 | my $utf8 = find_encoding('utf8'); |
85982a32 |
52 | |
f9d05ba3 |
53 | my $src = $uo; |
54 | my $dst = $ascii->encode($src, FB_DEFAULT); |
55 | is($dst, $af, "FB_DEFAULT ascii"); |
56 | is($src, $uo, "FB_DEFAULT residue ascii"); |
85982a32 |
57 | |
f9d05ba3 |
58 | $src = $ao; |
59 | $dst = $utf8->decode($src, FB_DEFAULT); |
60 | is($dst, $uf, "FB_DEFAULT utf8"); |
61 | is($src, $ao, "FB_DEFAULT residue utf8"); |
85982a32 |
62 | |
f9d05ba3 |
63 | $src = $uo; |
64 | eval{ $dst = $ascii->encode($src, FB_CROAK) }; |
65 | like($@, qr/does not map to ascii/o, "FB_CROAK ascii"); |
66 | is($src, $uo, "FB_CROAK residue ascii"); |
85982a32 |
67 | |
f9d05ba3 |
68 | $src = $ao; |
69 | eval{ $dst = $utf8->decode($src, FB_CROAK) }; |
70 | like($@, qr/does not map to Unicode/o, "FB_CROAK utf8"); |
71 | is($src, $ao, "FB_CROAK residue utf8"); |
72 | |
73 | $src = $nf; |
74 | eval{ $dst = $ascii->encode($src, FB_CROAK) }; |
75 | is($@, '', "FB_CROAK on success ascii"); |
76 | is($src, '', "FB_CROAK on success residue ascii"); |
77 | |
78 | $src = $nf; |
79 | eval{ $dst = $utf8->decode($src, FB_CROAK) }; |
80 | is($@, '', "FB_CROAK on success utf8"); |
81 | is($src, '', "FB_CROAK on success residue utf8"); |
82 | |
83 | $src = $uo; |
84 | $dst = $ascii->encode($src, FB_QUIET); |
85 | is($dst, $aq, "FB_QUIET ascii"); |
86 | is($src, $residue, "FB_QUIET residue ascii"); |
87 | |
88 | $src = $ao; |
89 | $dst = $utf8->decode($src, FB_QUIET); |
90 | is($dst, $uq, "FB_QUIET utf8"); |
91 | is($src, $residue, "FB_QUIET residue utf8"); |
85982a32 |
92 | |
93 | { |
f9d05ba3 |
94 | my $message = ''; |
85982a32 |
95 | local $SIG{__WARN__} = sub { $message = $_[0] }; |
f9d05ba3 |
96 | |
97 | $src = $uo; |
98 | $dst = $ascii->encode($src, FB_WARN); |
99 | is($dst, $aq, "FB_WARN ascii"); |
100 | is($src, $residue, "FB_WARN residue ascii"); |
101 | like($message, qr/does not map to ascii/o, "FB_WARN message ascii"); |
4089adc4 |
102 | |
103 | $message = ''; |
f9d05ba3 |
104 | $src = $ao; |
105 | $dst = $utf8->decode($src, FB_WARN); |
106 | is($dst, $uq, "FB_WARN utf8"); |
107 | is($src, $residue, "FB_WARN residue utf8"); |
108 | like($message, qr/does not map to Unicode/o, "FB_WARN message utf8"); |
4089adc4 |
109 | |
f9d05ba3 |
110 | $message = ''; |
111 | $src = $uo; |
112 | $dst = $ascii->encode($src, WARN_ON_ERR); |
113 | is($dst, $af, "WARN_ON_ERR ascii"); |
114 | is($src, '', "WARN_ON_ERR residue ascii"); |
115 | like($message, qr/does not map to ascii/o, "WARN_ON_ERR message ascii"); |
4089adc4 |
116 | |
f9d05ba3 |
117 | $message = ''; |
118 | $src = $ao; |
119 | $dst = $utf8->decode($src, WARN_ON_ERR); |
120 | is($dst, $uf, "WARN_ON_ERR utf8"); |
121 | is($src, '', "WARN_ON_ERR residue utf8"); |
122 | like($message, qr/does not map to Unicode/o, "WARN_ON_ERR message ascii"); |
85982a32 |
123 | } |
124 | |
f9d05ba3 |
125 | $src = $uo; |
126 | $dst = $ascii->encode($src, FB_PERLQQ); |
127 | is($dst, $ap, "FB_PERLQQ ascii"); |
128 | is($src, '', "FB_PERLQQ residue ascii"); |
129 | |
130 | $src = $ao; |
131 | $dst = $utf8->decode($src, FB_PERLQQ); |
132 | is($dst, $up, "FB_PERLQQ utf8"); |
133 | is($src, '', "FB_PERLQQ residue utf8"); |
134 | |
135 | $src = $uo; |
136 | $dst = $ascii->encode($src, FB_HTMLCREF); |
137 | is($dst, $ah, "FB_HTMLCREF ascii"); |
138 | is($src, '', "FB_HTMLCREF residue ascii"); |
139 | |
78589665 |
140 | $src = $ao; |
141 | $dst = $utf8->decode($src, FB_HTMLCREF); |
142 | is($dst, $uh, "FB_HTMLCREF utf8"); |
143 | is($src, '', "FB_HTMLCREF residue utf8"); |
f9d05ba3 |
144 | |
145 | $src = $uo; |
146 | $dst = $ascii->encode($src, FB_XMLCREF); |
147 | is($dst, $ax, "FB_XMLCREF ascii"); |
148 | is($src, '', "FB_XMLCREF residue ascii"); |
149 | |
78589665 |
150 | $src = $ao; |
151 | $dst = $utf8->decode($src, FB_XMLCREF); |
152 | is($dst, $ax, "FB_XMLCREF utf8"); |
153 | is($src, '', "FB_XMLCREF residue utf8"); |