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