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