This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
parts/inc/uv: Use > to compare $]
[perl5.git] / dist / Devel-PPPort / t / uv.t
CommitLineData
adfe19db
MHM
1################################################################################
2#
3# !!!!! Do NOT edit this file directly! !!!!!
4#
5# Edit mktests.PL and/or parts/inc/uv instead.
6#
cac25305
MHM
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#
adfe19db
MHM
11################################################################################
12
13BEGIN {
14 if ($ENV{'PERL_CORE'}) {
15 chdir 't' if -d 't';
0ff33da8 16 @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext';
adfe19db
MHM
17 require Config; import Config;
18 use vars '%Config';
a745474a 19 if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) {
adfe19db
MHM
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
c07deaaf
MHM
28 sub load {
29 eval "use Test";
30 require 'testutil.pl' if $@;
adfe19db 31 }
c07deaaf 32
5ef77e59 33 if (11) {
c07deaaf 34 load();
5ef77e59 35 plan(tests => 11);
adfe19db
MHM
36 }
37}
38
39use Devel::PPPort;
40use strict;
91900b62 41BEGIN { $^W = 1; }
adfe19db 42
236afa0a
MHM
43package Devel::PPPort;
44use vars '@ISA';
45require DynaLoader;
46@ISA = qw(DynaLoader);
47bootstrap Devel::PPPort;
48
49package main;
50
f5feb9e7 51BEGIN { require warnings if "$]" > '5.006' }
933ffe6b 52
adfe19db
MHM
53ok(&Devel::PPPort::sv_setuv(42), 42);
54ok(&Devel::PPPort::newSVuv(123), 123);
55ok(&Devel::PPPort::sv_2uv("4711"), 4711);
56ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559);
57ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559);
58ok(&Devel::PPPort::SvUVx(1735928559), 1735928559);
59ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
60ok(&Devel::PPPort::XSRETURN_UV(), 42);
96ad942f
MHM
61ok(&Devel::PPPort::PUSHu(), 42);
62ok(&Devel::PPPort::XPUSHu(), 43);
e28192fd 63ok(&Devel::PPPort::my_strnlen("abc\0def", 7), 3);
aadf4f9e 64
89d8c7cd
KW
65# skip tests on 5.6.0 and earlier
66if ("$]" le '5.006') {
933ffe6b 67 skip 'skip: broken utf8 support', 0 for 1..51;
89d8c7cd
KW
68 exit;
69}
70
933ffe6b
P
71ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
72ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
73
aadf4f9e 74my $ret = &Devel::PPPort::utf8_to_uvchr("A");
4c28bdc5
KW
75ok($ret->[0], ord("A"));
76ok($ret->[1], 1);
aadf4f9e
N
77
78$ret = &Devel::PPPort::utf8_to_uvchr("\0");
4c28bdc5
KW
79ok($ret->[0], 0);
80ok($ret->[1], 1);
aadf4f9e
N
81
82$ret = &Devel::PPPort::utf8_to_uvchr_buf("A", 0);
39d7245c
KW
83ok($ret->[0], ord("A"));
84ok($ret->[1], 1);
aadf4f9e
N
85
86$ret = &Devel::PPPort::utf8_to_uvchr_buf("\0", 0);
39d7245c
KW
87ok($ret->[0], 0);
88ok($ret->[1], 1);
adfe19db 89
aadf4f9e 90if (ord("A") != 65) { # tests not valid for EBCDIC
5f93efa0 91 ok(1, 1) for 1 .. (2 + 4 + (7 * 5));
aadf4f9e
N
92}
93else {
94 $ret = &Devel::PPPort::utf8_to_uvchr_buf("\xc4\x80", 0);
95 ok($ret->[0], 0x100);
96 ok($ret->[1], 2);
97
98 my @warnings;
99 local $SIG{__WARN__} = sub { push @warnings, @_; };
100
101 {
933ffe6b 102 BEGIN { 'warnings'->import('utf8') if "$]" gt '5.006' }
aadf4f9e
N
103 $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
104 ok($ret->[0], 0);
105 ok($ret->[1], -1);
106
933ffe6b 107 BEGIN { 'warnings'->unimport() if "$]" gt '5.006' }
aadf4f9e
N
108 $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
109 ok($ret->[0], 0xFFFD);
110 ok($ret->[1], 1);
111 }
112
113 my @buf_tests = (
114 {
115 input => "A",
116 adjustment => -1,
117 warning => qr/empty/,
118 no_warnings_returned_length => 0,
119 },
120 {
121 input => "\xc4\xc5",
122 adjustment => 0,
123 warning => qr/non-continuation/,
124 no_warnings_returned_length => 1,
125 },
126 {
127 input => "\xc4\x80",
128 adjustment => -1,
129 warning => qr/short|1 byte, need 2/,
130 no_warnings_returned_length => 1,
131 },
132 {
133 input => "\xc0\x81",
134 adjustment => 0,
135 warning => qr/overlong|2 bytes, need 1/,
136 no_warnings_returned_length => 2,
137 },
5f93efa0
KW
138 {
139 input => "\xe0\x80\x81",
140 adjustment => 0,
141 warning => qr/overlong|3 bytes, need 1/,
142 no_warnings_returned_length => 3,
143 },
144 {
145 input => "\xf0\x80\x80\x81",
146 adjustment => 0,
147 warning => qr/overlong|4 bytes, need 1/,
148 no_warnings_returned_length => 4,
149 },
6858ac42 150 { # Old algorithm failed to detect this
aadf4f9e
N
151 input => "\xff\x80\x90\x90\x90\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf",
152 adjustment => 0,
05fc829b 153 warning => qr/overflow/,
aadf4f9e
N
154 no_warnings_returned_length => 13,
155 },
156 );
157
158 # An empty input is an assertion failure on debugging builds. It is
159 # deliberately the first test.
160 require Config; import Config;
161 use vars '%Config';
72c9c989
CB
162 if ($Config{ccflags} =~ /-DDEBUGGING/
163 || $^O eq 'VMS' && $Config{usedebugging_perl} eq 'Y') {
aadf4f9e
N
164 shift @buf_tests;
165 ok(1, 1) for 1..5;
166 }
167
168 for my $test (@buf_tests) {
169 my $input = $test->{'input'};
170 my $adjustment = $test->{'adjustment'};
171 my $display = 'utf8_to_uvchr_buf("';
172 for (my $i = 0; $i < length($input) + $adjustment; $i++) {
173 $display .= sprintf "\\x%02x", ord substr($input, $i, 1);
174 }
175
176 $display .= '")';
177 my $warning = $test->{'warning'};
178
179 undef @warnings;
933ffe6b 180 BEGIN { 'warnings'->import('utf8') if "$]" gt '5.006' }
aadf4f9e
N
181 $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
182 ok($ret->[0], 0, "returned value $display; warnings enabled");
183 ok($ret->[1], -1, "returned length $display; warnings enabled");
184 my $all_warnings = join "; ", @warnings;
185 my $contains = grep { $_ =~ $warning } $all_warnings;
17c135f5
KW
186 ok($contains, 1, $display
187 . "; Got: '$all_warnings', which should contain '$warning'");
aadf4f9e
N
188
189 undef @warnings;
933ffe6b 190 BEGIN { 'warnings'->unimport('utf8') if "$]" gt '5.006' }
aadf4f9e
N
191 $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
192 ok($ret->[0], 0xFFFD, "returned value $display; warnings disabled");
193 ok($ret->[1], $test->{'no_warnings_returned_length'},
194 "returned length $display; warnings disabled");
195 }
196}
197