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