This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Backport isUTF8_CHAR
[perl5.git] / dist / Devel-PPPort / t / utf8.t
1 ################################################################################
2 #
3 #            !!!!!   Do NOT edit this file directly!   !!!!!
4 #
5 #            Edit mktests.PL and/or parts/inc/utf8 instead.
6 #
7 #  This file was automatically generated from the definition files in the
8 #  parts/inc/ subdirectory by mktests.PL. To learn more about how all this
9 #  works, please read the F<HACKERS> file that came with this distribution.
10 #
11 ################################################################################
12
13 BEGIN {
14   if ($ENV{'PERL_CORE'}) {
15     chdir 't' if -d 't';
16     @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext';
17     require Config; import Config;
18     use vars '%Config';
19     if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) {
20       print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
21       exit 0;
22     }
23   }
24   else {
25     unshift @INC, 't';
26   }
27
28   sub load {
29     eval "use Test";
30     require 'testutil.pl' if $@;
31   }
32
33   if (55) {
34     load();
35     plan(tests => 55);
36   }
37 }
38
39 use Devel::PPPort;
40 use strict;
41 BEGIN { $^W = 1; }
42
43 package Devel::PPPort;
44 use vars '@ISA';
45 require DynaLoader;
46 @ISA = qw(DynaLoader);
47 bootstrap Devel::PPPort;
48
49 package main;
50
51 BEGIN { require warnings if "$]" gt '5.006' }
52
53 # skip tests on 5.6.0 and earlier
54 if ("$]" le '5.006') {
55     skip 'skip: broken utf8 support', 0 for 1..55;
56     exit;
57 }
58
59 ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
60 ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
61
62 ok(&Devel::PPPort::isUTF8_CHAR("A", -1), 0);
63 ok(&Devel::PPPort::isUTF8_CHAR("A",  0), 1);
64 ok(&Devel::PPPort::isUTF8_CHAR("\x{100}",  -1), 0);
65 ok(&Devel::PPPort::isUTF8_CHAR("\x{100}",  0), 2);
66
67 my $ret = &Devel::PPPort::utf8_to_uvchr("A");
68 ok($ret->[0], ord("A"));
69 ok($ret->[1], 1);
70
71 $ret = &Devel::PPPort::utf8_to_uvchr("\0");
72 ok($ret->[0], 0);
73 ok($ret->[1], 1);
74
75 $ret = &Devel::PPPort::utf8_to_uvchr_buf("A", 0);
76 ok($ret->[0], ord("A"));
77 ok($ret->[1], 1);
78
79 $ret = &Devel::PPPort::utf8_to_uvchr_buf("\0", 0);
80 ok($ret->[0], 0);
81 ok($ret->[1], 1);
82
83 if (ord("A") != 65) {   # tests not valid for EBCDIC
84     ok(1, 1) for 1 .. (2 + 4 + (7 * 5));
85 }
86 else {
87     $ret = &Devel::PPPort::utf8_to_uvchr_buf("\xc4\x80", 0);
88     ok($ret->[0], 0x100);
89     ok($ret->[1], 2);
90
91     my @warnings;
92     local $SIG{__WARN__} = sub { push @warnings, @_; };
93
94     {
95         BEGIN { 'warnings'->import('utf8') if "$]" gt '5.006' }
96         $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
97         ok($ret->[0], 0);
98         ok($ret->[1], -1);
99
100         BEGIN { 'warnings'->unimport() if "$]" gt '5.006' }
101         $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
102         ok($ret->[0], 0xFFFD);
103         ok($ret->[1], 1);
104     }
105
106     my @buf_tests = (
107         {
108             input      => "A",
109             adjustment => -1,
110             warning    => qr/empty/,
111             no_warnings_returned_length => 0,
112         },
113         {
114             input      => "\xc4\xc5",
115             adjustment => 0,
116             warning    => qr/non-continuation/,
117             no_warnings_returned_length => 1,
118         },
119         {
120             input      => "\xc4\x80",
121             adjustment => -1,
122             warning    => qr/short|1 byte, need 2/,
123             no_warnings_returned_length => 1,
124         },
125         {
126             input      => "\xc0\x81",
127             adjustment => 0,
128             warning    => qr/overlong|2 bytes, need 1/,
129             no_warnings_returned_length => 2,
130         },
131         {
132             input      => "\xe0\x80\x81",
133             adjustment => 0,
134             warning    => qr/overlong|3 bytes, need 1/,
135             no_warnings_returned_length => 3,
136         },
137         {
138             input      => "\xf0\x80\x80\x81",
139             adjustment => 0,
140             warning    => qr/overlong|4 bytes, need 1/,
141             no_warnings_returned_length => 4,
142         },
143         {                 # Old algorithm failed to detect this
144             input      => "\xff\x80\x90\x90\x90\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf",
145             adjustment => 0,
146             warning    => qr/overflow/,
147             no_warnings_returned_length => 13,
148         },
149     );
150
151     # An empty input is an assertion failure on debugging builds.  It is
152     # deliberately the first test.
153     require Config; import Config;
154     use vars '%Config';
155     if ($Config{ccflags} =~ /-DDEBUGGING/) {
156         shift @buf_tests;
157         ok(1, 1) for 1..5;
158     }
159
160     for my $test (@buf_tests) {
161         my $input = $test->{'input'};
162         my $adjustment = $test->{'adjustment'};
163         my $display = 'utf8_to_uvchr_buf("';
164         for (my $i = 0; $i < length($input) + $adjustment; $i++) {
165             $display .= sprintf "\\x%02x", ord substr($input, $i, 1);
166         }
167
168         $display .= '")';
169         my $warning = $test->{'warning'};
170
171         undef @warnings;
172         BEGIN { 'warnings'->import('utf8') if "$]" gt '5.006' }
173         $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
174         ok($ret->[0], 0,  "returned value $display; warnings enabled");
175         ok($ret->[1], -1, "returned length $display; warnings enabled");
176         my $all_warnings = join "; ", @warnings;
177         my $contains = grep { $_ =~ $warning } $all_warnings;
178         ok($contains, 1, $display
179                     . "; Got: '$all_warnings', which should contain '$warning'");
180
181         undef @warnings;
182         BEGIN { 'warnings'->unimport('utf8') if "$]" gt '5.006' }
183         $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
184         ok($ret->[0], 0xFFFD,  "returned value $display; warnings disabled");
185         ok($ret->[1], $test->{'no_warnings_returned_length'},
186                       "returned length $display; warnings disabled");
187     }
188 }
189