2 if ($ENV{'PERL_CORE'}){
4 unshift @INC, '../lib';
6 require Config; import Config;
7 if ($Config{'extensions'} !~ /\bEncode\b/) {
8 print "1..0 # Skip: Encode was not built\n";
11 if (ord("A") == 193) {
12 print "1..0 # Skip: EBCDIC\n";
19 #use Test::More qw(no_plan);
20 use Test::More tests => 40;
25 my ($af, $aq, $ap, $ah, $ax, $uf, $uq, $up, $uh, $ux);
26 for my $i (0x20..0x7e){
29 $af = $aq = $ap = $ah = $ax =
30 $uf = $uq = $up = $uh = $ux =
34 for my $i (0x80..0xff){
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);
50 my $ascii = find_encoding('ascii');
51 my $utf8 = find_encoding('utf8');
54 my $dst = $ascii->encode($src, FB_DEFAULT);
55 is($dst, $af, "FB_DEFAULT ascii");
56 is($src, $uo, "FB_DEFAULT residue ascii");
59 $dst = $utf8->decode($src, FB_DEFAULT);
60 is($dst, $uf, "FB_DEFAULT utf8");
61 is($src, $ao, "FB_DEFAULT residue utf8");
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");
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");
74 eval{ $dst = $ascii->encode($src, FB_CROAK) };
75 is($@, '', "FB_CROAK on success ascii");
76 is($src, '', "FB_CROAK on success residue ascii");
79 eval{ $dst = $utf8->decode($src, FB_CROAK) };
80 is($@, '', "FB_CROAK on success utf8");
81 is($src, '', "FB_CROAK on success residue utf8");
84 $dst = $ascii->encode($src, FB_QUIET);
85 is($dst, $aq, "FB_QUIET ascii");
86 is($src, $residue, "FB_QUIET residue ascii");
89 $dst = $utf8->decode($src, FB_QUIET);
90 is($dst, $uq, "FB_QUIET utf8");
91 is($src, $residue, "FB_QUIET residue utf8");
95 local $SIG{__WARN__} = sub { $message = $_[0] };
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");
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");
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");
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");
126 $dst = $ascii->encode($src, FB_PERLQQ);
127 is($dst, $ap, "FB_PERLQQ ascii");
128 is($src, $uo, "FB_PERLQQ residue ascii");
131 $dst = $utf8->decode($src, FB_PERLQQ);
132 is($dst, $up, "FB_PERLQQ utf8");
133 is($src, $ao, "FB_PERLQQ residue utf8");
136 $dst = $ascii->encode($src, FB_HTMLCREF);
137 is($dst, $ah, "FB_HTMLCREF ascii");
138 is($src, $uo, "FB_HTMLCREF residue ascii");
141 $dst = $utf8->decode($src, FB_HTMLCREF);
142 is($dst, $uh, "FB_HTMLCREF utf8");
143 is($src, $ao, "FB_HTMLCREF residue utf8");
146 $dst = $ascii->encode($src, FB_XMLCREF);
147 is($dst, $ax, "FB_XMLCREF ascii");
148 is($src, $uo, "FB_XMLCREF residue ascii");
151 $dst = $utf8->decode($src, FB_XMLCREF);
152 is($dst, $ax, "FB_XMLCREF utf8");
153 is($src, $ao, "FB_XMLCREF residue utf8");