Move Encode from ext/ to cpan/
[perl.git] / cpan / Encode / t / utf8strict.t
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      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      }
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