110 lines
2.5 KiB
Plaintext
110 lines
2.5 KiB
Plaintext
################################################################################
|
|
##
|
|
## Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
|
|
## Version 2.x, Copyright (C) 2001, Paul Marquess.
|
|
## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
|
|
##
|
|
## This program is free software; you can redistribute it and/or
|
|
## modify it under the same terms as Perl itself.
|
|
##
|
|
################################################################################
|
|
|
|
=provides
|
|
|
|
__UNDEFINED__
|
|
newSVpvn_flags
|
|
|
|
=implementation
|
|
|
|
#if { VERSION < 5.6.0 }
|
|
# define D_PPP_CONSTPV_ARG(x) ((char *) (x))
|
|
#else
|
|
# define D_PPP_CONSTPV_ARG(x) (x)
|
|
#endif
|
|
|
|
__UNDEFINED__ newSVpvn(data,len) ((data) \
|
|
? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
|
|
: newSV(0))
|
|
|
|
__UNDEFINED__ newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
|
|
|
|
__UNDEFINED__ SVf_UTF8 0
|
|
|
|
#ifndef newSVpvn_flags
|
|
|
|
#if { NEED newSVpvn_flags }
|
|
|
|
SV *
|
|
newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags)
|
|
{
|
|
SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
|
|
SvFLAGS(sv) |= (flags & SVf_UTF8);
|
|
return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
|
|
}
|
|
|
|
#endif
|
|
|
|
#endif
|
|
|
|
=xsinit
|
|
|
|
#define NEED_newSVpvn_flags
|
|
|
|
=xsubs
|
|
|
|
void
|
|
newSVpvn()
|
|
PPCODE:
|
|
mXPUSHs(newSVpvn("test", 4));
|
|
mXPUSHs(newSVpvn("test", 2));
|
|
mXPUSHs(newSVpvn("test", 0));
|
|
mXPUSHs(newSVpvn(NULL, 2));
|
|
mXPUSHs(newSVpvn(NULL, 0));
|
|
XSRETURN(5);
|
|
|
|
void
|
|
newSVpvn_flags()
|
|
PPCODE:
|
|
XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP));
|
|
XPUSHs(newSVpvn_flags("test", 2, SVs_TEMP));
|
|
XPUSHs(newSVpvn_flags("test", 0, SVs_TEMP));
|
|
XPUSHs(newSVpvn_flags(NULL, 2, SVs_TEMP));
|
|
XPUSHs(newSVpvn_flags(NULL, 0, SVs_TEMP));
|
|
XSRETURN(5);
|
|
|
|
void
|
|
newSVpvn_utf8()
|
|
PPCODE:
|
|
XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP|SVf_UTF8));
|
|
XSRETURN(1);
|
|
|
|
=tests plan => 15
|
|
|
|
my @s = &Devel::PPPort::newSVpvn();
|
|
ok(@s == 5);
|
|
ok($s[0], "test");
|
|
ok($s[1], "te");
|
|
ok($s[2], "");
|
|
ok(!defined($s[3]));
|
|
ok(!defined($s[4]));
|
|
|
|
@s = &Devel::PPPort::newSVpvn_flags();
|
|
ok(@s == 5);
|
|
ok($s[0], "test");
|
|
ok($s[1], "te");
|
|
ok($s[2], "");
|
|
ok(!defined($s[3]));
|
|
ok(!defined($s[4]));
|
|
|
|
@s = &Devel::PPPort::newSVpvn_utf8();
|
|
ok(@s == 1);
|
|
ok($s[0], "test");
|
|
|
|
if ("$]" >= 5.008001) {
|
|
require utf8;
|
|
ok(utf8::is_utf8($s[0]));
|
|
}
|
|
else {
|
|
skip("skip: no is_utf8()", 0);
|
|
}
|