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