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"; |
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 | %ORD = ( |
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 | ); |
42 | $NTESTS += scalar keys %ORD; |
43 | %SEQ = ( |
44 | qq/ed 9f bf/ => 0, # 2.3.1 |
45 | qq/ee 80 80/ => 0, # 2.3.2 |
46 | qq/f4 8f bf bf/ => 0, # 2.3.3 |
47 | qq/f4 90 80 80/ => 1, # 2.3.4 -- out of range so NG |
48 | # "3 Malformed sequences" are checked by perl. |
49 | # "4 Overlong sequences" are checked by perl. |
50 | ); |
51 | $NTESTS += scalar keys %SEQ; |
52 | } |
53 | use strict; |
54 | use Encode; |
55 | use utf8; |
56 | use Test::More tests => $NTESTS; |
57 | |
58 | local($SIG{__WARN__}) = sub { $DEBUG and $@ and print STDERR $@ }; |
59 | |
60 | my $d = find_encoding("utf-8-strict"); |
61 | for my $u (sort keys %ORD){ |
62 | my $c = chr($u); |
63 | eval { $d->encode($c,1) }; |
64 | $DEBUG and $@ and warn $@; |
65 | my $t = $@ ? 1 : 0; |
66 | is($t, $ORD{$u}, sprintf "U+%04X", $u); |
67 | } |
68 | for my $s (sort keys %SEQ){ |
69 | my $o = pack "C*" => map {hex} split /\s+/, $s; |
70 | eval { $d->decode($o,1) }; |
71 | $DEBUG and $@ and warn $@; |
72 | my $t = $@ ? 1 : 0; |
73 | is($t, $SEQ{$s}, $s); |
74 | } |
75 | |
76 | __END__ |
77 | |
78 | |