This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Devel::PPPort 3.18
[perl5.git] / ext / Devel-PPPort / parts / inc / variables
CommitLineData
0d0f8426
MHM
1################################################################################
2##
51d6c659 3## $Revision: 19 $
0d0f8426 4## $Author: mhx $
51d6c659 5## $Date: 2009/01/18 14:10:53 +0100 $
0d0f8426
MHM
6##
7################################################################################
8##
51d6c659 9## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz.
0d0f8426
MHM
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
679ad62d
MHM
20PL_ppaddr
21PL_no_modify
22PL_DBsignal
23PL_DBsingle
24PL_DBsub
25PL_DBtrace
26PL_Sv
c01be2ce
MHM
27PL_bufend
28PL_bufptr
679ad62d
MHM
29PL_compiling
30PL_copline
31PL_curcop
32PL_curstash
33PL_debstash
34PL_defgv
35PL_diehook
36PL_dirty
37PL_dowarn
38PL_errgv
39PL_expect
40PL_hexdigit
41PL_hints
42PL_laststatval
c01be2ce
MHM
43PL_lex_state
44PL_lex_stuff
45PL_linestr
679ad62d 46PL_na
c01be2ce 47PL_parser
679ad62d
MHM
48PL_perl_destruct_level
49PL_perldb
50PL_rsfp_filters
51PL_rsfp
52PL_stack_base
53PL_stack_sp
54PL_statcache
55PL_stdingv
56PL_sv_arenaroot
57PL_sv_no
58PL_sv_undef
59PL_sv_yes
60PL_tainted
61PL_tainting
c01be2ce 62PL_tokenbuf
679ad62d 63PL_signals
0d0f8426
MHM
64PERL_SIGNALS_UNSAFE_FLAG
65
66=implementation
67
68#ifndef PERL_SIGNALS_UNSAFE_FLAG
69
70#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
71
cac25305
MHM
72#if { VERSION < 5.8.0 }
73# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
74#else
75# define D_PPP_PERL_SIGNALS_INIT 0
76#endif
77
78__NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT;
79
80#endif
0d0f8426 81
cac25305
MHM
82/* Hint: PL_ppaddr
83 * Calling an op via PL_ppaddr requires passing a context argument
84 * for threaded builds. Since the context argument is different for
85 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
86 * automatically be defined as the correct argument.
87 */
88
c58e738a 89#if { VERSION <= 5.005_05 }
cac25305
MHM
90/* Replace: 1 */
91# define PL_ppaddr ppaddr
92# define PL_no_modify no_modify
93/* Replace: 0 */
94#endif
95
96#if { VERSION <= 5.004_05 }
97/* Replace: 1 */
98# define PL_DBsignal DBsignal
99# define PL_DBsingle DBsingle
100# define PL_DBsub DBsub
101# define PL_DBtrace DBtrace
102# define PL_Sv Sv
c01be2ce
MHM
103# define PL_bufend bufend
104# define PL_bufptr bufptr
cac25305
MHM
105# define PL_compiling compiling
106# define PL_copline copline
107# define PL_curcop curcop
108# define PL_curstash curstash
109# define PL_debstash debstash
110# define PL_defgv defgv
111# define PL_diehook diehook
112# define PL_dirty dirty
113# define PL_dowarn dowarn
114# define PL_errgv errgv
a89b7ab8 115# define PL_expect expect
cac25305
MHM
116# define PL_hexdigit hexdigit
117# define PL_hints hints
118# define PL_laststatval laststatval
c01be2ce
MHM
119# define PL_lex_state lex_state
120# define PL_lex_stuff lex_stuff
121# define PL_linestr linestr
cac25305
MHM
122# define PL_na na
123# define PL_perl_destruct_level perl_destruct_level
124# define PL_perldb perldb
125# define PL_rsfp_filters rsfp_filters
126# define PL_rsfp rsfp
127# define PL_stack_base stack_base
128# define PL_stack_sp stack_sp
129# define PL_statcache statcache
130# define PL_stdingv stdingv
131# define PL_sv_arenaroot sv_arenaroot
132# define PL_sv_no sv_no
133# define PL_sv_undef sv_undef
134# define PL_sv_yes sv_yes
135# define PL_tainted tainted
136# define PL_tainting tainting
c01be2ce 137# define PL_tokenbuf tokenbuf
cac25305 138/* Replace: 0 */
0d0f8426
MHM
139#endif
140
c01be2ce
MHM
141/* Warning: PL_parser
142 * For perl versions earlier than 5.9.5, this is an always
143 * non-NULL dummy. Also, it cannot be dereferenced. Don't
144 * use it if you can avoid is and unless you absolutely know
145 * what you're doing.
146 * If you always check that PL_parser is non-NULL, you can
147 * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
148 * a dummy parser structure.
679ad62d
MHM
149 */
150
53a7735b 151#if { VERSION >= 5.9.5 }
c01be2ce
MHM
152# ifdef DPPP_PL_parser_NO_DUMMY
153# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
154 (croak("panic: PL_parser == NULL in %s:%d", \
155 __FILE__, __LINE__), (yy_parser *) NULL))->var)
156# else
157# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
158# define D_PPP_parser_dummy_warning(var)
159# else
160# define D_PPP_parser_dummy_warning(var) \
161 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
162# endif
163# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
164 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
165__NEED_DUMMY_VAR__ yy_parser PL_parser;
166# endif
167
168/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
169/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
170 * Do not use this variable unless you know exactly what you're
171 * doint. It is internal to the perl parser and may change or even
172 * be removed in the future. As of perl 5.9.5, you have to check
173 * for (PL_parser != NULL) for this variable to have any effect.
174 * An always non-NULL PL_parser dummy is provided for earlier
175 * perl versions.
176 * If PL_parser is NULL when you try to access this variable, a
177 * dummy is being accessed instead and a warning is issued unless
178 * you define DPPP_PL_parser_NO_DUMMY_WARNING.
179 * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
180 * this variable will croak with a panic message.
181 */
182
183# define PL_expect D_PPP_my_PL_parser_var(expect)
184# define PL_copline D_PPP_my_PL_parser_var(copline)
185# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
186# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
187# define PL_linestr D_PPP_my_PL_parser_var(linestr)
188# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
189# define PL_bufend D_PPP_my_PL_parser_var(bufend)
190# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
191# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
192# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
193
194#else
195
196/* ensure that PL_parser != NULL and cannot be dereferenced */
197# define PL_parser ((void *) 1)
198
53a7735b
DM
199#endif
200
0d0f8426
MHM
201=xsinit
202
203#define NEED_PL_signals
c01be2ce
MHM
204#define NEED_PL_parser
205#define DPPP_PL_parser_NO_DUMMY_WARNING
0d0f8426
MHM
206
207=xsmisc
208
209U32 get_PL_signals_1(void)
210{
211 return PL_signals;
212}
213
214extern U32 get_PL_signals_2(void);
215extern U32 get_PL_signals_3(void);
c01be2ce
MHM
216int no_dummy_parser_vars(int);
217int dummy_parser_warning(void);
218
219#define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var != NULL); count++; } STMT_END
220
221#define ppp_PARSERVAR(type, var) STMT_START { \
222 type volatile my_ ## var; \
223 type volatile *my_p_ ## var; \
224 my_ ## var = var; \
225 my_p_ ## var = &var; \
226 var = my_ ## var; \
227 var = *my_p_ ## var; \
228 mXPUSHi(&var != NULL); \
229 count++; \
230 } STMT_END
231
fd7af155
MHM
232#if { VERSION < 5.004 }
233# define ppp_rsfp_t FILE *
234#else
235# define ppp_rsfp_t PerlIO *
236#endif
237
238#if { VERSION < 5.6.0 }
c01be2ce 239# define ppp_expect_t expectation
fd7af155 240#elif { VERSION < 5.9.5 }
c01be2ce
MHM
241# define ppp_expect_t int
242#else
243# define ppp_expect_t U8
244#endif
0d0f8426 245
fd7af155 246#if { VERSION < 5.9.5 }
c01be2ce
MHM
247# define ppp_lex_state_t U32
248#else
249# define ppp_lex_state_t U8
250#endif
cac25305 251
0d0f8426
MHM
252=xsubs
253
254int
255compare_PL_signals()
256 CODE:
257 {
258 U32 ref = get_PL_signals_1();
259 RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3();
260 }
261 OUTPUT:
262 RETVAL
263
cac25305
MHM
264SV *
265PL_sv_undef()
266 CODE:
267 RETVAL = newSVsv(&PL_sv_undef);
268 OUTPUT:
269 RETVAL
270
271SV *
272PL_sv_yes()
273 CODE:
274 RETVAL = newSVsv(&PL_sv_yes);
275 OUTPUT:
276 RETVAL
277
278SV *
279PL_sv_no()
280 CODE:
281 RETVAL = newSVsv(&PL_sv_no);
282 OUTPUT:
283 RETVAL
284
285int
286PL_na(string)
287 char *string
288 CODE:
289 PL_na = strlen(string);
290 RETVAL = PL_na;
291 OUTPUT:
292 RETVAL
293
294SV *
295PL_Sv()
296 CODE:
297 PL_Sv = newSVpv("mhx", 0);
298 RETVAL = PL_Sv;
299 OUTPUT:
300 RETVAL
301
302SV *
c01be2ce 303PL_tokenbuf()
679ad62d 304 CODE:
c01be2ce 305 RETVAL = newSViv(PL_tokenbuf[0]);
679ad62d
MHM
306 OUTPUT:
307 RETVAL
308
309SV *
c01be2ce 310PL_parser()
679ad62d 311 CODE:
c01be2ce 312 RETVAL = newSViv(PL_parser != NULL);
679ad62d
MHM
313 OUTPUT:
314 RETVAL
315
316SV *
cac25305
MHM
317PL_hexdigit()
318 CODE:
aab9a3b6 319 RETVAL = newSVpv((char *) PL_hexdigit, 0);
cac25305
MHM
320 OUTPUT:
321 RETVAL
322
323SV *
324PL_hints()
325 CODE:
326 RETVAL = newSViv((IV) PL_hints);
327 OUTPUT:
328 RETVAL
329
330void
331PL_ppaddr(string)
332 char *string
333 PPCODE:
334 PUSHMARK(SP);
c1a049cb 335 mXPUSHs(newSVpv(string, 0));
cac25305
MHM
336 PUTBACK;
337 ENTER;
338 (void)*(PL_ppaddr[OP_UC])(aTHXR);
339 SPAGAIN;
340 LEAVE;
341 XSRETURN(1);
342
343void
344other_variables()
345 PREINIT:
346 int count = 0;
347 PPCODE:
348 ppp_TESTVAR(PL_DBsignal);
349 ppp_TESTVAR(PL_DBsingle);
350 ppp_TESTVAR(PL_DBsub);
351 ppp_TESTVAR(PL_DBtrace);
352 ppp_TESTVAR(PL_compiling);
353 ppp_TESTVAR(PL_curcop);
354 ppp_TESTVAR(PL_curstash);
355 ppp_TESTVAR(PL_debstash);
356 ppp_TESTVAR(PL_defgv);
357 ppp_TESTVAR(PL_diehook);
358 ppp_TESTVAR(PL_dirty);
359 ppp_TESTVAR(PL_dowarn);
360 ppp_TESTVAR(PL_errgv);
361 ppp_TESTVAR(PL_laststatval);
362 ppp_TESTVAR(PL_no_modify);
363 ppp_TESTVAR(PL_perl_destruct_level);
364 ppp_TESTVAR(PL_perldb);
cac25305
MHM
365 ppp_TESTVAR(PL_stack_base);
366 ppp_TESTVAR(PL_stack_sp);
367 ppp_TESTVAR(PL_statcache);
368 ppp_TESTVAR(PL_stdingv);
369 ppp_TESTVAR(PL_sv_arenaroot);
370 ppp_TESTVAR(PL_tainted);
371 ppp_TESTVAR(PL_tainting);
c01be2ce
MHM
372
373 ppp_PARSERVAR(ppp_expect_t, PL_expect);
374 ppp_PARSERVAR(line_t, PL_copline);
fd7af155 375 ppp_PARSERVAR(ppp_rsfp_t, PL_rsfp);
c01be2ce
MHM
376 ppp_PARSERVAR(AV *, PL_rsfp_filters);
377 ppp_PARSERVAR(SV *, PL_linestr);
378 ppp_PARSERVAR(char *, PL_bufptr);
379 ppp_PARSERVAR(char *, PL_bufend);
380 ppp_PARSERVAR(ppp_lex_state_t, PL_lex_state);
381 ppp_PARSERVAR(SV *, PL_lex_stuff);
382
cac25305
MHM
383 XSRETURN(count);
384
c01be2ce
MHM
385int
386no_dummy_parser_vars(check)
387 int check
388
389int
390dummy_parser_warning()
391
392=tests plan => 49
0d0f8426
MHM
393
394ok(Devel::PPPort::compare_PL_signals());
395
cac25305
MHM
396ok(!defined(&Devel::PPPort::PL_sv_undef()));
397ok(&Devel::PPPort::PL_sv_yes());
398ok(!&Devel::PPPort::PL_sv_no());
399ok(&Devel::PPPort::PL_na("abcd"), 4);
400ok(&Devel::PPPort::PL_Sv(), "mhx");
c01be2ce
MHM
401ok(defined &Devel::PPPort::PL_tokenbuf());
402ok($] >= 5.009005 || &Devel::PPPort::PL_parser());
cac25305
MHM
403ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
404ok(defined &Devel::PPPort::PL_hints());
405ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
406
407for (&Devel::PPPort::other_variables()) {
408 ok($_ != 0);
409}
c01be2ce
MHM
410
411{
412 my @w;
413 my $fail = 0;
414 {
415 local $SIG{'__WARN__'} = sub { push @w, @_ };
416 ok(&Devel::PPPort::dummy_parser_warning());
417 }
418 if ($] >= 5.009005) {
419 ok(@w >= 0);
420 for (@w) {
421 print "# $_";
422 unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) {
423 warn $_;
424 $fail++;
425 }
426 }
427 }
428 else {
429 ok(@w == 0);
430 }
431 ok($fail, 0);
432}
433
434ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ($] < 5.009005 ? 1 : 0));
435
436eval { &Devel::PPPort::no_dummy_parser_vars(0) };
437
438if ($] < 5.009005) {
439 ok($@, '');
440}
441else {
442 if ($@) {
443 print "# $@";
444 ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i);
445 }
446 else {
447 ok(1);
448 }
449}