Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
HvNAME	961 B	-r--r--r--	2014-12-27 11:48
MY_CXT	5.02 KB	-r--r--r--	2014-12-27 11:48
SvPV	14.47 KB	-r--r--r--	2014-12-27 11:49
SvREFCNT	3.78 KB	-r--r--r--	2014-12-27 11:48
Sv_set	2.93 KB	-r--r--r--	2014-12-27 11:48
call	9.12 KB	-r--r--r--	2014-12-27 11:49
cop	2.76 KB	-r--r--r--	2014-12-27 11:49
exception	1.66 KB	-r--r--r--	2014-12-27 11:48
format	1.56 KB	-r--r--r--	2014-12-27 11:48
grok	20.45 KB	-r--r--r--	2014-12-27 11:49
gv	2.8 KB	-r--r--r--	2014-12-27 11:48
limits	7.25 KB	-r--r--r--	2014-12-27 11:48
mPUSH	3.27 KB	-r--r--r--	2014-12-27 11:48
magic	10.14 KB	-r--r--r--	2014-12-27 11:49
memory	2.24 KB	-r--r--r--	2014-12-27 11:48
misc	13.64 KB	-r--r--r--	2014-12-27 11:49
newCONSTSUB	2.54 KB	-r--r--r--	2014-12-27 11:48
newRV	1.4 KB	-r--r--r--	2014-12-27 11:48
newSV_type	1.61 KB	-r--r--r--	2014-12-27 11:48
newSVpv	2.53 KB	-r--r--r--	2014-12-27 11:48
podtest	1.07 KB	-r--r--r--	2014-12-27 11:48
ppphbin	20.5 KB	-r--r--r--	2014-12-27 11:48
ppphdoc	9.64 KB	-r--r--r--	2014-12-27 11:49
ppphtest	21.33 KB	-r--r--r--	2014-12-27 11:49
pv_tools	8.35 KB	-r--r--r--	2014-12-27 11:49
pvs	4.3 KB	-r--r--r--	2014-12-27 11:48
shared_pv	2.14 KB	-r--r--r--	2014-12-27 11:48
snprintf	1.39 KB	-r--r--r--	2014-12-27 11:48
sprintf	1.12 KB	-r--r--r--	2014-12-27 11:48
strlfuncs	2.47 KB	-r--r--r--	2014-12-27 11:48
sv_xpvf	6.98 KB	-r--r--r--	2014-12-27 11:48
threads	1.34 KB	-r--r--r--	2014-12-27 11:48
uv	3.21 KB	-r--r--r--	2014-12-27 11:48
variables	13.2 KB	-r--r--r--	2014-12-27 11:49
version	1.56 KB	-r--r--r--	2014-12-27 11:48
warn	4.36 KB	-r--r--r--	2014-12-27 11:48

Rename

################################################################################
##
##  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

=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);
}