1#!./perl -w 2 3BEGIN { 4 require './test.pl'; 5 skip_all_without_dynamic_extension('Encode'); 6 skip_all("EBCDIC") if $::IS_EBCDIC; 7 skip_all_without_perlio(); 8} 9 10use strict; 11use Encode; 12 13# %mbchars = (encoding => { bytes => utf8, ... }, ...); 14# * pack('C*') is expected to return bytes even if ${^ENCODING} is true. 15our %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 30# 4 == @char; paired tests inside 3 nested loops, 31# plus extra pair of tests in a loop, plus extra pair of tests. 32plan tests => 2 * (4 ** 3 + 4 + 1) * (keys %mbchars); 33 34for 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; 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" 56 } 57 } 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)"); 64 } 65 66 $/ = ")"; # the last char of something like "ARRAY(0x80ff6e4)" 67 my $got = chomp(); 68 is ($got, 1); 69 ok (!ref($_), "chomp ref (modify)"); 70} 71