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