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 => 22;
25 my ($fallenback, $quiet, $perlqq, $htmlcref, $xmlcref);
26 for my $i (0x20..0x7e){
29 $fallenback = $quiet =
30 $perlqq = $htmlcref = $xmlcref = $nofallback = $original;
33 for my $i (0x80..0xff){
37 $perlqq .= sprintf("\\x{%04x}", $i);
38 $htmlcref .= sprintf("&#%d;", $i);
39 $xmlcref .= sprintf("&#x%x;", $i);
41 utf8::upgrade($original);
42 my $meth = find_encoding('ascii');
45 my $dst = $meth->encode($src, FB_DEFAULT);
46 is($dst, $fallenback, "FB_DEFAULT");
47 is($src, $original, "FB_DEFAULT residue");
50 eval{ $dst = $meth->encode($src, FB_CROAK) };
51 like($@, qr/does not map to ascii/o, "FB_CROAK");
52 is($src, $original, "FB_CROAK residue");
55 eval{ $dst = $meth->encode($src, FB_CROAK) };
56 like($@, qr/does not map to ascii/o, "FB_CROAK");
57 is($src, $original, "FB_CROAK residue");
61 eval{ $dst = $meth->encode($src, FB_CROAK) };
62 is($@, '', "FB_CROAK on success");
63 is($src, '', "FB_CROAK on success residue");
66 $dst = $meth->encode($src, FB_QUIET);
67 is($dst, $quiet, "FB_QUIET");
68 is($src, $residue, "FB_QUIET residue");
72 local $SIG{__WARN__} = sub { $message = $_[0] };
74 $dst = $meth->encode($src, FB_WARN);
75 is($dst, $quiet, "FB_WARN");
76 is($src, $residue, "FB_WARN residue");
77 like($message, qr/does not map to ascii/o, "FB_WARN message");
82 $dst = $meth->encode($src, WARN_ON_ERR);
84 is($dst, $fallenback, "WARN_ON_ERR");
85 is($src, '', "WARN_ON_ERR residue");
86 like($message, qr/does not map to ascii/o, "WARN_ON_ERR message");
90 $dst = $meth->encode($src, FB_PERLQQ);
91 is($dst, $perlqq, "FB_PERLQQ");
92 is($src, '', "FB_PERLQQ residue");
95 $dst = $meth->encode($src, FB_HTMLCREF);
96 is($dst, $htmlcref, "FB_HTMLCREF");
97 is($src, '', "FB_HTMLCREF residue");
100 $dst = $meth->encode($src, FB_XMLCREF);
101 is($dst, $xmlcref, "FB_XMLCREF");
102 is($src, '', "FB_XMLCREF residue");