################################################################################

##

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

}