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
35#if { NEED newSVpvn_flags }
36
37SV *
38newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags)
39{
40  SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
41  SvFLAGS(sv) |= (flags & SVf_UTF8);
42  return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
43}
44
45#endif
46
47#endif
48
49=xsinit
50
51#define NEED_newSVpvn_flags
52
53=xsubs
54
55void
56newSVpvn()
57        PPCODE:
58                mXPUSHs(newSVpvn("test", 4));
59                mXPUSHs(newSVpvn("test", 2));
60                mXPUSHs(newSVpvn("test", 0));
61                mXPUSHs(newSVpvn(NULL, 2));
62                mXPUSHs(newSVpvn(NULL, 0));
63                XSRETURN(5);
64
65void
66newSVpvn_flags()
67        PPCODE:
68                XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP));
69                XPUSHs(newSVpvn_flags("test", 2, SVs_TEMP));
70                XPUSHs(newSVpvn_flags("test", 0, SVs_TEMP));
71                XPUSHs(newSVpvn_flags(NULL, 2, SVs_TEMP));
72                XPUSHs(newSVpvn_flags(NULL, 0, SVs_TEMP));
73                XSRETURN(5);
74
75void
76newSVpvn_utf8()
77        PPCODE:
78                XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP|SVf_UTF8));
79                XSRETURN(1);
80
81=tests plan => 15
82
83my @s = &Devel::PPPort::newSVpvn();
84ok(@s == 5);
85ok($s[0], "test");
86ok($s[1], "te");
87ok($s[2], "");
88ok(!defined($s[3]));
89ok(!defined($s[4]));
90
91@s = &Devel::PPPort::newSVpvn_flags();
92ok(@s == 5);
93ok($s[0], "test");
94ok($s[1], "te");
95ok($s[2], "");
96ok(!defined($s[3]));
97ok(!defined($s[4]));
98
99@s = &Devel::PPPort::newSVpvn_utf8();
100ok(@s == 1);
101ok($s[0], "test");
102
103if ($] >= 5.008001) {
104  require utf8;
105  ok(utf8::is_utf8($s[0]));
106}
107else {
108  skip("skip: no is_utf8()", 0);
109}
110