This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Regression tests for, and fix quite a lot of bugs in, cases FF_LINESNGL
[perl5.git] / ext / Devel / PPPort / parts / inc / misc
CommitLineData
adfe19db
MHM
1################################################################################
2##
1d175cda 3## $Revision: 45 $
adfe19db 4## $Author: mhx $
1d175cda 5## $Date: 2008/01/04 15:50:58 +0100 $
adfe19db
MHM
6##
7################################################################################
8##
c1a049cb 9## Version 3.x, Copyright (C) 2004-2008, Marcus Holland-Moritz.
adfe19db
MHM
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__
21PERL_UNUSED_DECL
f2ab5a41
MHM
22PERL_UNUSED_ARG
23PERL_UNUSED_VAR
24PERL_UNUSED_CONTEXT
a745474a 25PERL_GCC_BRACE_GROUPS_FORBIDDEN
c07deaaf 26PERL_USE_GCC_BRACE_GROUPS
adfe19db
MHM
27NVTYPE
28INT2PTR
29PTRV
30NUM2PTR
c83e6f19 31PERL_HASH
adfe19db
MHM
32PTR2IV
33PTR2UV
34PTR2NV
35PTR2ul
a745474a
MHM
36START_EXTERN_C
37END_EXTERN_C
38EXTERN_C
39STMT_START
40STMT_END
679ad62d 41UTF8_MAXBYTES
0d0f8426 42XSRETURN
adfe19db
MHM
43
44=implementation
45
62093c1c
NC
46#ifndef PERL_UNUSED_DECL
47# ifdef HASATTRIBUTE
48# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
49# define PERL_UNUSED_DECL
50# else
51# define PERL_UNUSED_DECL __attribute__((unused))
52# endif
adfe19db 53# else
62093c1c 54# define PERL_UNUSED_DECL
adfe19db 55# endif
adfe19db
MHM
56#endif
57
f2ab5a41
MHM
58#ifndef PERL_UNUSED_ARG
59# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
60# include <note.h>
61# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
62# else
63# define PERL_UNUSED_ARG(x) ((void)x)
64# endif
65#endif
66
67#ifndef PERL_UNUSED_VAR
68# define PERL_UNUSED_VAR(x) ((void)x)
69#endif
70
71#ifndef PERL_UNUSED_CONTEXT
72# ifdef USE_ITHREADS
73# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
74# else
75# define PERL_UNUSED_CONTEXT
76# endif
77#endif
78
79__UNDEFINED__ NOOP /*EMPTY*/(void)0
80__UNDEFINED__ dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
adfe19db
MHM
81
82#ifndef NVTYPE
83# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
84# define NVTYPE long double
85# else
86# define NVTYPE double
87# endif
88typedef NVTYPE NV;
89#endif
90
91#ifndef INT2PTR
92
93# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
94# define PTRV UV
95# define INT2PTR(any,d) (any)(d)
96# else
97# if PTRSIZE == LONGSIZE
98# define PTRV unsigned long
99# else
100# define PTRV unsigned
101# endif
102# define INT2PTR(any,d) (any)(PTRV)(d)
103# endif
104
105# define NUM2PTR(any,d) (any)(PTRV)(d)
106# define PTR2IV(p) INT2PTR(IV,p)
107# define PTR2UV(p) INT2PTR(UV,p)
108# define PTR2NV(p) NUM2PTR(NV,p)
109
110# if PTRSIZE == LONGSIZE
111# define PTR2ul(p) (unsigned long)(p)
112# else
4a582685 113# define PTR2ul(p) INT2PTR(unsigned long,p)
adfe19db
MHM
114# endif
115
116#endif /* !INT2PTR */
117
a745474a
MHM
118#undef START_EXTERN_C
119#undef END_EXTERN_C
120#undef EXTERN_C
121#ifdef __cplusplus
122# define START_EXTERN_C extern "C" {
123# define END_EXTERN_C }
124# define EXTERN_C extern "C"
125#else
126# define START_EXTERN_C
127# define END_EXTERN_C
128# define EXTERN_C extern
129#endif
130
c07deaaf
MHM
131#if defined(PERL_GCC_PEDANTIC)
132# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
a745474a
MHM
133# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
134# endif
135#endif
136
c07deaaf
MHM
137#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
138# ifndef PERL_USE_GCC_BRACE_GROUPS
139# define PERL_USE_GCC_BRACE_GROUPS
140# endif
141#endif
142
a745474a
MHM
143#undef STMT_START
144#undef STMT_END
c07deaaf 145#ifdef PERL_USE_GCC_BRACE_GROUPS
a745474a
MHM
146# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
147# define STMT_END )
148#else
149# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
150# define STMT_START if (1)
151# define STMT_END else (void)0
152# else
153# define STMT_START do
154# define STMT_END while (0)
155# endif
156#endif
157
adfe19db
MHM
158__UNDEFINED__ boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
159
160/* DEFSV appears first in 5.004_56 */
161__UNDEFINED__ DEFSV GvSV(PL_defgv)
162__UNDEFINED__ SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
163
164/* Older perls (<=5.003) lack AvFILLp */
165__UNDEFINED__ AvFILLp AvFILL
166
167__UNDEFINED__ ERRSV get_sv("@",FALSE)
168
adfe19db
MHM
169/* Hint: gv_stashpvn
170 * This function's backport doesn't support the length parameter, but
171 * rather ignores it. Portability can only be ensured if the length
172 * parameter is used for speed reasons, but the length can always be
173 * correctly computed from the string argument.
174 */
175
176__UNDEFINED__ gv_stashpvn(str,len,create) gv_stashpv(str,create)
177
178/* Replace: 1 */
179__UNDEFINED__ get_cv perl_get_cv
180__UNDEFINED__ get_sv perl_get_sv
181__UNDEFINED__ get_av perl_get_av
182__UNDEFINED__ get_hv perl_get_hv
183/* Replace: 0 */
184
adfe19db
MHM
185__UNDEFINED__ dUNDERBAR dNOOP
186__UNDEFINED__ UNDERBAR DEFSV
187
188__UNDEFINED__ dAX I32 ax = MARK - PL_stack_base + 1
189__UNDEFINED__ dITEMS I32 items = SP - MARK
190
9132e1a3
MHM
191__UNDEFINED__ dXSTARG SV * targ = sv_newmortal()
192
0d0f8426
MHM
193__UNDEFINED__ dAXMARK I32 ax = POPMARK; \
194 register SV ** const mark = PL_stack_base + ax++
195
196
197__UNDEFINED__ XSprePUSH (sp = PL_stack_base + ax - 1)
198
199#if { VERSION < 5.005 }
200# undef XSRETURN
201# define XSRETURN(off) \
202 STMT_START { \
203 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
204 return; \
205 } STMT_END
206#endif
207
f2ab5a41
MHM
208__UNDEFINED__ PERL_ABS(x) ((x) < 0 ? -(x) : (x))
209
210__UNDEFINED__ dVAR dNOOP
211
212__UNDEFINED__ SVf "_"
213
c83e6f19
MHM
214__UNDEFINED__ UTF8_MAXBYTES UTF8_MAXLEN
215
216__UNDEFINED__ PERL_HASH(hash,str,len) \
217 STMT_START { \
218 const char *s_PeRlHaSh = str; \
219 I32 i_PeRlHaSh = len; \
220 U32 hash_PeRlHaSh = 0; \
221 while (i_PeRlHaSh--) \
222 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
223 (hash) = hash_PeRlHaSh; \
224 } STMT_END
679ad62d 225
9132e1a3
MHM
226=xsmisc
227
228XS(XS_Devel__PPPort_dXSTARG); /* prototype */
229XS(XS_Devel__PPPort_dXSTARG)
230{
231 dXSARGS;
232 dXSTARG;
2dd69576 233 IV iv;
9132e1a3 234 SP -= items;
2dd69576 235 iv = SvIV(ST(0)) + 1;
9132e1a3
MHM
236 PUSHi(iv);
237 XSRETURN(1);
238}
239
0d0f8426
MHM
240XS(XS_Devel__PPPort_dAXMARK); /* prototype */
241XS(XS_Devel__PPPort_dAXMARK)
242{
243 dSP;
244 dAXMARK;
245 dITEMS;
246 IV iv;
247 SP -= items;
248 iv = SvIV(ST(0)) - 1;
c1a049cb 249 mPUSHi(iv);
0d0f8426
MHM
250 XSRETURN(1);
251}
252
9132e1a3
MHM
253=xsboot
254
255newXS("Devel::PPPort::dXSTARG", XS_Devel__PPPort_dXSTARG, file);
0d0f8426 256newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file);
9132e1a3 257
adfe19db
MHM
258=xsubs
259
260int
261gv_stashpvn(name, create)
262 char *name
263 I32 create
264 CODE:
265 RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
266 OUTPUT:
267 RETVAL
268
269int
270get_sv(name, create)
271 char *name
272 I32 create
273 CODE:
274 RETVAL = get_sv(name, create) != NULL;
275 OUTPUT:
276 RETVAL
277
278int
279get_av(name, create)
280 char *name
281 I32 create
282 CODE:
283 RETVAL = get_av(name, create) != NULL;
284 OUTPUT:
285 RETVAL
286
287int
288get_hv(name, create)
289 char *name
290 I32 create
291 CODE:
292 RETVAL = get_hv(name, create) != NULL;
293 OUTPUT:
294 RETVAL
295
296int
297get_cv(name, create)
298 char *name
299 I32 create
300 CODE:
301 RETVAL = get_cv(name, create) != NULL;
302 OUTPUT:
303 RETVAL
304
305void
0d0f8426
MHM
306xsreturn(two)
307 int two
308 PPCODE:
c1a049cb 309 mXPUSHp("test1", 5);
0d0f8426 310 if (two)
c1a049cb 311 mXPUSHp("test2", 5);
0d0f8426
MHM
312 if (two)
313 XSRETURN(2);
314 else
315 XSRETURN(1);
316
adfe19db
MHM
317SV*
318boolSV(value)
319 int value
320 CODE:
321 RETVAL = newSVsv(boolSV(value));
322 OUTPUT:
323 RETVAL
324
325SV*
326DEFSV()
327 CODE:
328 RETVAL = newSVsv(DEFSV);
329 OUTPUT:
330 RETVAL
331
332int
333ERRSV()
334 CODE:
335 RETVAL = SvTRUE(ERRSV);
336 OUTPUT:
337 RETVAL
338
339SV*
340UNDERBAR()
341 CODE:
342 {
343 dUNDERBAR;
344 RETVAL = newSVsv(UNDERBAR);
345 }
346 OUTPUT:
347 RETVAL
348
0d0f8426
MHM
349void
350prepush()
351 CODE:
352 {
353 dXSTARG;
354 XSprePUSH;
1d175cda 355 PUSHi(42);
0d0f8426
MHM
356 XSRETURN(1);
357 }
358
f2ab5a41
MHM
359int
360PERL_ABS(a)
361 int a
362
363void
364SVf(x)
365 SV *x
366 PPCODE:
367#if { VERSION >= 5.004 }
c1a049cb 368 x = sv_2mortal(newSVpvf("[%"SVf"]", x));
f2ab5a41
MHM
369#endif
370 XPUSHs(x);
371 XSRETURN(1);
372
c1a049cb 373=tests plan => 32
adfe19db
MHM
374
375use vars qw($my_sv @my_av %my_hv);
376
adfe19db
MHM
377ok(&Devel::PPPort::boolSV(1));
378ok(!&Devel::PPPort::boolSV(0));
379
380$_ = "Fred";
381ok(&Devel::PPPort::DEFSV(), "Fred");
382ok(&Devel::PPPort::UNDERBAR(), "Fred");
383
0d0f8426
MHM
384if ($] >= 5.009002) {
385 eval q{
386 my $_ = "Tony";
387 ok(&Devel::PPPort::DEFSV(), "Fred");
388 ok(&Devel::PPPort::UNDERBAR(), "Tony");
389 };
390}
391else {
392 ok(1);
393 ok(1);
394}
395
adfe19db
MHM
396eval { 1 };
397ok(!&Devel::PPPort::ERRSV());
398eval { cannot_call_this_one() };
399ok(&Devel::PPPort::ERRSV());
400
401ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
402ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
403ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1));
404
405$my_sv = 1;
406ok(&Devel::PPPort::get_sv('my_sv', 0));
407ok(!&Devel::PPPort::get_sv('not_my_sv', 0));
408ok(&Devel::PPPort::get_sv('not_my_sv', 1));
409
410@my_av = (1);
411ok(&Devel::PPPort::get_av('my_av', 0));
412ok(!&Devel::PPPort::get_av('not_my_av', 0));
413ok(&Devel::PPPort::get_av('not_my_av', 1));
414
415%my_hv = (a=>1);
416ok(&Devel::PPPort::get_hv('my_hv', 0));
417ok(!&Devel::PPPort::get_hv('not_my_hv', 0));
418ok(&Devel::PPPort::get_hv('not_my_hv', 1));
419
420sub my_cv { 1 };
421ok(&Devel::PPPort::get_cv('my_cv', 0));
422ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
423ok(&Devel::PPPort::get_cv('not_my_cv', 1));
424
9132e1a3 425ok(Devel::PPPort::dXSTARG(42), 43);
0d0f8426
MHM
426ok(Devel::PPPort::dAXMARK(4711), 4710);
427
428ok(Devel::PPPort::prepush(), 42);
9132e1a3 429
0d0f8426
MHM
430ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
431ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
f2ab5a41
MHM
432
433ok(Devel::PPPort::PERL_ABS(42), 42);
434ok(Devel::PPPort::PERL_ABS(-13), 13);
435
436ok(Devel::PPPort::SVf(42), $] >= 5.004 ? '[42]' : '42');
437ok(Devel::PPPort::SVf('abc'), $] >= 5.004 ? '[abc]' : 'abc');
438