################################################################################
##
##  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 defined(PERL_USE_GCC_BRACE_GROUPS)
#    define newSVpvn_flags(s, len, flags)                       \
        ({                                                      \
            SV * sv = newSVpvn(D_PPP_CONSTPV_ARG(s), (len));    \
            SvFLAGS(sv) |= ((flags) & SVf_UTF8);                \
            if ((flags) & SVs_TEMP) sv = sv_2mortal(sv);        \
            sv;                                                 \
        })
#  else
     PERL_STATIC_INLINE SV* D_PPP_newSVpvn_flags(const char *const s, const STRLEN len, const U32 flags)
     {
        dTHX;
        SV * sv = newSVpvn(s, len);
        SvFLAGS(sv) |= (flags & SVf_UTF8);
        if (flags & SVs_TEMP) return sv_2mortal(sv);
        return sv;
     }
#    define newSVpvn_flags(s, len, flags) D_PPP_newSVpvn_flags((s), (len), (flags))
#  endif
#endif

=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);
is($s[0], "test");
is($s[1], "te");
is($s[2], "");
ok(!defined($s[3]));
ok(!defined($s[4]));

@s = &Devel::PPPort::newSVpvn_flags();
ok(@s == 5);
is($s[0], "test");
is($s[1], "te");
is($s[2], "");
ok(!defined($s[3]));
ok(!defined($s[4]));

@s = &Devel::PPPort::newSVpvn_utf8();
ok(@s == 1);
is($s[0], "test");

if (ivers($]) >= ivers("5.008001")) {
  require utf8;
  ok(utf8::is_utf8($s[0]));
}
else {
  skip("skip: no is_utf8()", 1);
}