projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Upgrade to CGI.pm-3.33. There are still differences between the
[p5sagit/p5-mst-13.2.git] / ext / Devel / PPPort / parts / inc / misc
CommitLineData
adfe19db 1################################################################################
2##
c83e6f19 3## $Revision: 41 $
adfe19db 4## $Author: mhx $
c83e6f19 5## $Date: 2007/08/20 18:33:10 +0200 $
adfe19db 6##
7################################################################################
8##
d2dacc4f 9## Version 3.x, Copyright (C) 2004-2007, 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
c07deaaf 26PERL_USE_GCC_BRACE_GROUPS
adfe19db 27NVTYPE
28INT2PTR
29PTRV
30NUM2PTR
c83e6f19 31PERL_HASH
adfe19db 32PTR2IV
33PTR2UV
34PTR2NV
35PTR2ul
a745474a 36START_EXTERN_C
37END_EXTERN_C
38EXTERN_C
39STMT_START
40STMT_END
679ad62d 41UTF8_MAXBYTES
0d0f8426 42XSRETURN
adfe19db 43
44=implementation
45
62093c1c 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 56#endif
57
f2ab5a41 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 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 114# endif
115
116#endif /* !INT2PTR */
117
a745474a 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 131#if defined(PERL_GCC_PEDANTIC)
132# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
a745474a 133# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
134# endif
135#endif
136
c07deaaf 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 143#undef STMT_START
144#undef STMT_END
c07deaaf 145#ifdef PERL_USE_GCC_BRACE_GROUPS
a745474a 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 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
169__UNDEFINED__ newSVpvn(data,len) ((data) \
170 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
171 : newSV(0))
172
173/* Hint: gv_stashpvn
174 * This function's backport doesn't support the length parameter, but
175 * rather ignores it. Portability can only be ensured if the length
176 * parameter is used for speed reasons, but the length can always be
177 * correctly computed from the string argument.
178 */
179
180__UNDEFINED__ gv_stashpvn(str,len,create) gv_stashpv(str,create)
181
182/* Replace: 1 */
183__UNDEFINED__ get_cv perl_get_cv
184__UNDEFINED__ get_sv perl_get_sv
185__UNDEFINED__ get_av perl_get_av
186__UNDEFINED__ get_hv perl_get_hv
187/* Replace: 0 */
188
adfe19db 189__UNDEFINED__ dUNDERBAR dNOOP
190__UNDEFINED__ UNDERBAR DEFSV
191
192__UNDEFINED__ dAX I32 ax = MARK - PL_stack_base + 1
193__UNDEFINED__ dITEMS I32 items = SP - MARK
194
9132e1a3 195__UNDEFINED__ dXSTARG SV * targ = sv_newmortal()
196
0d0f8426 197__UNDEFINED__ dAXMARK I32 ax = POPMARK; \
198 register SV ** const mark = PL_stack_base + ax++
199
200
201__UNDEFINED__ XSprePUSH (sp = PL_stack_base + ax - 1)
202
203#if { VERSION < 5.005 }
204# undef XSRETURN
205# define XSRETURN(off) \
206 STMT_START { \
207 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
208 return; \
209 } STMT_END
210#endif
211
f2ab5a41 212__UNDEFINED__ PERL_ABS(x) ((x) < 0 ? -(x) : (x))
213
214__UNDEFINED__ dVAR dNOOP
215
216__UNDEFINED__ SVf "_"
217
c83e6f19 218__UNDEFINED__ UTF8_MAXBYTES UTF8_MAXLEN
219
220__UNDEFINED__ PERL_HASH(hash,str,len) \
221 STMT_START { \
222 const char *s_PeRlHaSh = str; \
223 I32 i_PeRlHaSh = len; \
224 U32 hash_PeRlHaSh = 0; \
225 while (i_PeRlHaSh--) \
226 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
227 (hash) = hash_PeRlHaSh; \
228 } STMT_END
679ad62d 229
9132e1a3 230=xsmisc
231
232XS(XS_Devel__PPPort_dXSTARG); /* prototype */
233XS(XS_Devel__PPPort_dXSTARG)
234{
235 dXSARGS;
236 dXSTARG;
2dd69576 237 IV iv;
9132e1a3 238 SP -= items;
2dd69576 239 iv = SvIV(ST(0)) + 1;
9132e1a3 240 PUSHi(iv);
241 XSRETURN(1);
242}
243
0d0f8426 244XS(XS_Devel__PPPort_dAXMARK); /* prototype */
245XS(XS_Devel__PPPort_dAXMARK)
246{
247 dSP;
248 dAXMARK;
249 dITEMS;
250 IV iv;
251 SP -= items;
252 iv = SvIV(ST(0)) - 1;
253 PUSHs(sv_2mortal(newSViv(iv)));
254 XSRETURN(1);
255}
256
9132e1a3 257=xsboot
258
259newXS("Devel::PPPort::dXSTARG", XS_Devel__PPPort_dXSTARG, file);
0d0f8426 260newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file);
9132e1a3 261
adfe19db 262=xsubs
263
264int
265gv_stashpvn(name, create)
266 char *name
267 I32 create
268 CODE:
269 RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
270 OUTPUT:
271 RETVAL
272
273int
274get_sv(name, create)
275 char *name
276 I32 create
277 CODE:
278 RETVAL = get_sv(name, create) != NULL;
279 OUTPUT:
280 RETVAL
281
282int
283get_av(name, create)
284 char *name
285 I32 create
286 CODE:
287 RETVAL = get_av(name, create) != NULL;
288 OUTPUT:
289 RETVAL
290
291int
292get_hv(name, create)
293 char *name
294 I32 create
295 CODE:
296 RETVAL = get_hv(name, create) != NULL;
297 OUTPUT:
298 RETVAL
299
300int
301get_cv(name, create)
302 char *name
303 I32 create
304 CODE:
305 RETVAL = get_cv(name, create) != NULL;
306 OUTPUT:
307 RETVAL
308
309void
310newSVpvn()
311 PPCODE:
312 XPUSHs(newSVpvn("test", 4));
313 XPUSHs(newSVpvn("test", 2));
314 XPUSHs(newSVpvn("test", 0));
315 XPUSHs(newSVpvn(NULL, 2));
316 XPUSHs(newSVpvn(NULL, 0));
317 XSRETURN(5);
318
0d0f8426 319void
320xsreturn(two)
321 int two
322 PPCODE:
323 XPUSHs(newSVpvn("test1", 5));
324 if (two)
325 XPUSHs(newSVpvn("test2", 5));
326 if (two)
327 XSRETURN(2);
328 else
329 XSRETURN(1);
330
adfe19db 331SV*
332boolSV(value)
333 int value
334 CODE:
335 RETVAL = newSVsv(boolSV(value));
336 OUTPUT:
337 RETVAL
338
339SV*
340DEFSV()
341 CODE:
342 RETVAL = newSVsv(DEFSV);
343 OUTPUT:
344 RETVAL
345
346int
347ERRSV()
348 CODE:
349 RETVAL = SvTRUE(ERRSV);
350 OUTPUT:
351 RETVAL
352
353SV*
354UNDERBAR()
355 CODE:
356 {
357 dUNDERBAR;
358 RETVAL = newSVsv(UNDERBAR);
359 }
360 OUTPUT:
361 RETVAL
362
0d0f8426 363void
364prepush()
365 CODE:
366 {
367 dXSTARG;
368 XSprePUSH;
369 PUSHi(42);
370 XSRETURN(1);
371 }
372
f2ab5a41 373int
374PERL_ABS(a)
375 int a
376
377void
378SVf(x)
379 SV *x
380 PPCODE:
381#if { VERSION >= 5.004 }
382 x = newSVpvf("[%"SVf"]", x);
383#endif
384 XPUSHs(x);
385 XSRETURN(1);
386
cac25305 387=tests plan => 38
adfe19db 388
389use vars qw($my_sv @my_av %my_hv);
390
391my @s = &Devel::PPPort::newSVpvn();
392ok(@s == 5);
393ok($s[0], "test");
394ok($s[1], "te");
395ok($s[2], "");
396ok(!defined($s[3]));
397ok(!defined($s[4]));
398
adfe19db 399ok(&Devel::PPPort::boolSV(1));
400ok(!&Devel::PPPort::boolSV(0));
401
402$_ = "Fred";
403ok(&Devel::PPPort::DEFSV(), "Fred");
404ok(&Devel::PPPort::UNDERBAR(), "Fred");
405
0d0f8426 406if ($] >= 5.009002) {
407 eval q{
408 my $_ = "Tony";
409 ok(&Devel::PPPort::DEFSV(), "Fred");
410 ok(&Devel::PPPort::UNDERBAR(), "Tony");
411 };
412}
413else {
414 ok(1);
415 ok(1);
416}
417
adfe19db 418eval { 1 };
419ok(!&Devel::PPPort::ERRSV());
420eval { cannot_call_this_one() };
421ok(&Devel::PPPort::ERRSV());
422
423ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
424ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
425ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1));
426
427$my_sv = 1;
428ok(&Devel::PPPort::get_sv('my_sv', 0));
429ok(!&Devel::PPPort::get_sv('not_my_sv', 0));
430ok(&Devel::PPPort::get_sv('not_my_sv', 1));
431
432@my_av = (1);
433ok(&Devel::PPPort::get_av('my_av', 0));
434ok(!&Devel::PPPort::get_av('not_my_av', 0));
435ok(&Devel::PPPort::get_av('not_my_av', 1));
436
437%my_hv = (a=>1);
438ok(&Devel::PPPort::get_hv('my_hv', 0));
439ok(!&Devel::PPPort::get_hv('not_my_hv', 0));
440ok(&Devel::PPPort::get_hv('not_my_hv', 1));
441
442sub my_cv { 1 };
443ok(&Devel::PPPort::get_cv('my_cv', 0));
444ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
445ok(&Devel::PPPort::get_cv('not_my_cv', 1));
446
9132e1a3 447ok(Devel::PPPort::dXSTARG(42), 43);
0d0f8426 448ok(Devel::PPPort::dAXMARK(4711), 4710);
449
450ok(Devel::PPPort::prepush(), 42);
9132e1a3 451
0d0f8426 452ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
453ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
f2ab5a41 454
455ok(Devel::PPPort::PERL_ABS(42), 42);
456ok(Devel::PPPort::PERL_ABS(-13), 13);
457
458ok(Devel::PPPort::SVf(42), $] >= 5.004 ? '[42]' : '42');
459ok(Devel::PPPort::SVf('abc'), $] >= 5.004 ? '[abc]' : 'abc');
460
Unnamed repository; edit this file to name it for gitweb.