This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix gv_fetchpvn_flags
[perl5.git] / dist / Devel-PPPort / parts / inc / uv
CommitLineData
adfe19db
MHM
1################################################################################
2##
b2049988 3## Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
adfe19db
MHM
4## Version 2.x, Copyright (C) 2001, Paul Marquess.
5## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
6##
7## This program is free software; you can redistribute it and/or
8## modify it under the same terms as Perl itself.
9##
10################################################################################
11
12=provides
13
adfe19db 14__UNDEFINED__
e28192fd 15my_strnlen
679ad62d 16SvUOK
aadf4f9e
N
17utf8_to_uvchr_buf
18
adfe19db
MHM
19=implementation
20
bbe8b705 21#define D_PPP_MIN(a,b) (((a) <= (b)) ? (a) : (b))
aadf4f9e 22
0d0f8426
MHM
23__UNDEFINED__ sv_setuv(sv, uv) \
24 STMT_START { \
25 UV TeMpUv = uv; \
26 if (TeMpUv <= IV_MAX) \
27 sv_setiv(sv, TeMpUv); \
28 else \
29 sv_setnv(sv, (double)TeMpUv); \
30 } STMT_END
31
32__UNDEFINED__ newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
adfe19db
MHM
33
34__UNDEFINED__ sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
35__UNDEFINED__ SvUVX(sv) ((UV)SvIVX(sv))
36__UNDEFINED__ SvUVXx(sv) SvUVX(sv)
37__UNDEFINED__ SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
38__UNDEFINED__ SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
39
40/* Hint: sv_uv
41 * Always use the SvUVx() macro instead of sv_uv().
42 */
43__UNDEFINED__ sv_uv(sv) SvUVx(sv)
44
679ad62d
MHM
45#if !defined(SvUOK) && defined(SvIOK_UV)
46# define SvUOK(sv) SvIOK_UV(sv)
47#endif
48
adfe19db
MHM
49__UNDEFINED__ XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
50__UNDEFINED__ XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
51
96ad942f
MHM
52__UNDEFINED__ PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
53__UNDEFINED__ XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
54
f2e3e4ce 55#if defined UTF8SKIP
94a2c4f7
KW
56
57/* Don't use official version because it uses MIN, which may not be available */
58#undef UTF8_SAFE_SKIP
59
aadf4f9e
N
60__UNDEFINED__ UTF8_SAFE_SKIP(s, e) ( \
61 ((((e) - (s)) <= 0) \
f2e3e4ce 62 ? 0 \
bbe8b705 63 : D_PPP_MIN(((e) - (s)), UTF8SKIP(s))))
f2e3e4ce
KW
64#endif
65
e28192fd
KW
66#if !defined(my_strnlen)
67#if { NEED my_strnlen }
68
69STRLEN
70my_strnlen(const char *str, Size_t maxlen)
71{
72 const char *p = str;
73
74 while(maxlen-- && *p)
75 p++;
76
77 return p - str;
78}
79
80#endif
81#endif
4c28bdc5 82
97d83eb2 83#if { VERSION < 5.31.3 }
aadf4f9e
N
84 /* Versions prior to this accepted things that are now considered
85 * malformations, and didn't return -1 on error with warnings enabled
86 * */
87# undef utf8_to_uvchr_buf
88#endif
4c28bdc5 89
aadf4f9e
N
90/* This implementation brings modern, generally more restricted standards to
91 * utf8_to_uvchr_buf. Some of these are security related, and clearly must
92 * be done. But its arguable that the others need not, and hence should not.
93 * The reason they're here is that a module that intends to play with the
6858ac42 94 * latest perls should be able to work the same in all releases. An example is
aadf4f9e
N
95 * that perl no longer accepts any UV for a code point, but limits them to
96 * IV_MAX or below. This is for future internal use of the larger code points.
97 * If it turns out that some of these changes are breaking code that isn't
98 * intended to work with modern perls, the tighter restrictions could be
99 * relaxed. khw thinks this is unlikely, but has been wrong in the past. */
100
6858ac42
KW
101/* 5.6.0 is the first release with UTF-8, and we don't implement this function
102 * there due to its likely lack of still being in use, and the underlying
103 * implementation is very different from later ones, without the later
104 * safeguards, so would require extra work to deal with */
e4a76720 105#if { VERSION >= 5.6.1 } && ! defined(utf8_to_uvchr_buf)
aadf4f9e
N
106 /* Choose which underlying implementation to use. At least one must be
107 * present or the perl is too early to handle this function */
108# if defined(utf8n_to_uvchr) || defined(utf8_to_uv)
109# if defined(utf8n_to_uvchr) /* This is the preferred implementation */
bbe8b705 110# define D_PPP_utf8_to_uvchr_buf_callee utf8n_to_uvchr
e4a76720 111# else /* Must be at least 5.6.1 from #if above */
612c5515 112# define D_PPP_utf8_to_uvchr_buf_callee(s, curlen, retlen, flags) utf8_to_uv((U8 *)(s), (curlen), (retlen), (flags))
aadf4f9e 113# endif
aadf4f9e
N
114# endif
115
aadf4f9e 116# if { NEED utf8_to_uvchr_buf }
4c28bdc5 117
aadf4f9e 118UV
612c5515 119utf8_to_uvchr_buf(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
aadf4f9e
N
120{
121 UV ret;
122 STRLEN curlen;
123 bool overflows = 0;
124 const U8 *cur_s = s;
125 const bool do_warnings = ckWARN_d(WARN_UTF8);
05fc829b 126 STRLEN overflow_length = 0;
aadf4f9e
N
127
128 if (send > s) {
129 curlen = send - s;
130 }
131 else {
132 assert(0); /* Modern perls die under this circumstance */
133 curlen = 0;
134 if (! do_warnings) { /* Handle empty here if no warnings needed */
135 if (retlen) *retlen = 0;
136 return UNICODE_REPLACEMENT;
137 }
138 }
139
8ec545d9 140# if { VERSION < 5.26.0 } && ! defined(EBCDIC)
aadf4f9e 141
6858ac42
KW
142 /* Perl did not properly detect overflow for much of its history on
143 * non-EBCDIC platforms, often returning an overlong value which may or may
144 * not have been tolerated in the call. Also, earlier versions, when they
145 * did detect overflow, may have disallowed it completely. Modern ones can
146 * replace it with the REPLACEMENT CHARACTER, depending on calling
147 * parameters. Therefore detect it ourselves in releases it was
148 * problematic in. */
aadf4f9e 149
05fc829b 150 if (curlen > 0 && UNLIKELY(*s >= 0xFE)) {
aadf4f9e 151
6858ac42
KW
152 /* First, on a 32-bit machine the first byte being at least \xFE
153 * automatically is overflow, as it indicates something requiring more
154 * than 31 bits */
aadf4f9e
N
155 if (sizeof(ret) < 8) {
156 overflows = 1;
05fc829b 157 overflow_length = 7;
aadf4f9e
N
158 }
159 else {
160 const U8 highest[] = /* 2*63-1 */
161 "\xFF\x80\x87\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF";
162 const U8 *cur_h = highest;
163
164 for (cur_s = s; cur_s < send; cur_s++, cur_h++) {
165 if (UNLIKELY(*cur_s == *cur_h)) {
166 continue;
167 }
168
169 /* If this byte is larger than the corresponding highest UTF-8
6858ac42
KW
170 * byte, the sequence overflows; otherwise the byte is less
171 * than (as we handled the equality case above), and so the
172 * sequence doesn't overflow */
aadf4f9e
N
173 overflows = *cur_s > *cur_h;
174 break;
175
176 }
177
178 /* Here, either we set the bool and broke out of the loop, or got
179 * to the end and all bytes are the same which indicates it doesn't
05fc829b
KW
180 * overflow. If it did overflow, it would be this number of bytes
181 * */
182 overflow_length = 13;
183 }
184 }
185
186 if (UNLIKELY(overflows)) {
187 ret = 0;
188
189 if (! do_warnings && retlen) {
190 *retlen = overflow_length;
aadf4f9e
N
191 }
192 }
05fc829b 193 else
aadf4f9e 194
aadf4f9e
N
195# endif /* < 5.26 */
196
05fc829b
KW
197 /* Here, we are either in a release that properly detects overflow, or
198 * we have checked for overflow and the next statement is executing as
199 * part of the above conditional where we know we don't have overflow.
200 *
201 * The modern versions allow anything that evaluates to a legal UV, but
202 * not overlongs nor an empty input */
bbe8b705 203 ret = D_PPP_utf8_to_uvchr_buf_callee(
05fc829b
KW
204 s, curlen, retlen, (UTF8_ALLOW_ANYUV
205 & ~(UTF8_ALLOW_LONG|UTF8_ALLOW_EMPTY)));
206
207# if { VERSION >= 5.26.0 } && { VERSION < 5.28.0 }
208
209 /* But actually, more modern versions restrict the UV to being no more than
210 * what * an IV can hold, so it could, so it could still have gotten it
211 * wrong about overflowing. */
212 if (UNLIKELY(ret > IV_MAX)) {
213 overflows = 1;
214 }
215
216# endif
217
aadf4f9e
N
218 if (UNLIKELY(overflows)) {
219 if (! do_warnings) {
220 if (retlen) {
bbe8b705
KW
221 *retlen = D_PPP_MIN(*retlen, UTF8SKIP(s));
222 *retlen = D_PPP_MIN(*retlen, curlen);
aadf4f9e
N
223 }
224 return UNICODE_REPLACEMENT;
225 }
226 else {
227
6858ac42 228 /* We use the error message in use from 5.8-5.26 */
de222e8b
KW
229 Perl_warner(aTHX_ packWARN(WARN_UTF8),
230 "Malformed UTF-8 character (overflow at 0x%" UVxf
231 ", byte 0x%02x, after start byte 0x%02x)",
232 ret, *cur_s, *s);
aadf4f9e
N
233 if (retlen) {
234 *retlen = (STRLEN) -1;
235 }
236 return 0;
237 }
238 }
239
6858ac42
KW
240 /* Here, did not overflow, but if it failed for some other reason, and
241 * warnings are off, to emulate the behavior of the real utf8_to_uvchr(),
242 * try again, allowing anything. (Note a return of 0 is ok if the input
243 * was '\0') */
aadf4f9e
N
244 if (UNLIKELY(ret == 0 && (curlen == 0 || *s != '\0'))) {
245
246 /* If curlen is 0, we already handled the case where warnings are
6858ac42
KW
247 * disabled, so this 'if' will be true, and so later on, we know that
248 * 's' is dereferencible */
aadf4f9e
N
249 if (do_warnings) {
250 *retlen = (STRLEN) -1;
251 }
252 else {
bbe8b705 253 ret = D_PPP_utf8_to_uvchr_buf_callee(
aadf4f9e
N
254 s, curlen, retlen, UTF8_ALLOW_ANY);
255 /* Override with the REPLACEMENT character, as that is what the
256 * modern version of this function returns */
257 ret = UNICODE_REPLACEMENT;
258
de222e8b 259# if { VERSION < 5.16.0 }
aadf4f9e
N
260
261 /* Versions earlier than this don't necessarily return the proper
262 * length. It should not extend past the end of string, nor past
263 * what the first byte indicates the length is, nor past the
264 * continuation characters */
265 if (retlen && *retlen >= 0) {
f1590d76 266 unsigned int i = 1;
bbe8b705
KW
267
268 *retlen = D_PPP_MIN(*retlen, curlen);
269 *retlen = D_PPP_MIN(*retlen, UTF8SKIP(s));
aadf4f9e
N
270 do {
271 if (s[i] < 0x80 || s[i] > 0xBF) {
272 *retlen = i;
273 break;
274 }
275 } while (++i < *retlen);
276 }
277
de222e8b 278# endif
aadf4f9e
N
279
280 }
281 }
282
283 return ret;
284}
e28192fd 285
aadf4f9e
N
286# endif
287#endif
39d7245c 288
aadf4f9e
N
289#if defined(UTF8SKIP) && defined(utf8_to_uvchr_buf)
290#undef utf8_to_uvchr /* Always redefine this unsafe function so that it refuses
291 to read past a NUL, making it much less likely to read
292 off the end of the buffer. A NUL indicates the start
293 of the next character anyway. If the input isn't
294 NUL-terminated, the function remains unsafe, as it
295 always has been. */
39d7245c
KW
296
297__UNDEFINED__ utf8_to_uvchr(s, lp) \
298 ((*(s) == '\0') \
299 ? utf8_to_uvchr_buf(s,((s)+1), lp) /* Handle single NUL specially */ \
300 : utf8_to_uvchr_buf(s, (s) + my_strnlen((char *) (s), UTF8SKIP(s)), (lp)))
301
aadf4f9e
N
302#endif
303
e28192fd
KW
304=xsinit
305
306#define NEED_my_strnlen
aadf4f9e 307#define NEED_utf8_to_uvchr_buf
e28192fd 308
adfe19db
MHM
309=xsubs
310
311SV *
312sv_setuv(uv)
b2049988
MHM
313 UV uv
314 CODE:
315 RETVAL = newSViv(1);
316 sv_setuv(RETVAL, uv);
317 OUTPUT:
318 RETVAL
adfe19db
MHM
319
320SV *
321newSVuv(uv)
b2049988
MHM
322 UV uv
323 CODE:
324 RETVAL = newSVuv(uv);
325 OUTPUT:
326 RETVAL
adfe19db
MHM
327
328UV
329sv_2uv(sv)
b2049988
MHM
330 SV *sv
331 CODE:
332 RETVAL = sv_2uv(sv);
333 OUTPUT:
334 RETVAL
adfe19db
MHM
335
336UV
337SvUVx(sv)
b2049988
MHM
338 SV *sv
339 CODE:
340 sv--;
341 RETVAL = SvUVx(++sv);
342 OUTPUT:
343 RETVAL
adfe19db
MHM
344
345void
346XSRETURN_UV()
b2049988
MHM
347 PPCODE:
348 XSRETURN_UV(42);
adfe19db 349
96ad942f
MHM
350void
351PUSHu()
b2049988
MHM
352 PREINIT:
353 dTARG;
354 PPCODE:
355 TARG = sv_newmortal();
356 EXTEND(SP, 1);
357 PUSHu(42);
358 XSRETURN(1);
96ad942f
MHM
359
360void
361XPUSHu()
b2049988
MHM
362 PREINIT:
363 dTARG;
364 PPCODE:
365 TARG = sv_newmortal();
366 XPUSHu(43);
367 XSRETURN(1);
96ad942f 368
612c5515
P
369#if defined(UTF8_SAFE_SKIP) && defined(UTF8SKIP)
370
f2e3e4ce
KW
371STRLEN
372UTF8_SAFE_SKIP(s, adjustment)
612c5515 373 char * s
f2e3e4ce 374 int adjustment
612c5515
P
375 PREINIT:
376 const char *const_s;
f2e3e4ce 377 CODE:
612c5515 378 const_s = s;
f2e3e4ce 379 /* Instead of passing in an 'e' ptr, use the real end, adjusted */
612c5515 380 RETVAL = UTF8_SAFE_SKIP(const_s, s + UTF8SKIP(s) + adjustment);
f2e3e4ce
KW
381 OUTPUT:
382 RETVAL
383
612c5515
P
384#endif
385
e28192fd
KW
386STRLEN
387my_strnlen(s, max)
388 char * s
389 STRLEN max
390 CODE:
391 RETVAL= my_strnlen(s, max);
392 OUTPUT:
393 RETVAL
394
612c5515
P
395#ifdef utf8_to_uvchr_buf
396
4c28bdc5 397AV *
aadf4f9e 398utf8_to_uvchr_buf(s, adjustment)
4c28bdc5 399 unsigned char *s
aadf4f9e 400 int adjustment
4c28bdc5
KW
401 PREINIT:
402 AV *av;
403 STRLEN len;
612c5515 404 const char *const_s;
4c28bdc5
KW
405 CODE:
406 av = newAV();
612c5515
P
407 const_s = s;
408 av_push(av, newSVuv(utf8_to_uvchr_buf(const_s,
aadf4f9e
N
409 s + UTF8SKIP(s) + adjustment,
410 &len)));
721db7b0
N
411 if (len == (STRLEN) -1) {
412 av_push(av, newSViv(-1));
413 }
414 else {
415 av_push(av, newSVuv(len));
416 }
4c28bdc5
KW
417 RETVAL = av;
418 OUTPUT:
419 RETVAL
420
612c5515
P
421#endif
422
423#ifdef utf8_to_uvchr
424
39d7245c
KW
425AV *
426utf8_to_uvchr(s)
427 unsigned char *s
428 PREINIT:
429 AV *av;
430 STRLEN len;
612c5515 431 const char *const_s;
39d7245c
KW
432 CODE:
433 av = newAV();
612c5515
P
434 const_s = s;
435 av_push(av, newSVuv(utf8_to_uvchr(const_s, &len)));
721db7b0
N
436 if (len == (STRLEN) -1) {
437 av_push(av, newSViv(-1));
438 }
439 else {
440 av_push(av, newSVuv(len));
441 }
39d7245c
KW
442 RETVAL = av;
443 OUTPUT:
444 RETVAL
445
612c5515
P
446#endif
447
5f93efa0 448=tests plan => 62
adfe19db 449
933ffe6b
P
450BEGIN { require warnings if "$]" gt '5.006' }
451
adfe19db
MHM
452ok(&Devel::PPPort::sv_setuv(42), 42);
453ok(&Devel::PPPort::newSVuv(123), 123);
454ok(&Devel::PPPort::sv_2uv("4711"), 4711);
455ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559);
456ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559);
457ok(&Devel::PPPort::SvUVx(1735928559), 1735928559);
458ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
459ok(&Devel::PPPort::XSRETURN_UV(), 42);
96ad942f
MHM
460ok(&Devel::PPPort::PUSHu(), 42);
461ok(&Devel::PPPort::XPUSHu(), 43);
e28192fd 462ok(&Devel::PPPort::my_strnlen("abc\0def", 7), 3);
aadf4f9e 463
89d8c7cd
KW
464# skip tests on 5.6.0 and earlier
465if ("$]" le '5.006') {
933ffe6b 466 skip 'skip: broken utf8 support', 0 for 1..51;
89d8c7cd
KW
467 exit;
468}
469
933ffe6b
P
470ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
471ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
472
aadf4f9e 473my $ret = &Devel::PPPort::utf8_to_uvchr("A");
4c28bdc5
KW
474ok($ret->[0], ord("A"));
475ok($ret->[1], 1);
aadf4f9e
N
476
477$ret = &Devel::PPPort::utf8_to_uvchr("\0");
4c28bdc5
KW
478ok($ret->[0], 0);
479ok($ret->[1], 1);
aadf4f9e
N
480
481$ret = &Devel::PPPort::utf8_to_uvchr_buf("A", 0);
39d7245c
KW
482ok($ret->[0], ord("A"));
483ok($ret->[1], 1);
aadf4f9e
N
484
485$ret = &Devel::PPPort::utf8_to_uvchr_buf("\0", 0);
39d7245c
KW
486ok($ret->[0], 0);
487ok($ret->[1], 1);
aadf4f9e
N
488
489if (ord("A") != 65) { # tests not valid for EBCDIC
5f93efa0 490 ok(1, 1) for 1 .. (2 + 4 + (7 * 5));
aadf4f9e
N
491}
492else {
493 $ret = &Devel::PPPort::utf8_to_uvchr_buf("\xc4\x80", 0);
494 ok($ret->[0], 0x100);
495 ok($ret->[1], 2);
496
497 my @warnings;
498 local $SIG{__WARN__} = sub { push @warnings, @_; };
499
500 {
933ffe6b 501 BEGIN { 'warnings'->import('utf8') if "$]" gt '5.006' }
aadf4f9e
N
502 $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
503 ok($ret->[0], 0);
504 ok($ret->[1], -1);
505
933ffe6b 506 BEGIN { 'warnings'->unimport() if "$]" gt '5.006' }
aadf4f9e
N
507 $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
508 ok($ret->[0], 0xFFFD);
509 ok($ret->[1], 1);
510 }
511
512 my @buf_tests = (
513 {
514 input => "A",
515 adjustment => -1,
516 warning => qr/empty/,
517 no_warnings_returned_length => 0,
518 },
519 {
520 input => "\xc4\xc5",
521 adjustment => 0,
522 warning => qr/non-continuation/,
523 no_warnings_returned_length => 1,
524 },
525 {
526 input => "\xc4\x80",
527 adjustment => -1,
528 warning => qr/short|1 byte, need 2/,
529 no_warnings_returned_length => 1,
530 },
531 {
532 input => "\xc0\x81",
533 adjustment => 0,
534 warning => qr/overlong|2 bytes, need 1/,
535 no_warnings_returned_length => 2,
536 },
5f93efa0
KW
537 {
538 input => "\xe0\x80\x81",
539 adjustment => 0,
540 warning => qr/overlong|3 bytes, need 1/,
541 no_warnings_returned_length => 3,
542 },
543 {
544 input => "\xf0\x80\x80\x81",
545 adjustment => 0,
546 warning => qr/overlong|4 bytes, need 1/,
547 no_warnings_returned_length => 4,
548 },
6858ac42 549 { # Old algorithm failed to detect this
aadf4f9e
N
550 input => "\xff\x80\x90\x90\x90\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf",
551 adjustment => 0,
05fc829b 552 warning => qr/overflow/,
aadf4f9e
N
553 no_warnings_returned_length => 13,
554 },
555 );
556
557 # An empty input is an assertion failure on debugging builds. It is
558 # deliberately the first test.
559 require Config; import Config;
560 use vars '%Config';
561 if ($Config{ccflags} =~ /-DDEBUGGING/) {
562 shift @buf_tests;
563 ok(1, 1) for 1..5;
564 }
565
566 for my $test (@buf_tests) {
567 my $input = $test->{'input'};
568 my $adjustment = $test->{'adjustment'};
569 my $display = 'utf8_to_uvchr_buf("';
570 for (my $i = 0; $i < length($input) + $adjustment; $i++) {
571 $display .= sprintf "\\x%02x", ord substr($input, $i, 1);
572 }
573
574 $display .= '")';
575 my $warning = $test->{'warning'};
576
577 undef @warnings;
933ffe6b 578 BEGIN { 'warnings'->import('utf8') if "$]" gt '5.006' }
aadf4f9e
N
579 $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
580 ok($ret->[0], 0, "returned value $display; warnings enabled");
581 ok($ret->[1], -1, "returned length $display; warnings enabled");
582 my $all_warnings = join "; ", @warnings;
583 my $contains = grep { $_ =~ $warning } $all_warnings;
17c135f5
KW
584 ok($contains, 1, $display
585 . "; Got: '$all_warnings', which should contain '$warning'");
aadf4f9e
N
586
587 undef @warnings;
933ffe6b 588 BEGIN { 'warnings'->unimport('utf8') if "$]" gt '5.006' }
aadf4f9e
N
589 $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
590 ok($ret->[0], 0xFFFD, "returned value $display; warnings disabled");
591 ok($ret->[1], $test->{'no_warnings_returned_length'},
592 "returned length $display; warnings disabled");
593 }
594}