1 ################################################################################
5 ## $Date: 2009/01/18 14:10:53 +0100 $
7 ################################################################################
9 ## Version 3.x, Copyright (C) 2004-2009, 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 ################################################################################
48 PL_perl_destruct_level
64 PERL_SIGNALS_UNSAFE_FLAG
68 #ifndef PERL_SIGNALS_UNSAFE_FLAG
70 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
72 #if { VERSION < 5.8.0 }
73 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
75 # define D_PPP_PERL_SIGNALS_INIT 0
78 __NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT;
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.
89 #if { VERSION <= 5.005_05 }
91 # define PL_ppaddr ppaddr
92 # define PL_no_modify no_modify
96 #if { VERSION <= 5.004_05 }
98 # define PL_DBsignal DBsignal
99 # define PL_DBsingle DBsingle
100 # define PL_DBsub DBsub
101 # 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_expect expect
116 # define PL_hexdigit hexdigit
117 # define PL_hints hints
118 # define PL_laststatval laststatval
119 # define PL_lex_state lex_state
120 # define PL_lex_stuff lex_stuff
121 # define PL_linestr linestr
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
137 # define PL_tokenbuf tokenbuf
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
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.
151 #if { VERSION >= 5.9.5 }
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)
157 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
158 # define D_PPP_parser_dummy_warning(var)
160 # define D_PPP_parser_dummy_warning(var) \
161 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
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;
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
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.
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)
196 /* ensure that PL_parser != NULL and cannot be dereferenced */
197 # define PL_parser ((void *) 1)
203 #define NEED_PL_signals
204 #define NEED_PL_parser
205 #define DPPP_PL_parser_NO_DUMMY_WARNING
209 U32 get_PL_signals_1(void)
214 extern U32 get_PL_signals_2(void);
215 extern U32 get_PL_signals_3(void);
216 int no_dummy_parser_vars(int);
217 int dummy_parser_warning(void);
219 #define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var != NULL); count++; } STMT_END
221 #define ppp_PARSERVAR(type, var) STMT_START { \
222 type volatile my_ ## var; \
223 type volatile *my_p_ ## var; \
225 my_p_ ## var = &var; \
227 var = *my_p_ ## var; \
228 mXPUSHi(&var != NULL); \
232 #if { VERSION < 5.004 }
233 # define ppp_rsfp_t FILE *
235 # define ppp_rsfp_t PerlIO *
238 #if { VERSION < 5.6.0 }
239 # define ppp_expect_t expectation
240 #elif { VERSION < 5.9.5 }
241 # define ppp_expect_t int
243 # define ppp_expect_t U8
246 #if { VERSION < 5.9.5 }
247 # define ppp_lex_state_t U32
249 # define ppp_lex_state_t U8
258 U32 ref = get_PL_signals_1();
259 RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3();
267 RETVAL = newSVsv(&PL_sv_undef);
274 RETVAL = newSVsv(&PL_sv_yes);
281 RETVAL = newSVsv(&PL_sv_no);
289 PL_na = strlen(string);
297 PL_Sv = newSVpv("mhx", 0);
305 RETVAL = newSViv(PL_tokenbuf[0]);
312 RETVAL = newSViv(PL_parser != NULL);
319 RETVAL = newSVpv((char *) PL_hexdigit, 0);
326 RETVAL = newSViv((IV) PL_hints);
335 mXPUSHs(newSVpv(string, 0));
338 (void)*(PL_ppaddr[OP_UC])(aTHXR);
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);
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);
373 ppp_PARSERVAR(ppp_expect_t, PL_expect);
374 ppp_PARSERVAR(line_t, PL_copline);
375 ppp_PARSERVAR(ppp_rsfp_t, PL_rsfp);
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);
386 no_dummy_parser_vars(check)
390 dummy_parser_warning()
394 ok(Devel::PPPort::compare_PL_signals());
396 ok(!defined(&Devel::PPPort::PL_sv_undef()));
397 ok(&Devel::PPPort::PL_sv_yes());
398 ok(!&Devel::PPPort::PL_sv_no());
399 ok(&Devel::PPPort::PL_na("abcd"), 4);
400 ok(&Devel::PPPort::PL_Sv(), "mhx");
401 ok(defined &Devel::PPPort::PL_tokenbuf());
402 ok($] >= 5.009005 || &Devel::PPPort::PL_parser());
403 ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
404 ok(defined &Devel::PPPort::PL_hints());
405 ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
407 for (&Devel::PPPort::other_variables()) {
415 local $SIG{'__WARN__'} = sub { push @w, @_ };
416 ok(&Devel::PPPort::dummy_parser_warning());
418 if ($] >= 5.009005) {
422 unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) {
434 ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ($] < 5.009005 ? 1 : 0));
436 eval { &Devel::PPPort::no_dummy_parser_vars(0) };
444 ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i);