1 ################################################################################
3 ## Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
4 ## Version 2.x, Copyright (C) 2001, Paul Marquess.
5 ## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
7 ## This program is free software; you can redistribute it and/or
8 ## modify it under the same terms as Perl itself.
10 ################################################################################
46 PL_perl_destruct_level
63 PERL_SIGNALS_UNSAFE_FLAG
67 #ifndef PERL_SIGNALS_UNSAFE_FLAG
69 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
71 #if { VERSION < 5.8.0 }
72 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
74 # define D_PPP_PERL_SIGNALS_INIT 0
77 __NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT;
82 * Calling an op via PL_ppaddr requires passing a context argument
83 * for threaded builds. Since the context argument is different for
84 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
85 * automatically be defined as the correct argument.
88 #if { VERSION <= 5.005_05 }
90 # define PL_ppaddr ppaddr
91 # define PL_no_modify no_modify
95 #if { VERSION <= 5.004_05 }
97 # define PL_DBsignal DBsignal
98 # define PL_DBsingle DBsingle
99 # define PL_DBsub DBsub
100 # define PL_DBtrace DBtrace
103 # define PL_bufend bufend
104 # define PL_bufptr bufptr
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
115 # define PL_error_count error_count
116 # define PL_expect expect
117 # define PL_hexdigit hexdigit
118 # define PL_hints hints
119 # define PL_in_my in_my
120 # define PL_laststatval laststatval
121 # define PL_lex_state lex_state
122 # define PL_lex_stuff lex_stuff
123 # define PL_linestr linestr
125 # define PL_perl_destruct_level perl_destruct_level
126 # define PL_perldb perldb
127 # define PL_rsfp_filters rsfp_filters
128 # define PL_rsfp rsfp
129 # define PL_stack_base stack_base
130 # define PL_stack_sp stack_sp
131 # define PL_statcache statcache
132 # define PL_stdingv stdingv
133 # define PL_sv_arenaroot sv_arenaroot
134 # define PL_sv_no sv_no
135 # define PL_sv_undef sv_undef
136 # define PL_sv_yes sv_yes
137 # define PL_tainted tainted
138 # define PL_tainting tainting
139 # define PL_tokenbuf tokenbuf
140 # define PL_mess_sv mess_sv
144 /* Warning: PL_parser
145 * For perl versions earlier than 5.9.5, this is an always
146 * non-NULL dummy. Also, it cannot be dereferenced. Don't
147 * use it if you can avoid it, and unless you absolutely know
149 * If you always check that PL_parser is non-NULL, you can
150 * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
151 * a dummy parser structure.
154 #if { VERSION >= 5.9.5 }
155 # ifdef DPPP_PL_parser_NO_DUMMY
156 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
157 (croak("panic: PL_parser == NULL in %s:%d", \
158 __FILE__, __LINE__), (yy_parser *) NULL))->var)
160 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
161 # define D_PPP_parser_dummy_warning(var)
163 # define D_PPP_parser_dummy_warning(var) \
164 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
166 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
167 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
168 __NEED_DUMMY_VAR__ yy_parser PL_parser;
171 /* 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 */
172 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
173 * Do not use this variable unless you know exactly what you're
174 * doing. It is internal to the perl parser and may change or even
175 * be removed in the future. As of perl 5.9.5, you have to check
176 * for (PL_parser != NULL) for this variable to have any effect.
177 * An always non-NULL PL_parser dummy is provided for earlier
179 * If PL_parser is NULL when you try to access this variable, a
180 * dummy is being accessed instead and a warning is issued unless
181 * you define DPPP_PL_parser_NO_DUMMY_WARNING.
182 * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
183 * this variable will croak with a panic message.
186 # define PL_expect D_PPP_my_PL_parser_var(expect)
187 # define PL_copline D_PPP_my_PL_parser_var(copline)
188 # define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
189 # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
190 # define PL_linestr D_PPP_my_PL_parser_var(linestr)
191 # define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
192 # define PL_bufend D_PPP_my_PL_parser_var(bufend)
193 # define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
194 # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
195 # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
196 # define PL_in_my D_PPP_my_PL_parser_var(in_my)
197 # define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
198 # define PL_error_count D_PPP_my_PL_parser_var(error_count)
203 /* ensure that PL_parser != NULL and cannot be dereferenced */
204 # define PL_parser ((void *) 1)
210 #define NEED_PL_signals
211 #define NEED_PL_parser
212 #define DPPP_PL_parser_NO_DUMMY_WARNING
216 U32 get_PL_signals_1(void)
218 #ifdef PERL_NO_GET_CONTEXT
224 extern U32 get_PL_signals_2(void);
225 extern U32 get_PL_signals_3(void);
226 int no_dummy_parser_vars(int);
227 int dummy_parser_warning(void);
229 /* No PTRSIZE IN 5.004 and below, so PTR2IV would warn and possibly misbehave */
230 #if { VERSION > 5.004 }
231 #define ppp_TESTVAR(var) STMT_START { mXPUSHi(PTR2IV(&var)); count++; } STMT_END
233 #define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var); count++; } STMT_END
236 #define ppp_PARSERVAR(type, var) STMT_START { \
237 type volatile my_ ## var; \
238 type volatile *my_p_ ## var; \
240 my_p_ ## var = &var; \
242 var = *my_p_ ## var; \
243 mXPUSHi(&var != NULL); \
247 #define ppp_PARSERVAR_dummy STMT_START { \
252 #if { VERSION < 5.004 }
253 # define ppp_rsfp_t FILE *
255 # define ppp_rsfp_t PerlIO *
258 #if { VERSION < 5.6.0 }
259 # define ppp_expect_t expectation
260 #elif { VERSION < 5.9.5 }
261 # define ppp_expect_t int
263 # define ppp_expect_t U8
266 #if { VERSION < 5.9.5 }
267 # define ppp_lex_state_t U32
269 # define ppp_lex_state_t U8
272 #if { VERSION < 5.6.0 }
273 # define ppp_in_my_t bool
274 #elif { VERSION < 5.9.5 }
275 # define ppp_in_my_t I32
277 # define ppp_in_my_t U16
280 #if { VERSION < 5.9.5 }
281 # define ppp_error_count_t I32
283 # define ppp_error_count_t U8
292 U32 ref = get_PL_signals_1();
293 RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3();
301 RETVAL = newSVsv(&PL_sv_undef);
308 RETVAL = newSVsv(&PL_sv_yes);
315 RETVAL = newSVsv(&PL_sv_no);
323 PL_na = strlen(string);
331 PL_Sv = newSVpv("mhx", 0);
339 RETVAL = newSViv(PL_tokenbuf[0]);
346 RETVAL = newSViv(PL_parser != NULL);
353 RETVAL = newSVpv((char *) PL_hexdigit, 0);
360 RETVAL = newSViv((IV) PL_hints);
369 mXPUSHs(newSVpv(string, 0));
372 (void)*(PL_ppaddr[OP_UC])(aTHXR);
382 ppp_TESTVAR(PL_DBsignal);
383 ppp_TESTVAR(PL_DBsingle);
384 ppp_TESTVAR(PL_DBsub);
385 ppp_TESTVAR(PL_DBtrace);
386 ppp_TESTVAR(PL_compiling);
387 ppp_TESTVAR(PL_curcop);
388 ppp_TESTVAR(PL_curstash);
389 ppp_TESTVAR(PL_debstash);
390 ppp_TESTVAR(PL_defgv);
391 ppp_TESTVAR(PL_diehook);
392 #if { VERSION >= 5.13.7 }
393 /* can't get a pointer any longer */
394 mXPUSHi(PL_dirty ? 1 : 1);
397 ppp_TESTVAR(PL_dirty);
399 ppp_TESTVAR(PL_dowarn);
400 ppp_TESTVAR(PL_errgv);
401 ppp_TESTVAR(PL_laststatval);
402 ppp_TESTVAR(PL_no_modify);
403 ppp_TESTVAR(PL_perl_destruct_level);
404 ppp_TESTVAR(PL_perldb);
405 ppp_TESTVAR(PL_stack_base);
406 ppp_TESTVAR(PL_stack_sp);
407 ppp_TESTVAR(PL_statcache);
408 ppp_TESTVAR(PL_stdingv);
409 ppp_TESTVAR(PL_sv_arenaroot);
410 ppp_TESTVAR(PL_tainted);
411 ppp_TESTVAR(PL_tainting);
413 ppp_PARSERVAR(ppp_expect_t, PL_expect);
414 ppp_PARSERVAR(line_t, PL_copline);
415 ppp_PARSERVAR(ppp_rsfp_t, PL_rsfp);
416 ppp_PARSERVAR(AV *, PL_rsfp_filters);
417 ppp_PARSERVAR(SV *, PL_linestr);
418 ppp_PARSERVAR(char *, PL_bufptr);
419 ppp_PARSERVAR(char *, PL_bufend);
420 ppp_PARSERVAR(ppp_lex_state_t, PL_lex_state);
421 ppp_PARSERVAR(SV *, PL_lex_stuff);
422 ppp_PARSERVAR(ppp_error_count_t, PL_error_count);
423 ppp_PARSERVAR(ppp_in_my_t, PL_in_my);
424 #if { VERSION >= 5.5.0 }
425 ppp_PARSERVAR(HV*, PL_in_my_stash);
432 no_dummy_parser_vars(check)
436 dummy_parser_warning()
440 ok(Devel::PPPort::compare_PL_signals());
442 ok(!defined(&Devel::PPPort::PL_sv_undef()));
443 ok(&Devel::PPPort::PL_sv_yes());
444 ok(!&Devel::PPPort::PL_sv_no());
445 is(&Devel::PPPort::PL_na("abcd"), 4);
446 is(&Devel::PPPort::PL_Sv(), "mhx");
447 ok(defined &Devel::PPPort::PL_tokenbuf());
448 ok(ivers($]) >= ivers("5.009005") || &Devel::PPPort::PL_parser());
449 ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
450 ok(defined &Devel::PPPort::PL_hints());
451 is(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
453 for (&Devel::PPPort::other_variables()) {
461 local $SIG{'__WARN__'} = sub { push @w, @_ };
462 ok(&Devel::PPPort::dummy_parser_warning());
464 if (ivers($]) >= ivers("5.009005")) {
468 unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) {
480 ok(&Devel::PPPort::no_dummy_parser_vars(1) >= (ivers($]) < ivers("5.009005") ? 1 : 0));
482 eval { &Devel::PPPort::no_dummy_parser_vars(0) };
484 if (ivers($]) < ivers("5.009005")) {
490 ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i);