Commit | Line | Data |
---|---|---|
85982a32 JH |
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 JH |
11 | if (ord("A") == 193) { |
12 | print "1..0 # Skip: EBCDIC\n"; | |
13 | exit 0; | |
14 | } | |
85982a32 JH |
15 | $| = 1; |
16 | } | |
17 | ||
18 | use strict; | |
19 | #use Test::More qw(no_plan); | |
4089adc4 | 20 | use Test::More tests => 22; |
85982a32 JH |
21 | use Encode q(:all); |
22 | ||
85982a32 JH |
23 | my $original = ''; |
24 | my $nofallback = ''; | |
af1f55d9 | 25 | my ($fallenback, $quiet, $perlqq, $htmlcref, $xmlcref); |
85982a32 JH |
26 | for my $i (0x20..0x7e){ |
27 | $original .= chr($i); | |
28 | } | |
af1f55d9 JH |
29 | $fallenback = $quiet = |
30 | $perlqq = $htmlcref = $xmlcref = $nofallback = $original; | |
85982a32 JH |
31 | |
32 | my $residue = ''; | |
33 | for my $i (0x80..0xff){ | |
34 | $original .= chr($i); | |
35 | $residue .= chr($i); | |
36 | $fallenback .= '?'; | |
37 | $perlqq .= sprintf("\\x{%04x}", $i); | |
af1f55d9 JH |
38 | $htmlcref .= sprintf("&#%d;", $i); |
39 | $xmlcref .= sprintf("&#x%x;", $i); | |
85982a32 JH |
40 | } |
41 | utf8::upgrade($original); | |
42 | my $meth = find_encoding('ascii'); | |
43 | ||
44 | my $src = $original; | |
45 | my $dst = $meth->encode($src, FB_DEFAULT); | |
46 | is($dst, $fallenback, "FB_DEFAULT"); | |
47 | is($src, $original, "FB_DEFAULT residue"); | |
48 | ||
49 | $src = $original; | |
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"); | |
53 | ||
54 | $src = $original; | |
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"); | |
58 | ||
59 | ||
60 | $src = $nofallback; | |
61 | eval{ $dst = $meth->encode($src, FB_CROAK) }; | |
62 | is($@, '', "FB_CROAK on success"); | |
63 | is($src, '', "FB_CROAK on success residue"); | |
64 | ||
65 | $src = $original; | |
66 | $dst = $meth->encode($src, FB_QUIET); | |
67 | is($dst, $quiet, "FB_QUIET"); | |
68 | is($src, $residue, "FB_QUIET residue"); | |
69 | ||
70 | { | |
71 | my $message; | |
72 | local $SIG{__WARN__} = sub { $message = $_[0] }; | |
73 | $src = $original; | |
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"); | |
4089adc4 JH |
78 | |
79 | $message = ''; | |
80 | ||
81 | $src = $original; | |
82 | $dst = $meth->encode($src, WARN_ON_ERR); | |
83 | ||
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"); | |
85982a32 JH |
87 | } |
88 | ||
89 | $src = $original; | |
90 | $dst = $meth->encode($src, FB_PERLQQ); | |
91 | is($dst, $perlqq, "FB_PERLQQ"); | |
92 | is($src, '', "FB_PERLQQ residue"); | |
af1f55d9 JH |
93 | |
94 | $src = $original; | |
95 | $dst = $meth->encode($src, FB_HTMLCREF); | |
96 | is($dst, $htmlcref, "FB_HTMLCREF"); | |
97 | is($src, '', "FB_HTMLCREF residue"); | |
98 | ||
99 | $src = $original; | |
100 | $dst = $meth->encode($src, FB_XMLCREF); | |
101 | is($dst, $xmlcref, "FB_XMLCREF"); | |
102 | is($src, '', "FB_XMLCREF residue"); |