This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Backport foldEQ_utf8 using ibcmp_utf8
[perl5.git] / dist / Devel-PPPort / t / utf8.t
CommitLineData
7899b636
KW
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
13BEGIN {
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
2ff9e5e8 33 if (58) {
7899b636 34 load();
2ff9e5e8 35 plan(tests => 58);
7899b636
KW
36 }
37}
38
39use Devel::PPPort;
40use strict;
41BEGIN { $^W = 1; }
42
43package Devel::PPPort;
44use vars '@ISA';
45require DynaLoader;
46@ISA = qw(DynaLoader);
47bootstrap Devel::PPPort;
48
49package main;
50
51BEGIN { require warnings if "$]" gt '5.006' }
52
53# skip tests on 5.6.0 and earlier
54if ("$]" le '5.006') {
2ff9e5e8 55 skip 'skip: broken utf8 support', 0 for 1..58;
7899b636
KW
56 exit;
57}
58
59ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
60ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
61
62ok(&Devel::PPPort::isUTF8_CHAR("A", -1), 0);
63ok(&Devel::PPPort::isUTF8_CHAR("A", 0), 1);
64ok(&Devel::PPPort::isUTF8_CHAR("\x{100}", -1), 0);
65ok(&Devel::PPPort::isUTF8_CHAR("\x{100}", 0), 2);
66
2ff9e5e8
KW
67if ("$]" lt '5.008') {
68 ok(1, 1) for 1 ..3
69}
70else {
71 ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{101}", 3, 1), 1);
72 ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{102}", 3, 1), 0);
73 ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "b\x{101}", 3, 1), 0);
74}
75
7899b636
KW
76my $ret = &Devel::PPPort::utf8_to_uvchr("A");
77ok($ret->[0], ord("A"));
78ok($ret->[1], 1);
79
80$ret = &Devel::PPPort::utf8_to_uvchr("\0");
81ok($ret->[0], 0);
82ok($ret->[1], 1);
83
84$ret = &Devel::PPPort::utf8_to_uvchr_buf("A", 0);
85ok($ret->[0], ord("A"));
86ok($ret->[1], 1);
87
88$ret = &Devel::PPPort::utf8_to_uvchr_buf("\0", 0);
89ok($ret->[0], 0);
90ok($ret->[1], 1);
91
92if (ord("A") != 65) { # tests not valid for EBCDIC
93 ok(1, 1) for 1 .. (2 + 4 + (7 * 5));
94}
95else {
96 $ret = &Devel::PPPort::utf8_to_uvchr_buf("\xc4\x80", 0);
97 ok($ret->[0], 0x100);
98 ok($ret->[1], 2);
99
100 my @warnings;
101 local $SIG{__WARN__} = sub { push @warnings, @_; };
102
103 {
104 BEGIN { 'warnings'->import('utf8') if "$]" gt '5.006' }
105 $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
106 ok($ret->[0], 0);
107 ok($ret->[1], -1);
108
109 BEGIN { 'warnings'->unimport() if "$]" gt '5.006' }
110 $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
111 ok($ret->[0], 0xFFFD);
112 ok($ret->[1], 1);
113 }
114
115 my @buf_tests = (
116 {
117 input => "A",
118 adjustment => -1,
119 warning => qr/empty/,
120 no_warnings_returned_length => 0,
121 },
122 {
123 input => "\xc4\xc5",
124 adjustment => 0,
125 warning => qr/non-continuation/,
126 no_warnings_returned_length => 1,
127 },
128 {
129 input => "\xc4\x80",
130 adjustment => -1,
131 warning => qr/short|1 byte, need 2/,
132 no_warnings_returned_length => 1,
133 },
134 {
135 input => "\xc0\x81",
136 adjustment => 0,
137 warning => qr/overlong|2 bytes, need 1/,
138 no_warnings_returned_length => 2,
139 },
140 {
141 input => "\xe0\x80\x81",
142 adjustment => 0,
143 warning => qr/overlong|3 bytes, need 1/,
144 no_warnings_returned_length => 3,
145 },
146 {
147 input => "\xf0\x80\x80\x81",
148 adjustment => 0,
149 warning => qr/overlong|4 bytes, need 1/,
150 no_warnings_returned_length => 4,
151 },
152 { # Old algorithm failed to detect this
153 input => "\xff\x80\x90\x90\x90\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf",
154 adjustment => 0,
155 warning => qr/overflow/,
156 no_warnings_returned_length => 13,
157 },
158 );
159
160 # An empty input is an assertion failure on debugging builds. It is
161 # deliberately the first test.
162 require Config; import Config;
163 use vars '%Config';
164 if ($Config{ccflags} =~ /-DDEBUGGING/) {
165 shift @buf_tests;
166 ok(1, 1) for 1..5;
167 }
168
169 for my $test (@buf_tests) {
170 my $input = $test->{'input'};
171 my $adjustment = $test->{'adjustment'};
172 my $display = 'utf8_to_uvchr_buf("';
173 for (my $i = 0; $i < length($input) + $adjustment; $i++) {
174 $display .= sprintf "\\x%02x", ord substr($input, $i, 1);
175 }
176
177 $display .= '")';
178 my $warning = $test->{'warning'};
179
180 undef @warnings;
181 BEGIN { 'warnings'->import('utf8') if "$]" gt '5.006' }
182 $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
183 ok($ret->[0], 0, "returned value $display; warnings enabled");
184 ok($ret->[1], -1, "returned length $display; warnings enabled");
185 my $all_warnings = join "; ", @warnings;
186 my $contains = grep { $_ =~ $warning } $all_warnings;
187 ok($contains, 1, $display
188 . "; Got: '$all_warnings', which should contain '$warning'");
189
190 undef @warnings;
191 BEGIN { 'warnings'->unimport('utf8') if "$]" gt '5.006' }
192 $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
193 ok($ret->[0], 0xFFFD, "returned value $display; warnings disabled");
194 ok($ret->[1], $test->{'no_warnings_returned_length'},
195 "returned length $display; warnings disabled");
196 }
197}
198