projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Upgrade to Devel::PPPort 3.08_01
[p5sagit/p5-mst-13.2.git] / ext / Devel / PPPort / parts / inc / misc
CommitLineData
adfe19db 1################################################################################
2##
f2ab5a41 3## $Revision: 35 $
adfe19db 4## $Author: mhx $
f2ab5a41 5## $Date: 2006/05/19 23:57:26 +0200 $
adfe19db 6##
7################################################################################
8##
0d0f8426 9## Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
adfe19db 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 22PERL_UNUSED_ARG
23PERL_UNUSED_VAR
24PERL_UNUSED_CONTEXT
a745474a 25PERL_GCC_BRACE_GROUPS_FORBIDDEN
adfe19db 26NVTYPE
27INT2PTR
28PTRV
29NUM2PTR
30PTR2IV
31PTR2UV
32PTR2NV
33PTR2ul
a745474a 34START_EXTERN_C
35END_EXTERN_C
36EXTERN_C
37STMT_START
38STMT_END
0d0f8426 39XSRETURN
adfe19db 40/PL_\w+/
41
42=implementation
43
0d0f8426 44#if { VERSION <= 5.004_05 }
adfe19db 45/* Replace: 1 */
96ad942f 46# define PL_DBsingle DBsingle
47# define PL_DBsub DBsub
48# define PL_Sv Sv
49# define PL_compiling compiling
50# define PL_copline copline
51# define PL_curcop curcop
52# define PL_curstash curstash
53# define PL_debstash debstash
54# define PL_defgv defgv
55# define PL_diehook diehook
56# define PL_dirty dirty
57# define PL_dowarn dowarn
58# define PL_errgv errgv
59# define PL_hexdigit hexdigit
60# define PL_hints hints
61# define PL_na na
62# define PL_no_modify no_modify
63# define PL_perl_destruct_level perl_destruct_level
64# define PL_perldb perldb
65# define PL_ppaddr ppaddr
66# define PL_rsfp_filters rsfp_filters
67# define PL_rsfp rsfp
68# define PL_stack_base stack_base
69# define PL_stack_sp stack_sp
70# define PL_stdingv stdingv
71# define PL_sv_arenaroot sv_arenaroot
72# define PL_sv_no sv_no
73# define PL_sv_undef sv_undef
74# define PL_sv_yes sv_yes
75# define PL_tainted tainted
76# define PL_tainting tainting
adfe19db 77/* Replace: 0 */
78#endif
79
62093c1c 80#ifndef PERL_UNUSED_DECL
81# ifdef HASATTRIBUTE
82# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
83# define PERL_UNUSED_DECL
84# else
85# define PERL_UNUSED_DECL __attribute__((unused))
86# endif
adfe19db 87# else
62093c1c 88# define PERL_UNUSED_DECL
adfe19db 89# endif
adfe19db 90#endif
91
f2ab5a41 92#ifndef PERL_UNUSED_ARG
93# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
94# include <note.h>
95# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
96# else
97# define PERL_UNUSED_ARG(x) ((void)x)
98# endif
99#endif
100
101#ifndef PERL_UNUSED_VAR
102# define PERL_UNUSED_VAR(x) ((void)x)
103#endif
104
105#ifndef PERL_UNUSED_CONTEXT
106# ifdef USE_ITHREADS
107# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
108# else
109# define PERL_UNUSED_CONTEXT
110# endif
111#endif
112
113__UNDEFINED__ NOOP /*EMPTY*/(void)0
114__UNDEFINED__ dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
adfe19db 115
116#ifndef NVTYPE
117# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
118# define NVTYPE long double
119# else
120# define NVTYPE double
121# endif
122typedef NVTYPE NV;
123#endif
124
125#ifndef INT2PTR
126
127# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
128# define PTRV UV
129# define INT2PTR(any,d) (any)(d)
130# else
131# if PTRSIZE == LONGSIZE
132# define PTRV unsigned long
133# else
134# define PTRV unsigned
135# endif
136# define INT2PTR(any,d) (any)(PTRV)(d)
137# endif
138
139# define NUM2PTR(any,d) (any)(PTRV)(d)
140# define PTR2IV(p) INT2PTR(IV,p)
141# define PTR2UV(p) INT2PTR(UV,p)
142# define PTR2NV(p) NUM2PTR(NV,p)
143
144# if PTRSIZE == LONGSIZE
145# define PTR2ul(p) (unsigned long)(p)
146# else
4a582685 147# define PTR2ul(p) INT2PTR(unsigned long,p)
adfe19db 148# endif
149
150#endif /* !INT2PTR */
151
a745474a 152#undef START_EXTERN_C
153#undef END_EXTERN_C
154#undef EXTERN_C
155#ifdef __cplusplus
156# define START_EXTERN_C extern "C" {
157# define END_EXTERN_C }
158# define EXTERN_C extern "C"
159#else
160# define START_EXTERN_C
161# define END_EXTERN_C
162# define EXTERN_C extern
163#endif
164
165#ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
166# if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
167# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
168# endif
169#endif
170
171#undef STMT_START
172#undef STMT_END
173#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
174# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
175# define STMT_END )
176#else
177# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
178# define STMT_START if (1)
179# define STMT_END else (void)0
180# else
181# define STMT_START do
182# define STMT_END while (0)
183# endif
184#endif
185
adfe19db 186__UNDEFINED__ boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
187
188/* DEFSV appears first in 5.004_56 */
189__UNDEFINED__ DEFSV GvSV(PL_defgv)
190__UNDEFINED__ SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
191
192/* Older perls (<=5.003) lack AvFILLp */
193__UNDEFINED__ AvFILLp AvFILL
194
195__UNDEFINED__ ERRSV get_sv("@",FALSE)
196
197__UNDEFINED__ newSVpvn(data,len) ((data) \
198 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
199 : newSV(0))
200
201/* Hint: gv_stashpvn
202 * This function's backport doesn't support the length parameter, but
203 * rather ignores it. Portability can only be ensured if the length
204 * parameter is used for speed reasons, but the length can always be
205 * correctly computed from the string argument.
206 */
207
208__UNDEFINED__ gv_stashpvn(str,len,create) gv_stashpv(str,create)
209
210/* Replace: 1 */
211__UNDEFINED__ get_cv perl_get_cv
212__UNDEFINED__ get_sv perl_get_sv
213__UNDEFINED__ get_av perl_get_av
214__UNDEFINED__ get_hv perl_get_hv
215/* Replace: 0 */
216
adfe19db 217__UNDEFINED__ dUNDERBAR dNOOP
218__UNDEFINED__ UNDERBAR DEFSV
219
220__UNDEFINED__ dAX I32 ax = MARK - PL_stack_base + 1
221__UNDEFINED__ dITEMS I32 items = SP - MARK
222
9132e1a3 223__UNDEFINED__ dXSTARG SV * targ = sv_newmortal()
224
0d0f8426 225__UNDEFINED__ dAXMARK I32 ax = POPMARK; \
226 register SV ** const mark = PL_stack_base + ax++
227
228
229__UNDEFINED__ XSprePUSH (sp = PL_stack_base + ax - 1)
230
231#if { VERSION < 5.005 }
232# undef XSRETURN
233# define XSRETURN(off) \
234 STMT_START { \
235 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
236 return; \
237 } STMT_END
238#endif
239
f2ab5a41 240__UNDEFINED__ PERL_ABS(x) ((x) < 0 ? -(x) : (x))
241
242__UNDEFINED__ dVAR dNOOP
243
244__UNDEFINED__ SVf "_"
245
9132e1a3 246=xsmisc
247
248XS(XS_Devel__PPPort_dXSTARG); /* prototype */
249XS(XS_Devel__PPPort_dXSTARG)
250{
251 dXSARGS;
252 dXSTARG;
2dd69576 253 IV iv;
9132e1a3 254 SP -= items;
2dd69576 255 iv = SvIV(ST(0)) + 1;
9132e1a3 256 PUSHi(iv);
257 XSRETURN(1);
258}
259
0d0f8426 260XS(XS_Devel__PPPort_dAXMARK); /* prototype */
261XS(XS_Devel__PPPort_dAXMARK)
262{
263 dSP;
264 dAXMARK;
265 dITEMS;
266 IV iv;
267 SP -= items;
268 iv = SvIV(ST(0)) - 1;
269 PUSHs(sv_2mortal(newSViv(iv)));
270 XSRETURN(1);
271}
272
9132e1a3 273=xsboot
274
275newXS("Devel::PPPort::dXSTARG", XS_Devel__PPPort_dXSTARG, file);
0d0f8426 276newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file);
9132e1a3 277
adfe19db 278=xsubs
279
280int
281gv_stashpvn(name, create)
282 char *name
283 I32 create
284 CODE:
285 RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
286 OUTPUT:
287 RETVAL
288
289int
290get_sv(name, create)
291 char *name
292 I32 create
293 CODE:
294 RETVAL = get_sv(name, create) != NULL;
295 OUTPUT:
296 RETVAL
297
298int
299get_av(name, create)
300 char *name
301 I32 create
302 CODE:
303 RETVAL = get_av(name, create) != NULL;
304 OUTPUT:
305 RETVAL
306
307int
308get_hv(name, create)
309 char *name
310 I32 create
311 CODE:
312 RETVAL = get_hv(name, create) != NULL;
313 OUTPUT:
314 RETVAL
315
316int
317get_cv(name, create)
318 char *name
319 I32 create
320 CODE:
321 RETVAL = get_cv(name, create) != NULL;
322 OUTPUT:
323 RETVAL
324
325void
326newSVpvn()
327 PPCODE:
328 XPUSHs(newSVpvn("test", 4));
329 XPUSHs(newSVpvn("test", 2));
330 XPUSHs(newSVpvn("test", 0));
331 XPUSHs(newSVpvn(NULL, 2));
332 XPUSHs(newSVpvn(NULL, 0));
333 XSRETURN(5);
334
0d0f8426 335void
336xsreturn(two)
337 int two
338 PPCODE:
339 XPUSHs(newSVpvn("test1", 5));
340 if (two)
341 XPUSHs(newSVpvn("test2", 5));
342 if (two)
343 XSRETURN(2);
344 else
345 XSRETURN(1);
346
adfe19db 347SV *
348PL_sv_undef()
349 CODE:
350 RETVAL = newSVsv(&PL_sv_undef);
351 OUTPUT:
352 RETVAL
353
354SV *
355PL_sv_yes()
356 CODE:
357 RETVAL = newSVsv(&PL_sv_yes);
358 OUTPUT:
359 RETVAL
360
361SV *
362PL_sv_no()
363 CODE:
364 RETVAL = newSVsv(&PL_sv_no);
365 OUTPUT:
366 RETVAL
367
368int
369PL_na(string)
370 char *string
371 CODE:
372 PL_na = strlen(string);
373 RETVAL = PL_na;
374 OUTPUT:
375 RETVAL
376
377SV*
378boolSV(value)
379 int value
380 CODE:
381 RETVAL = newSVsv(boolSV(value));
382 OUTPUT:
383 RETVAL
384
385SV*
386DEFSV()
387 CODE:
388 RETVAL = newSVsv(DEFSV);
389 OUTPUT:
390 RETVAL
391
392int
393ERRSV()
394 CODE:
395 RETVAL = SvTRUE(ERRSV);
396 OUTPUT:
397 RETVAL
398
399SV*
400UNDERBAR()
401 CODE:
402 {
403 dUNDERBAR;
404 RETVAL = newSVsv(UNDERBAR);
405 }
406 OUTPUT:
407 RETVAL
408
0d0f8426 409void
410prepush()
411 CODE:
412 {
413 dXSTARG;
414 XSprePUSH;
415 PUSHi(42);
416 XSRETURN(1);
417 }
418
f2ab5a41 419int
420PERL_ABS(a)
421 int a
422
423void
424SVf(x)
425 SV *x
426 PPCODE:
427#if { VERSION >= 5.004 }
428 x = newSVpvf("[%"SVf"]", x);
429#endif
430 XPUSHs(x);
431 XSRETURN(1);
432
433=tests plan => 42
adfe19db 434
435use vars qw($my_sv @my_av %my_hv);
436
437my @s = &Devel::PPPort::newSVpvn();
438ok(@s == 5);
439ok($s[0], "test");
440ok($s[1], "te");
441ok($s[2], "");
442ok(!defined($s[3]));
443ok(!defined($s[4]));
444
445ok(!defined(&Devel::PPPort::PL_sv_undef()));
446ok(&Devel::PPPort::PL_sv_yes());
447ok(!&Devel::PPPort::PL_sv_no());
448ok(&Devel::PPPort::PL_na("abcd"), 4);
449
450ok(&Devel::PPPort::boolSV(1));
451ok(!&Devel::PPPort::boolSV(0));
452
453$_ = "Fred";
454ok(&Devel::PPPort::DEFSV(), "Fred");
455ok(&Devel::PPPort::UNDERBAR(), "Fred");
456
0d0f8426 457if ($] >= 5.009002) {
458 eval q{
459 my $_ = "Tony";
460 ok(&Devel::PPPort::DEFSV(), "Fred");
461 ok(&Devel::PPPort::UNDERBAR(), "Tony");
462 };
463}
464else {
465 ok(1);
466 ok(1);
467}
468
adfe19db 469eval { 1 };
470ok(!&Devel::PPPort::ERRSV());
471eval { cannot_call_this_one() };
472ok(&Devel::PPPort::ERRSV());
473
474ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
475ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
476ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1));
477
478$my_sv = 1;
479ok(&Devel::PPPort::get_sv('my_sv', 0));
480ok(!&Devel::PPPort::get_sv('not_my_sv', 0));
481ok(&Devel::PPPort::get_sv('not_my_sv', 1));
482
483@my_av = (1);
484ok(&Devel::PPPort::get_av('my_av', 0));
485ok(!&Devel::PPPort::get_av('not_my_av', 0));
486ok(&Devel::PPPort::get_av('not_my_av', 1));
487
488%my_hv = (a=>1);
489ok(&Devel::PPPort::get_hv('my_hv', 0));
490ok(!&Devel::PPPort::get_hv('not_my_hv', 0));
491ok(&Devel::PPPort::get_hv('not_my_hv', 1));
492
493sub my_cv { 1 };
494ok(&Devel::PPPort::get_cv('my_cv', 0));
495ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
496ok(&Devel::PPPort::get_cv('not_my_cv', 1));
497
9132e1a3 498ok(Devel::PPPort::dXSTARG(42), 43);
0d0f8426 499ok(Devel::PPPort::dAXMARK(4711), 4710);
500
501ok(Devel::PPPort::prepush(), 42);
9132e1a3 502
0d0f8426 503ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
504ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
f2ab5a41 505
506ok(Devel::PPPort::PERL_ABS(42), 42);
507ok(Devel::PPPort::PERL_ABS(-13), 13);
508
509ok(Devel::PPPort::SVf(42), $] >= 5.004 ? '[42]' : '42');
510ok(Devel::PPPort::SVf('abc'), $] >= 5.004 ? '[abc]' : 'abc');
511
Unnamed repository; edit this file to name it for gitweb.