1#!../perl 2our $DEBUG = @ARGV; 3our (%ORD, %SEQ, $NTESTS); 4BEGIN { 5 if ($ENV{'PERL_CORE'}){ 6 chdir 't'; 7 unshift @INC, '../lib'; 8 } 9 require Config; import Config; 10 if ($Config{'extensions'} !~ /\bEncode\b/) { 11 print "1..0 # Skip: Encode was not built\n"; 12 exit 0; 13 } 14 if ($] <= 5.008 and !$Config{perl_patchlevel}){ 15 print "1..0 # Skip: Perl 5.8.1 or later required\n"; 16 exit 0; 17 } 18 # http://smontagu.damowmow.com/utf8test.html 19 # The numbers below, like 2.1.2 are test numbers on this web page 20 %ORD = ( 21 0x00000080 => 0, # 2.1.2 22 0x00000800 => 0, # 2.1.3 23 0x00010000 => 0, # 2.1.4 24 0x00200000 => 1, # 2.1.5 25 0x00400000 => 1, # 2.1.6 26 0x0000007F => 0, # 2.2.1 -- unmapped okay 27 0x000007FF => 0, # 2.2.2 28 0x0000FFFF => 1, # 2.2.3 29 0x001FFFFF => 1, # 2.2.4 30 0x03FFFFFF => 1, # 2.2.5 31 0x7FFFFFFF => 1, # 2.2.6 32 0x0000D800 => 1, # 5.1.1 33 0x0000DB7F => 1, # 5.1.2 34 0x0000D880 => 1, # 5.1.3 35 0x0000DBFF => 1, # 5.1.4 36 0x0000DC00 => 1, # 5.1.5 37 0x0000DF80 => 1, # 5.1.6 38 0x0000DFFF => 1, # 5.1.7 39 # 5.2 "Paird UTF-16 surrogates skipped 40 # because utf-8-strict raises exception at the first one 41 0x0000FFFF => 1, # 5.3.1 42 ); 43 $NTESTS += scalar keys %ORD; 44 if (ord('A') == 193) { 45 %SEQ = ( 46 qq/dd 64 73 73/ => 0, # 2.3.1 47 qq/dd 67 41 41/ => 0, # 2.3.2 48 qq/ee 42 73 73 71/ => 0, # 2.3.3 49 qq/f4 90 80 80/ => 1, # 2.3.4 -- out of range so NG 50 # "3 Malformed sequences" are checked by perl. 51 # "4 Overlong sequences" are checked by perl. 52 ); 53 } else { 54 %SEQ = ( 55 qq/ed 9f bf/ => 0, # 2.3.1 56 qq/ee 80 80/ => 0, # 2.3.2 57 qq/f4 8f bf bd/ => 0, # 2.3.3 58 qq/f4 90 80 80/ => 1, # 2.3.4 -- out of range so NG 59 # "3 Malformed sequences" are checked by perl. 60 # "4 Overlong sequences" are checked by perl. 61 ); 62 } 63 $NTESTS += scalar keys %SEQ; 64} 65use strict; 66use Encode; 67use utf8; 68use Test::More tests => $NTESTS; 69 70local($SIG{__WARN__}) = sub { $DEBUG and $@ and print STDERR $@ }; 71 72my $d = find_encoding("utf-8-strict"); 73for my $u (sort keys %ORD){ 74 my $c = chr($u); 75 eval { $d->encode($c,1) }; 76 $DEBUG and $@ and warn $@; 77 my $t = $@ ? 1 : 0; 78 is($t, $ORD{$u}, sprintf "U+%04X", $u); 79} 80for my $s (sort keys %SEQ){ 81 my $o = pack "C*" => map {hex} split /\s+/, $s; 82 eval { $d->decode($o,1) }; 83 $DEBUG and $@ and warn $@; 84 my $t = $@ ? 1 : 0; 85 is($t, $SEQ{$s}, $s); 86} 87 88__END__ 89 90 91