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