Commit | Line | Data |
---|---|---|
a6aa349d TS |
1 | #!./perl -w |
2 | ||
3 | BEGIN { | |
b5efbd1f | 4 | chdir 't' if -d 't'; |
e4206093 | 5 | require './test.pl'; |
273be65c | 6 | skip_all_without_dynamic_extension('Encode'); |
3655fed7 | 7 | skip_all("encoding doesn't work with EBCDIC") if $::IS_EBCDIC; |
b5b7b9ad | 8 | skip_all_without_perlio(); |
a6aa349d TS |
9 | } |
10 | ||
11 | use strict; | |
e4206093 | 12 | use Encode; |
a6aa349d TS |
13 | |
14 | # %mbchars = (encoding => { bytes => utf8, ... }, ...); | |
15 | # * pack('C*') is expected to return bytes even if ${^ENCODING} is true. | |
16 | our %mbchars = ( | |
17 | 'big-5' => { | |
18 | pack('C*', 0x40) => pack('U*', 0x40), # COMMERCIAL AT | |
19 | pack('C*', 0xA4, 0x40) => "\x{4E00}", # CJK-4E00 | |
20 | }, | |
21 | 'euc-jp' => { | |
22 | pack('C*', 0xB0, 0xA1) => "\x{4E9C}", # CJK-4E9C | |
23 | pack('C*', 0x8F, 0xB0, 0xA1) => "\x{4E02}", # CJK-4E02 | |
24 | }, | |
25 | 'shift-jis' => { | |
26 | pack('C*', 0xA9) => "\x{FF69}", # halfwidth katakana small U | |
27 | pack('C*', 0x82, 0xA9) => "\x{304B}", # hiragana KA | |
28 | }, | |
29 | ); | |
30 | ||
1858f5c3 NC |
31 | # 4 == @char; paired tests inside 3 nested loops, |
32 | # plus extra pair of tests in a loop, plus extra pair of tests. | |
33 | plan tests => 2 * (4 ** 3 + 4 + 1) * (keys %mbchars); | |
34 | ||
a6aa349d | 35 | for my $enc (sort keys %mbchars) { |
d5b4785c | 36 | no warnings 'deprecated'; |
a6aa349d | 37 | local ${^ENCODING} = find_encoding($enc); |
d5b4785c | 38 | use warnings 'deprecated'; |
a6aa349d TS |
39 | my @char = (sort(keys %{ $mbchars{$enc} }), |
40 | sort(values %{ $mbchars{$enc} })); | |
41 | ||
42 | for my $rs (@char) { | |
43 | local $/ = $rs; | |
44 | for my $start (@char) { | |
45 | for my $end (@char) { | |
46 | my $string = $start.$end; | |
0a61292d NC |
47 | my ($expect, $return); |
48 | if ($end eq $rs) { | |
49 | $expect = $start; | |
50 | # The answer will always be a length in utf8, even if the | |
51 | # scalar was encoded with a different length | |
52 | $return = length ($end . "\x{100}") - 1; | |
53 | } else { | |
54 | $expect = $string; | |
55 | $return = 0; | |
56 | } | |
57 | is (chomp ($string), $return); | |
58 | is ($string, $expect); # "$enc \$/=$rs $start $end" | |
a6aa349d TS |
59 | } |
60 | } | |
1858f5c3 NC |
61 | # chomp should not stringify references unless it decides to modify |
62 | # them | |
63 | $_ = []; | |
64 | my $got = chomp(); | |
65 | is ($got, 0); | |
66 | is (ref($_), "ARRAY", "chomp ref (no modify)"); | |
a6aa349d | 67 | } |
1858f5c3 NC |
68 | |
69 | $/ = ")"; # the last char of something like "ARRAY(0x80ff6e4)" | |
70 | my $got = chomp(); | |
71 | is ($got, 1); | |
72 | ok (!ref($_), "chomp ref (modify)"); | |
a6aa349d | 73 | } |