Commit | Line | Data |
---|---|---|
adfe19db MHM |
1 | ################################################################################ |
2 | ## | |
b2049988 | 3 | ## Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz. |
adfe19db MHM |
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 | ||
adfe19db | 14 | __UNDEFINED__ |
e28192fd | 15 | my_strnlen |
679ad62d | 16 | SvUOK |
adfe19db MHM |
17 | |
18 | =implementation | |
19 | ||
0d0f8426 MHM |
20 | __UNDEFINED__ sv_setuv(sv, uv) \ |
21 | STMT_START { \ | |
22 | UV TeMpUv = uv; \ | |
23 | if (TeMpUv <= IV_MAX) \ | |
24 | sv_setiv(sv, TeMpUv); \ | |
25 | else \ | |
26 | sv_setnv(sv, (double)TeMpUv); \ | |
27 | } STMT_END | |
28 | ||
29 | __UNDEFINED__ newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv)) | |
adfe19db MHM |
30 | |
31 | __UNDEFINED__ sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) | |
32 | __UNDEFINED__ SvUVX(sv) ((UV)SvIVX(sv)) | |
33 | __UNDEFINED__ SvUVXx(sv) SvUVX(sv) | |
34 | __UNDEFINED__ SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) | |
35 | __UNDEFINED__ SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) | |
36 | ||
37 | /* Hint: sv_uv | |
38 | * Always use the SvUVx() macro instead of sv_uv(). | |
39 | */ | |
40 | __UNDEFINED__ sv_uv(sv) SvUVx(sv) | |
41 | ||
679ad62d MHM |
42 | #if !defined(SvUOK) && defined(SvIOK_UV) |
43 | # define SvUOK(sv) SvIOK_UV(sv) | |
44 | #endif | |
45 | ||
adfe19db MHM |
46 | __UNDEFINED__ XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) |
47 | __UNDEFINED__ XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END | |
48 | ||
96ad942f MHM |
49 | __UNDEFINED__ PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END |
50 | __UNDEFINED__ XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END | |
51 | ||
f2e3e4ce KW |
52 | #if defined UTF8SKIP |
53 | __UNDEFINED__ UTF8_SAFE_SKIP(s, e) (__ASSERT_((e) >= (s)) \ | |
54 | ((e) - (s)) <= 0 \ | |
55 | ? 0 \ | |
56 | : (((e) - (s)) >= UTF8SKIP(s)) \ | |
57 | ? ((e) - (s)) \ | |
58 | : UTF8SKIP(s)) | |
59 | #endif | |
60 | ||
e28192fd KW |
61 | #if !defined(my_strnlen) |
62 | #if { NEED my_strnlen } | |
63 | ||
64 | STRLEN | |
65 | my_strnlen(const char *str, Size_t maxlen) | |
66 | { | |
67 | const char *p = str; | |
68 | ||
69 | while(maxlen-- && *p) | |
70 | p++; | |
71 | ||
72 | return p - str; | |
73 | } | |
74 | ||
75 | #endif | |
76 | #endif | |
4c28bdc5 KW |
77 | #if defined(utf8n_to_uvchr) |
78 | ||
79 | __UNDEFINED__ utf8_to_uvchr_buf(s,e,lp) (__ASSERT_(e >= s) \ | |
80 | utf8n_to_uvchr((s), ((e)-(s)), (lp), \ | |
81 | (UTF8_ALLOW_ANYUV & ~UTF8_ALLOW_LONG))) | |
82 | ||
83 | #elif defined(utf8_to_uv) | |
84 | ||
85 | __UNDEFINED__ utf8_to_uvchr_buf(s,e,lp) (__ASSERT_(e >= s) \ | |
86 | utf8_to_uv((s), ((e)-(s)), (lp), \ | |
87 | (UTF8_ALLOW_ANYUV & ~UTF8_ALLOW_LONG))) | |
88 | #endif | |
e28192fd KW |
89 | |
90 | =xsinit | |
91 | ||
92 | #define NEED_my_strnlen | |
93 | ||
adfe19db MHM |
94 | =xsubs |
95 | ||
96 | SV * | |
97 | sv_setuv(uv) | |
b2049988 MHM |
98 | UV uv |
99 | CODE: | |
100 | RETVAL = newSViv(1); | |
101 | sv_setuv(RETVAL, uv); | |
102 | OUTPUT: | |
103 | RETVAL | |
adfe19db MHM |
104 | |
105 | SV * | |
106 | newSVuv(uv) | |
b2049988 MHM |
107 | UV uv |
108 | CODE: | |
109 | RETVAL = newSVuv(uv); | |
110 | OUTPUT: | |
111 | RETVAL | |
adfe19db MHM |
112 | |
113 | UV | |
114 | sv_2uv(sv) | |
b2049988 MHM |
115 | SV *sv |
116 | CODE: | |
117 | RETVAL = sv_2uv(sv); | |
118 | OUTPUT: | |
119 | RETVAL | |
adfe19db MHM |
120 | |
121 | UV | |
122 | SvUVx(sv) | |
b2049988 MHM |
123 | SV *sv |
124 | CODE: | |
125 | sv--; | |
126 | RETVAL = SvUVx(++sv); | |
127 | OUTPUT: | |
128 | RETVAL | |
adfe19db MHM |
129 | |
130 | void | |
131 | XSRETURN_UV() | |
b2049988 MHM |
132 | PPCODE: |
133 | XSRETURN_UV(42); | |
adfe19db | 134 | |
96ad942f MHM |
135 | void |
136 | PUSHu() | |
b2049988 MHM |
137 | PREINIT: |
138 | dTARG; | |
139 | PPCODE: | |
140 | TARG = sv_newmortal(); | |
141 | EXTEND(SP, 1); | |
142 | PUSHu(42); | |
143 | XSRETURN(1); | |
96ad942f MHM |
144 | |
145 | void | |
146 | XPUSHu() | |
b2049988 MHM |
147 | PREINIT: |
148 | dTARG; | |
149 | PPCODE: | |
150 | TARG = sv_newmortal(); | |
151 | XPUSHu(43); | |
152 | XSRETURN(1); | |
96ad942f | 153 | |
f2e3e4ce KW |
154 | STRLEN |
155 | UTF8_SAFE_SKIP(s, adjustment) | |
156 | unsigned char * s | |
157 | int adjustment | |
158 | CODE: | |
159 | /* Instead of passing in an 'e' ptr, use the real end, adjusted */ | |
160 | RETVAL = UTF8_SAFE_SKIP(s, s + UTF8SKIP(s) + adjustment); | |
161 | OUTPUT: | |
162 | RETVAL | |
163 | ||
e28192fd KW |
164 | STRLEN |
165 | my_strnlen(s, max) | |
166 | char * s | |
167 | STRLEN max | |
168 | CODE: | |
169 | RETVAL= my_strnlen(s, max); | |
170 | OUTPUT: | |
171 | RETVAL | |
172 | ||
4c28bdc5 KW |
173 | AV * |
174 | utf8_to_uvchr_buf(s) | |
175 | unsigned char *s | |
176 | PREINIT: | |
177 | AV *av; | |
178 | STRLEN len; | |
179 | CODE: | |
180 | av = newAV(); | |
181 | av_push(av, newSVuv(utf8_to_uvchr_buf(s, s + UTF8SKIP(s), &len))); | |
182 | av_push(av, newSVuv(len)); | |
183 | RETVAL = av; | |
184 | OUTPUT: | |
185 | RETVAL | |
186 | ||
187 | =tests plan => 17 | |
adfe19db MHM |
188 | |
189 | ok(&Devel::PPPort::sv_setuv(42), 42); | |
190 | ok(&Devel::PPPort::newSVuv(123), 123); | |
191 | ok(&Devel::PPPort::sv_2uv("4711"), 4711); | |
192 | ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559); | |
193 | ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559); | |
194 | ok(&Devel::PPPort::SvUVx(1735928559), 1735928559); | |
195 | ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef); | |
196 | ok(&Devel::PPPort::XSRETURN_UV(), 42); | |
96ad942f MHM |
197 | ok(&Devel::PPPort::PUSHu(), 42); |
198 | ok(&Devel::PPPort::XPUSHu(), 43); | |
f2e3e4ce KW |
199 | ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1); |
200 | ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0); | |
e28192fd | 201 | ok(&Devel::PPPort::my_strnlen("abc\0def", 7), 3); |
4c28bdc5 KW |
202 | my $ret = &Devel::PPPort::utf8_to_uvchr_buf("A"); |
203 | ok($ret->[0], ord("A")); | |
204 | ok($ret->[1], 1); | |
205 | $ret = &Devel::PPPort::utf8_to_uvchr_buf("\0"); | |
206 | ok($ret->[0], 0); | |
207 | ok($ret->[1], 1); |