1 ################################################################################
5 ## $Date: 2010/03/07 13:15:46 +0100 $
7 ################################################################################
9 ## Version 3.x, Copyright (C) 2004-2010, Marcus Holland-Moritz.
10 ## Version 2.x, Copyright (C) 2001, Paul Marquess.
11 ## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
13 ## This program is free software; you can redistribute it and/or
14 ## modify it under the same terms as Perl itself.
16 ################################################################################
51 PL_perl_destruct_level
67 PERL_SIGNALS_UNSAFE_FLAG
71 #ifndef PERL_SIGNALS_UNSAFE_FLAG
73 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
75 #if { VERSION < 5.8.0 }
76 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
78 # define D_PPP_PERL_SIGNALS_INIT 0
81 __NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT;
86 * Calling an op via PL_ppaddr requires passing a context argument
87 * for threaded builds. Since the context argument is different for
88 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
89 * automatically be defined as the correct argument.
92 #if { VERSION <= 5.005_05 }
94 # define PL_ppaddr ppaddr
95 # define PL_no_modify no_modify
99 #if { VERSION <= 5.004_05 }
101 # define PL_DBsignal DBsignal
102 # define PL_DBsingle DBsingle
103 # define PL_DBsub DBsub
104 # define PL_DBtrace DBtrace
106 # define PL_bufend bufend
107 # define PL_bufptr bufptr
108 # define PL_compiling compiling
109 # define PL_copline copline
110 # define PL_curcop curcop
111 # define PL_curstash curstash
112 # define PL_debstash debstash
113 # define PL_defgv defgv
114 # define PL_diehook diehook
115 # define PL_dirty dirty
116 # define PL_dowarn dowarn
117 # define PL_errgv errgv
118 # define PL_error_count error_count
119 # define PL_expect expect
120 # define PL_hexdigit hexdigit
121 # define PL_hints hints
122 # define PL_in_my in_my
123 # define PL_laststatval laststatval
124 # define PL_lex_state lex_state
125 # define PL_lex_stuff lex_stuff
126 # define PL_linestr linestr
128 # define PL_perl_destruct_level perl_destruct_level
129 # define PL_perldb perldb
130 # define PL_rsfp_filters rsfp_filters
131 # define PL_rsfp rsfp
132 # define PL_stack_base stack_base
133 # define PL_stack_sp stack_sp
134 # define PL_statcache statcache
135 # define PL_stdingv stdingv
136 # define PL_sv_arenaroot sv_arenaroot
137 # define PL_sv_no sv_no
138 # define PL_sv_undef sv_undef
139 # define PL_sv_yes sv_yes
140 # define PL_tainted tainted
141 # define PL_tainting tainting
142 # define PL_tokenbuf tokenbuf
146 /* Warning: PL_parser
147 * For perl versions earlier than 5.9.5, this is an always
148 * non-NULL dummy. Also, it cannot be dereferenced. Don't
149 * use it if you can avoid is and unless you absolutely know
151 * If you always check that PL_parser is non-NULL, you can
152 * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
153 * a dummy parser structure.
156 #if { VERSION >= 5.9.5 }
157 # ifdef DPPP_PL_parser_NO_DUMMY
158 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
159 (croak("panic: PL_parser == NULL in %s:%d", \
160 __FILE__, __LINE__), (yy_parser *) NULL))->var)
162 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
163 # define D_PPP_parser_dummy_warning(var)
165 # define D_PPP_parser_dummy_warning(var) \
166 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
168 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
169 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
170 __NEED_DUMMY_VAR__ yy_parser PL_parser;
173 /* 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 */
174 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
175 * Do not use this variable unless you know exactly what you're
176 * doint. It is internal to the perl parser and may change or even
177 * be removed in the future. As of perl 5.9.5, you have to check
178 * for (PL_parser != NULL) for this variable to have any effect.
179 * An always non-NULL PL_parser dummy is provided for earlier
181 * If PL_parser is NULL when you try to access this variable, a
182 * dummy is being accessed instead and a warning is issued unless
183 * you define DPPP_PL_parser_NO_DUMMY_WARNING.
184 * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
185 * this variable will croak with a panic message.
188 # define PL_expect D_PPP_my_PL_parser_var(expect)
189 # define PL_copline D_PPP_my_PL_parser_var(copline)
190 # define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
191 # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
192 # define PL_linestr D_PPP_my_PL_parser_var(linestr)
193 # define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
194 # define PL_bufend D_PPP_my_PL_parser_var(bufend)
195 # define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
196 # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
197 # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
198 # define PL_in_my D_PPP_my_PL_parser_var(in_my)
199 # define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
200 # define PL_error_count D_PPP_my_PL_parser_var(error_count)
205 /* ensure that PL_parser != NULL and cannot be dereferenced */
206 # define PL_parser ((void *) 1)
212 #define NEED_PL_signals
213 #define NEED_PL_parser
214 #define DPPP_PL_parser_NO_DUMMY_WARNING
218 U32 get_PL_signals_1(void)
223 extern U32 get_PL_signals_2(void);
224 extern U32 get_PL_signals_3(void);
225 int no_dummy_parser_vars(int);
226 int dummy_parser_warning(void);
228 #define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var != NULL); count++; } STMT_END
230 #define ppp_PARSERVAR(type, var) STMT_START { \
231 type volatile my_ ## var; \
232 type volatile *my_p_ ## var; \
234 my_p_ ## var = &var; \
236 var = *my_p_ ## var; \
237 mXPUSHi(&var != NULL); \
241 #define ppp_PARSERVAR_dummy STMT_START { \
246 #if { VERSION < 5.004 }
247 # define ppp_rsfp_t FILE *
249 # define ppp_rsfp_t PerlIO *
252 #if { VERSION < 5.6.0 }
253 # define ppp_expect_t expectation
254 #elif { VERSION < 5.9.5 }
255 # define ppp_expect_t int
257 # define ppp_expect_t U8
260 #if { VERSION < 5.9.5 }
261 # define ppp_lex_state_t U32
263 # define ppp_lex_state_t U8
266 #if { VERSION < 5.6.0 }
267 # define ppp_in_my_t bool
268 #elif { VERSION < 5.9.5 }
269 # define ppp_in_my_t I32
271 # define ppp_in_my_t U16
274 #if { VERSION < 5.9.5 }
275 # define ppp_error_count_t I32
277 # define ppp_error_count_t U8
286 U32 ref = get_PL_signals_1();
287 RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3();
295 RETVAL = newSVsv(&PL_sv_undef);
302 RETVAL = newSVsv(&PL_sv_yes);
309 RETVAL = newSVsv(&PL_sv_no);
317 PL_na = strlen(string);
325 PL_Sv = newSVpv("mhx", 0);
333 RETVAL = newSViv(PL_tokenbuf[0]);
340 RETVAL = newSViv(PL_parser != NULL);
347 RETVAL = newSVpv((char *) PL_hexdigit, 0);
354 RETVAL = newSViv((IV) PL_hints);
363 mXPUSHs(newSVpv(string, 0));
366 (void)*(PL_ppaddr[OP_UC])(aTHXR);
376 ppp_TESTVAR(PL_DBsignal);
377 ppp_TESTVAR(PL_DBsingle);
378 ppp_TESTVAR(PL_DBsub);
379 ppp_TESTVAR(PL_DBtrace);
380 ppp_TESTVAR(PL_compiling);
381 ppp_TESTVAR(PL_curcop);
382 ppp_TESTVAR(PL_curstash);
383 ppp_TESTVAR(PL_debstash);
384 ppp_TESTVAR(PL_defgv);
385 ppp_TESTVAR(PL_diehook);
386 ppp_TESTVAR(PL_dirty);
387 ppp_TESTVAR(PL_dowarn);
388 ppp_TESTVAR(PL_errgv);
389 ppp_TESTVAR(PL_laststatval);
390 ppp_TESTVAR(PL_no_modify);
391 ppp_TESTVAR(PL_perl_destruct_level);
392 ppp_TESTVAR(PL_perldb);
393 ppp_TESTVAR(PL_stack_base);
394 ppp_TESTVAR(PL_stack_sp);
395 ppp_TESTVAR(PL_statcache);
396 ppp_TESTVAR(PL_stdingv);
397 ppp_TESTVAR(PL_sv_arenaroot);
398 ppp_TESTVAR(PL_tainted);
399 ppp_TESTVAR(PL_tainting);
401 ppp_PARSERVAR(ppp_expect_t, PL_expect);
402 ppp_PARSERVAR(line_t, PL_copline);
403 ppp_PARSERVAR(ppp_rsfp_t, PL_rsfp);
404 ppp_PARSERVAR(AV *, PL_rsfp_filters);
405 ppp_PARSERVAR(SV *, PL_linestr);
406 ppp_PARSERVAR(char *, PL_bufptr);
407 ppp_PARSERVAR(char *, PL_bufend);
408 ppp_PARSERVAR(ppp_lex_state_t, PL_lex_state);
409 ppp_PARSERVAR(SV *, PL_lex_stuff);
410 ppp_PARSERVAR(ppp_error_count_t, PL_error_count);
411 ppp_PARSERVAR(ppp_in_my_t, PL_in_my);
412 #if { VERSION >= 5.5.0 }
413 ppp_PARSERVAR(HV*, PL_in_my_stash);
420 no_dummy_parser_vars(check)
424 dummy_parser_warning()
428 ok(Devel::PPPort::compare_PL_signals());
430 ok(!defined(&Devel::PPPort::PL_sv_undef()));
431 ok(&Devel::PPPort::PL_sv_yes());
432 ok(!&Devel::PPPort::PL_sv_no());
433 ok(&Devel::PPPort::PL_na("abcd"), 4);
434 ok(&Devel::PPPort::PL_Sv(), "mhx");
435 ok(defined &Devel::PPPort::PL_tokenbuf());
436 ok($] >= 5.009005 || &Devel::PPPort::PL_parser());
437 ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
438 ok(defined &Devel::PPPort::PL_hints());
439 ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
441 for (&Devel::PPPort::other_variables()) {
449 local $SIG{'__WARN__'} = sub { push @w, @_ };
450 ok(&Devel::PPPort::dummy_parser_warning());
452 if ($] >= 5.009005) {
456 unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) {
468 ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ($] < 5.009005 ? 1 : 0));
470 eval { &Devel::PPPort::no_dummy_parser_vars(0) };
478 ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i);