This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add MY_CXT_CLONE to the core. (Taken from Time::HiRes.) See also:
[perl5.git] / ext / Devel / PPPort / parts / inc / misc
CommitLineData
adfe19db
MHM
1################################################################################
2##
96ad942f 3## $Revision: 16 $
adfe19db 4## $Author: mhx $
96ad942f 5## $Date: 2004/08/17 13:49:30 +0200 $
adfe19db
MHM
6##
7################################################################################
8##
9## Version 3.x, Copyright (C) 2004, Marcus Holland-Moritz.
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
22NVTYPE
23INT2PTR
24PTRV
25NUM2PTR
26PTR2IV
27PTR2UV
28PTR2NV
29PTR2ul
30/PL_\w+/
31
32=implementation
33
34#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
35/* Replace: 1 */
96ad942f
MHM
36# define PL_DBsingle DBsingle
37# define PL_DBsub DBsub
38# define PL_Sv Sv
39# define PL_compiling compiling
40# define PL_copline copline
41# define PL_curcop curcop
42# define PL_curstash curstash
43# define PL_debstash debstash
44# define PL_defgv defgv
45# define PL_diehook diehook
46# define PL_dirty dirty
47# define PL_dowarn dowarn
48# define PL_errgv errgv
49# define PL_hexdigit hexdigit
50# define PL_hints hints
51# define PL_na na
52# define PL_no_modify no_modify
53# define PL_perl_destruct_level perl_destruct_level
54# define PL_perldb perldb
55# define PL_ppaddr ppaddr
56# define PL_rsfp_filters rsfp_filters
57# define PL_rsfp rsfp
58# define PL_stack_base stack_base
59# define PL_stack_sp stack_sp
60# define PL_stdingv stdingv
61# define PL_sv_arenaroot sv_arenaroot
62# define PL_sv_no sv_no
63# define PL_sv_undef sv_undef
64# define PL_sv_yes sv_yes
65# define PL_tainted tainted
66# define PL_tainting tainting
adfe19db
MHM
67/* Replace: 0 */
68#endif
69
70#ifdef HASATTRIBUTE
71# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
72# define PERL_UNUSED_DECL
73# else
74# define PERL_UNUSED_DECL __attribute__((unused))
75# endif
76#else
77# define PERL_UNUSED_DECL
78#endif
79
80__UNDEFINED__ NOOP (void)0
81__UNDEFINED__ dNOOP extern int Perl___notused PERL_UNUSED_DECL
82
83#ifndef NVTYPE
84# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
85# define NVTYPE long double
86# else
87# define NVTYPE double
88# endif
89typedef NVTYPE NV;
90#endif
91
92#ifndef INT2PTR
93
94# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
95# define PTRV UV
96# define INT2PTR(any,d) (any)(d)
97# else
98# if PTRSIZE == LONGSIZE
99# define PTRV unsigned long
100# else
101# define PTRV unsigned
102# endif
103# define INT2PTR(any,d) (any)(PTRV)(d)
104# endif
105
106# define NUM2PTR(any,d) (any)(PTRV)(d)
107# define PTR2IV(p) INT2PTR(IV,p)
108# define PTR2UV(p) INT2PTR(UV,p)
109# define PTR2NV(p) NUM2PTR(NV,p)
110
111# if PTRSIZE == LONGSIZE
112# define PTR2ul(p) (unsigned long)(p)
113# else
114# define PTR2ul(p) INT2PTR(unsigned long,p)
115# endif
116
117#endif /* !INT2PTR */
118
119__UNDEFINED__ boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
120
121/* DEFSV appears first in 5.004_56 */
122__UNDEFINED__ DEFSV GvSV(PL_defgv)
123__UNDEFINED__ SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
124
125/* Older perls (<=5.003) lack AvFILLp */
126__UNDEFINED__ AvFILLp AvFILL
127
128__UNDEFINED__ ERRSV get_sv("@",FALSE)
129
130__UNDEFINED__ newSVpvn(data,len) ((data) \
131 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
132 : newSV(0))
133
134/* Hint: gv_stashpvn
135 * This function's backport doesn't support the length parameter, but
136 * rather ignores it. Portability can only be ensured if the length
137 * parameter is used for speed reasons, but the length can always be
138 * correctly computed from the string argument.
139 */
140
141__UNDEFINED__ gv_stashpvn(str,len,create) gv_stashpv(str,create)
142
143/* Replace: 1 */
144__UNDEFINED__ get_cv perl_get_cv
145__UNDEFINED__ get_sv perl_get_sv
146__UNDEFINED__ get_av perl_get_av
147__UNDEFINED__ get_hv perl_get_hv
148/* Replace: 0 */
149
150#ifdef HAS_MEMCMP
151__UNDEFINED__ memNE(s1,s2,l) (memcmp(s1,s2,l))
152__UNDEFINED__ memEQ(s1,s2,l) (!memcmp(s1,s2,l))
153#else
154__UNDEFINED__ memNE(s1,s2,l) (bcmp(s1,s2,l))
155__UNDEFINED__ memEQ(s1,s2,l) (!bcmp(s1,s2,l))
156#endif
157
158__UNDEFINED__ MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
159__UNDEFINED__ CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
160#ifdef HAS_MEMSET
161__UNDEFINED__ ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
162#else
163__UNDEFINED__ ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)),d)
164#endif
165
166__UNDEFINED__ Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t))
167
168__UNDEFINED__ dUNDERBAR dNOOP
169__UNDEFINED__ UNDERBAR DEFSV
170
171__UNDEFINED__ dAX I32 ax = MARK - PL_stack_base + 1
172__UNDEFINED__ dITEMS I32 items = SP - MARK
173
174=xsubs
175
176int
177gv_stashpvn(name, create)
178 char *name
179 I32 create
180 CODE:
181 RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
182 OUTPUT:
183 RETVAL
184
185int
186get_sv(name, create)
187 char *name
188 I32 create
189 CODE:
190 RETVAL = get_sv(name, create) != NULL;
191 OUTPUT:
192 RETVAL
193
194int
195get_av(name, create)
196 char *name
197 I32 create
198 CODE:
199 RETVAL = get_av(name, create) != NULL;
200 OUTPUT:
201 RETVAL
202
203int
204get_hv(name, create)
205 char *name
206 I32 create
207 CODE:
208 RETVAL = get_hv(name, create) != NULL;
209 OUTPUT:
210 RETVAL
211
212int
213get_cv(name, create)
214 char *name
215 I32 create
216 CODE:
217 RETVAL = get_cv(name, create) != NULL;
218 OUTPUT:
219 RETVAL
220
221void
222newSVpvn()
223 PPCODE:
224 XPUSHs(newSVpvn("test", 4));
225 XPUSHs(newSVpvn("test", 2));
226 XPUSHs(newSVpvn("test", 0));
227 XPUSHs(newSVpvn(NULL, 2));
228 XPUSHs(newSVpvn(NULL, 0));
229 XSRETURN(5);
230
231SV *
232PL_sv_undef()
233 CODE:
234 RETVAL = newSVsv(&PL_sv_undef);
235 OUTPUT:
236 RETVAL
237
238SV *
239PL_sv_yes()
240 CODE:
241 RETVAL = newSVsv(&PL_sv_yes);
242 OUTPUT:
243 RETVAL
244
245SV *
246PL_sv_no()
247 CODE:
248 RETVAL = newSVsv(&PL_sv_no);
249 OUTPUT:
250 RETVAL
251
252int
253PL_na(string)
254 char *string
255 CODE:
256 PL_na = strlen(string);
257 RETVAL = PL_na;
258 OUTPUT:
259 RETVAL
260
261SV*
262boolSV(value)
263 int value
264 CODE:
265 RETVAL = newSVsv(boolSV(value));
266 OUTPUT:
267 RETVAL
268
269SV*
270DEFSV()
271 CODE:
272 RETVAL = newSVsv(DEFSV);
273 OUTPUT:
274 RETVAL
275
276int
277ERRSV()
278 CODE:
279 RETVAL = SvTRUE(ERRSV);
280 OUTPUT:
281 RETVAL
282
283SV*
284UNDERBAR()
285 CODE:
286 {
287 dUNDERBAR;
288 RETVAL = newSVsv(UNDERBAR);
289 }
290 OUTPUT:
291 RETVAL
292
293=tests plan => 31
294
295use vars qw($my_sv @my_av %my_hv);
296
297my @s = &Devel::PPPort::newSVpvn();
298ok(@s == 5);
299ok($s[0], "test");
300ok($s[1], "te");
301ok($s[2], "");
302ok(!defined($s[3]));
303ok(!defined($s[4]));
304
305ok(!defined(&Devel::PPPort::PL_sv_undef()));
306ok(&Devel::PPPort::PL_sv_yes());
307ok(!&Devel::PPPort::PL_sv_no());
308ok(&Devel::PPPort::PL_na("abcd"), 4);
309
310ok(&Devel::PPPort::boolSV(1));
311ok(!&Devel::PPPort::boolSV(0));
312
313$_ = "Fred";
314ok(&Devel::PPPort::DEFSV(), "Fred");
315ok(&Devel::PPPort::UNDERBAR(), "Fred");
316
317eval { 1 };
318ok(!&Devel::PPPort::ERRSV());
319eval { cannot_call_this_one() };
320ok(&Devel::PPPort::ERRSV());
321
322ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
323ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
324ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1));
325
326$my_sv = 1;
327ok(&Devel::PPPort::get_sv('my_sv', 0));
328ok(!&Devel::PPPort::get_sv('not_my_sv', 0));
329ok(&Devel::PPPort::get_sv('not_my_sv', 1));
330
331@my_av = (1);
332ok(&Devel::PPPort::get_av('my_av', 0));
333ok(!&Devel::PPPort::get_av('not_my_av', 0));
334ok(&Devel::PPPort::get_av('not_my_av', 1));
335
336%my_hv = (a=>1);
337ok(&Devel::PPPort::get_hv('my_hv', 0));
338ok(!&Devel::PPPort::get_hv('not_my_hv', 0));
339ok(&Devel::PPPort::get_hv('not_my_hv', 1));
340
341sub my_cv { 1 };
342ok(&Devel::PPPort::get_cv('my_cv', 0));
343ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
344ok(&Devel::PPPort::get_cv('not_my_cv', 1));
345