__UNDEFINED__
my_strnlen
SvUOK
-utf8_to_uvchr_buf
=implementation
-#define D_PPP_MIN(a,b) (((a) <= (b)) ? (a) : (b))
-
__UNDEFINED__ sv_setuv(sv, uv) \
STMT_START { \
UV TeMpUv = uv; \
__UNDEFINED__ newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
+__UNDEFINED__ sv_2uv(sv) ({ SV *_sv = (sv); (UV) (SvNOK(_sv) ? SvNV(_sv) : sv_2nv(_sv)); })
+#else
__UNDEFINED__ sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
+#endif
+
__UNDEFINED__ SvUVX(sv) ((UV)SvIVX(sv))
__UNDEFINED__ SvUVXx(sv) SvUVX(sv)
__UNDEFINED__ SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
+
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
+__UNDEFINED__ SvUVx(sv) ({ SV *_sv = (sv)); SvUV(_sv); })
+#else
__UNDEFINED__ SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
+#endif
/* Hint: sv_uv
* Always use the SvUVx() macro instead of sv_uv().
*/
+/* Replace sv_uv with SvUVx */
__UNDEFINED__ sv_uv(sv) SvUVx(sv)
#if !defined(SvUOK) && defined(SvIOK_UV)
__UNDEFINED__ PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
__UNDEFINED__ XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
-#if defined UTF8SKIP
-
-/* Don't use official version because it uses MIN, which may not be available */
-#undef UTF8_SAFE_SKIP
-
-__UNDEFINED__ UTF8_SAFE_SKIP(s, e) ( \
- ((((e) - (s)) <= 0) \
- ? 0 \
- : D_PPP_MIN(((e) - (s)), UTF8SKIP(s))))
-#endif
-
#if !defined(my_strnlen)
#if { NEED my_strnlen }
-STRLEN
+Size_t
my_strnlen(const char *str, Size_t maxlen)
{
const char *p = str;
#endif
#endif
-#if { VERSION < 5.31.3 }
+#if { VERSION < 5.31.4 }
/* Versions prior to this accepted things that are now considered
* malformations, and didn't return -1 on error with warnings enabled
* */
bool overflows = 0;
const U8 *cur_s = s;
const bool do_warnings = ckWARN_d(WARN_UTF8);
+# if { VERSION < 5.26.0 } && ! defined(EBCDIC)
STRLEN overflow_length = 0;
+# endif
if (send > s) {
curlen = send - s;
XPUSHu(43);
XSRETURN(1);
-#if defined(UTF8_SAFE_SKIP) && defined(UTF8SKIP)
-
-STRLEN
-UTF8_SAFE_SKIP(s, adjustment)
- char * s
- int adjustment
- PREINIT:
- const char *const_s;
- CODE:
- const_s = s;
- /* Instead of passing in an 'e' ptr, use the real end, adjusted */
- RETVAL = UTF8_SAFE_SKIP(const_s, s + UTF8SKIP(s) + adjustment);
- OUTPUT:
- RETVAL
-
-#endif
-
STRLEN
my_strnlen(s, max)
char * s
OUTPUT:
RETVAL
-#ifdef utf8_to_uvchr_buf
-
-AV *
-utf8_to_uvchr_buf(s, adjustment)
- unsigned char *s
- int adjustment
- PREINIT:
- AV *av;
- STRLEN len;
- const char *const_s;
- CODE:
- av = newAV();
- const_s = s;
- av_push(av, newSVuv(utf8_to_uvchr_buf(const_s,
- s + UTF8SKIP(s) + adjustment,
- &len)));
- if (len == (STRLEN) -1) {
- av_push(av, newSViv(-1));
- }
- else {
- av_push(av, newSVuv(len));
- }
- RETVAL = av;
- OUTPUT:
- RETVAL
+=tests plan => 11
-#endif
-
-#ifdef utf8_to_uvchr
-
-AV *
-utf8_to_uvchr(s)
- unsigned char *s
- PREINIT:
- AV *av;
- STRLEN len;
- const char *const_s;
- CODE:
- av = newAV();
- const_s = s;
- av_push(av, newSVuv(utf8_to_uvchr(const_s, &len)));
- if (len == (STRLEN) -1) {
- av_push(av, newSViv(-1));
- }
- else {
- av_push(av, newSVuv(len));
- }
- RETVAL = av;
- OUTPUT:
- RETVAL
-
-#endif
-
-=tests plan => 62
+BEGIN { require warnings if "$]" > '5.006' }
ok(&Devel::PPPort::sv_setuv(42), 42);
ok(&Devel::PPPort::newSVuv(123), 123);
ok(&Devel::PPPort::XSRETURN_UV(), 42);
ok(&Devel::PPPort::PUSHu(), 42);
ok(&Devel::PPPort::XPUSHu(), 43);
-ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
-ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
ok(&Devel::PPPort::my_strnlen("abc\0def", 7), 3);
# skip tests on 5.6.0 and earlier
if ("$]" le '5.006') {
- skip 'skip: broken utf8 support', 0 for 1..49;
+ skip 'skip: broken utf8 support', 0 for 1..51;
exit;
}
+ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
+ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
+
my $ret = &Devel::PPPort::utf8_to_uvchr("A");
ok($ret->[0], ord("A"));
ok($ret->[1], 1);
local $SIG{__WARN__} = sub { push @warnings, @_; };
{
- use warnings 'utf8';
+ BEGIN { 'warnings'->import('utf8') if "$]" gt '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
ok($ret->[0], 0);
ok($ret->[1], -1);
- no warnings;
+ BEGIN { 'warnings'->unimport() if "$]" gt '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
ok($ret->[0], 0xFFFD);
ok($ret->[1], 1);
# deliberately the first test.
require Config; import Config;
use vars '%Config';
- if ($Config{ccflags} =~ /-DDEBUGGING/) {
+ if ($Config{ccflags} =~ /-DDEBUGGING/
+ || $^O eq 'VMS' && $Config{usedebugging_perl} eq 'Y') {
shift @buf_tests;
ok(1, 1) for 1..5;
}
my $warning = $test->{'warning'};
undef @warnings;
- use warnings 'utf8';
+ BEGIN { 'warnings'->import('utf8') if "$]" gt '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
ok($ret->[0], 0, "returned value $display; warnings enabled");
ok($ret->[1], -1, "returned length $display; warnings enabled");
. "; Got: '$all_warnings', which should contain '$warning'");
undef @warnings;
- no warnings 'utf8';
+ BEGIN { 'warnings'->unimport('utf8') if "$]" gt '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
ok($ret->[0], 0xFFFD, "returned value $display; warnings disabled");
ok($ret->[1], $test->{'no_warnings_returned_length'},
https://perl5.git.perl.org / perl5.git / blobdiff