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     %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}
53use strict;
54use Encode;
55use utf8;
56use Test::More tests => $NTESTS;
57
58local($SIG{__WARN__}) = sub { $DEBUG and $@ and print STDERR $@ };
59
60my $d = find_encoding("utf-8-strict");
61for 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}
68for 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
79