1################################################################################
2##
3##  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
4##  Version 2.x, Copyright (C) 2001, Paul Marquess.
5##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
6##
7##  This program is free software; you can redistribute it and/or
8##  modify it under the same terms as Perl itself.
9##
10################################################################################
11
12=provides
13
14__UNDEFINED__
15newSVpvn_flags
16
17=implementation
18
19#if { VERSION < 5.6.0 }
20# define D_PPP_CONSTPV_ARG(x)  ((char *) (x))
21#else
22# define D_PPP_CONSTPV_ARG(x)  (x)
23#endif
24
25__UNDEFINED__  newSVpvn(data,len)  ((data)                                              \
26                                    ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
27                                    : newSV(0))
28
29__UNDEFINED__  newSVpvn_utf8(s, len, u)  newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
30
31__UNDEFINED__  SVf_UTF8  0
32
33#ifndef newSVpvn_flags
34#  if defined(PERL_USE_GCC_BRACE_GROUPS)
35#    define newSVpvn_flags(s, len, flags)                       \
36        ({                                                      \
37            SV * sv = newSVpvn(D_PPP_CONSTPV_ARG(s), (len));    \
38            SvFLAGS(sv) |= ((flags) & SVf_UTF8);                \
39            if ((flags) & SVs_TEMP) sv = sv_2mortal(sv);        \
40            sv;                                                 \
41        })
42#  else
43     PERL_STATIC_INLINE SV* D_PPP_newSVpvn_flags(const char *const s, const STRLEN len, const U32 flags)
44     {
45        dTHX;
46        SV * sv = newSVpvn(s, len);
47        SvFLAGS(sv) |= (flags & SVf_UTF8);
48        if (flags & SVs_TEMP) return sv_2mortal(sv);
49        return sv;
50     }
51#    define newSVpvn_flags(s, len, flags) D_PPP_newSVpvn_flags((s), (len), (flags))
52#  endif
53#endif
54
55=xsubs
56
57void
58newSVpvn()
59        PPCODE:
60                mXPUSHs(newSVpvn("test", 4));
61                mXPUSHs(newSVpvn("test", 2));
62                mXPUSHs(newSVpvn("test", 0));
63                mXPUSHs(newSVpvn(NULL, 2));
64                mXPUSHs(newSVpvn(NULL, 0));
65                XSRETURN(5);
66
67void
68newSVpvn_flags()
69        PPCODE:
70                XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP));
71                XPUSHs(newSVpvn_flags("test", 2, SVs_TEMP));
72                XPUSHs(newSVpvn_flags("test", 0, SVs_TEMP));
73                XPUSHs(newSVpvn_flags(NULL, 2, SVs_TEMP));
74                XPUSHs(newSVpvn_flags(NULL, 0, SVs_TEMP));
75                XSRETURN(5);
76
77void
78newSVpvn_utf8()
79        PPCODE:
80                XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP|SVf_UTF8));
81                XSRETURN(1);
82
83=tests plan => 15
84
85my @s = &Devel::PPPort::newSVpvn();
86ok(@s == 5);
87is($s[0], "test");
88is($s[1], "te");
89is($s[2], "");
90ok(!defined($s[3]));
91ok(!defined($s[4]));
92
93@s = &Devel::PPPort::newSVpvn_flags();
94ok(@s == 5);
95is($s[0], "test");
96is($s[1], "te");
97is($s[2], "");
98ok(!defined($s[3]));
99ok(!defined($s[4]));
100
101@s = &Devel::PPPort::newSVpvn_utf8();
102ok(@s == 1);
103is($s[0], "test");
104
105if (ivers($]) >= ivers("5.008001")) {
106  require utf8;
107  ok(utf8::is_utf8($s[0]));
108}
109else {
110  skip("skip: no is_utf8()", 1);
111}
112