1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
################################################################################
##
## $Revision: 6 $
## $Author: mhx $
## $Date: 2009/01/18 14:10:51 +0100 $
##
################################################################################
##
## Version 3.x, Copyright (C) 2004-2009, 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);
}
|
