This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use utf8_to_uvchr_buf()
[perl5.git] / dist / Devel-PPPort / parts / inc / uv
CommitLineData
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 15my_strnlen
679ad62d 16SvUOK
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
64STRLEN
65my_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
96SV *
97sv_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
105SV *
106newSVuv(uv)
b2049988
MHM
107 UV uv
108 CODE:
109 RETVAL = newSVuv(uv);
110 OUTPUT:
111 RETVAL
adfe19db
MHM
112
113UV
114sv_2uv(sv)
b2049988
MHM
115 SV *sv
116 CODE:
117 RETVAL = sv_2uv(sv);
118 OUTPUT:
119 RETVAL
adfe19db
MHM
120
121UV
122SvUVx(sv)
b2049988
MHM
123 SV *sv
124 CODE:
125 sv--;
126 RETVAL = SvUVx(++sv);
127 OUTPUT:
128 RETVAL
adfe19db
MHM
129
130void
131XSRETURN_UV()
b2049988
MHM
132 PPCODE:
133 XSRETURN_UV(42);
adfe19db 134
96ad942f
MHM
135void
136PUSHu()
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
145void
146XPUSHu()
b2049988
MHM
147 PREINIT:
148 dTARG;
149 PPCODE:
150 TARG = sv_newmortal();
151 XPUSHu(43);
152 XSRETURN(1);
96ad942f 153
f2e3e4ce
KW
154STRLEN
155UTF8_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
164STRLEN
165my_strnlen(s, max)
166 char * s
167 STRLEN max
168 CODE:
169 RETVAL= my_strnlen(s, max);
170 OUTPUT:
171 RETVAL
172
4c28bdc5
KW
173AV *
174utf8_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
189ok(&Devel::PPPort::sv_setuv(42), 42);
190ok(&Devel::PPPort::newSVuv(123), 123);
191ok(&Devel::PPPort::sv_2uv("4711"), 4711);
192ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559);
193ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559);
194ok(&Devel::PPPort::SvUVx(1735928559), 1735928559);
195ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
196ok(&Devel::PPPort::XSRETURN_UV(), 42);
96ad942f
MHM
197ok(&Devel::PPPort::PUSHu(), 42);
198ok(&Devel::PPPort::XPUSHu(), 43);
f2e3e4ce
KW
199ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
200ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
e28192fd 201ok(&Devel::PPPort::my_strnlen("abc\0def", 7), 3);
4c28bdc5
KW
202my $ret = &Devel::PPPort::utf8_to_uvchr_buf("A");
203ok($ret->[0], ord("A"));
204ok($ret->[1], 1);
205$ret = &Devel::PPPort::utf8_to_uvchr_buf("\0");
206ok($ret->[0], 0);
207ok($ret->[1], 1);