PL_ppaddr PL_no_modify PL_DBsignal PL_DBsingle PL_DBsub PL_DBtrace PL_Sv PL_bufend PL_bufptr PL_compiling PL_copline PL_curcop PL_curstash PL_debstash PL_defgv PL_diehook PL_dirty PL_dowarn PL_errgv PL_error_count PL_expect PL_hexdigit PL_hints PL_in_my PL_in_my_stash PL_laststatval PL_lex_state PL_lex_stuff PL_linestr PL_na PL_parser PL_perl_destruct_level PL_perldb PL_rsfp_filters PL_rsfp PL_stack_base PL_stack_sp PL_statcache PL_stdingv PL_sv_arenaroot PL_sv_no PL_sv_undef PL_sv_yes PL_tainted PL_tainting PL_tokenbuf PL_signals PL_mess_sv PERL_SIGNALS_UNSAFE_FLAG

#ifndef PERL_SIGNALS_UNSAFE_FLAG

#define PERL_SIGNALS_UNSAFE_FLAG 0x0001

#if { VERSION < 5.8.0 } # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG #else # define D_PPP_PERL_SIGNALS_INIT 0 #endif

__NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT;

#endif

/* Hint: PL_ppaddr * Calling an op via PL_ppaddr requires passing a context argument * for threaded builds. Since the context argument is different for * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will * automatically be defined as the correct argument. */

#if { VERSION <= 5.005_05 } /* Replace: 1 */ # define PL_ppaddr ppaddr # define PL_no_modify no_modify /* Replace: 0 */ #endif

#if { VERSION <= 5.004_05 } /* Replace: 1 */ # define PL_DBsignal DBsignal # define PL_DBsingle DBsingle # define PL_DBsub DBsub # define PL_DBtrace DBtrace # define PL_Sv Sv # define PL_bufend bufend # define PL_bufptr bufptr # define PL_compiling compiling # define PL_copline copline # define PL_curcop curcop # define PL_curstash curstash # define PL_debstash debstash # define PL_defgv defgv # define PL_diehook diehook # define PL_dirty dirty # define PL_dowarn dowarn # define PL_errgv errgv # define PL_error_count error_count # define PL_expect expect # define PL_hexdigit hexdigit # define PL_hints hints # define PL_in_my in_my # define PL_laststatval laststatval # define PL_lex_state lex_state # define PL_lex_stuff lex_stuff # define PL_linestr linestr # define PL_na na # define PL_perl_destruct_level perl_destruct_level # define PL_perldb perldb # define PL_rsfp_filters rsfp_filters # define PL_rsfp rsfp # define PL_stack_base stack_base # define PL_stack_sp stack_sp # define PL_statcache statcache # define PL_stdingv stdingv # define PL_sv_arenaroot sv_arenaroot # define PL_sv_no sv_no # define PL_sv_undef sv_undef # define PL_sv_yes sv_yes # define PL_tainted tainted # define PL_tainting tainting # define PL_tokenbuf tokenbuf # define PL_mess_sv mess_sv /* Replace: 0 */ #endif

/* Warning: PL_parser * For perl versions earlier than 5.9.5, this is an always * non-NULL dummy. Also, it cannot be dereferenced. Don't * use it if you can avoid it, and unless you absolutely know * what you're doing. * If you always check that PL_parser is non-NULL, you can * define DPPP_PL_parser_NO_DUMMY to avoid the creation of * a dummy parser structure. */

#if { VERSION >= 5.9.5 } # ifdef DPPP_PL_parser_NO_DUMMY # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \ (croak("panic: PL_parser == NULL in %s:%d", \ __FILE__, __LINE__), (yy_parser *) NULL))->var) # else # ifdef DPPP_PL_parser_NO_DUMMY_WARNING # define D_PPP_parser_dummy_warning(var) # else # define D_PPP_parser_dummy_warning(var) \ warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__), # endif # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \ (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var) __NEED_DUMMY_VAR__ yy_parser PL_parser; # endif

/* 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 */ /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf * Do not use this variable unless you know exactly what you're * doing. It is internal to the perl parser and may change or even * be removed in the future. As of perl 5.9.5, you have to check * for (PL_parser != NULL) for this variable to have any effect. * An always non-NULL PL_parser dummy is provided for earlier * perl versions. * If PL_parser is NULL when you try to access this variable, a * dummy is being accessed instead and a warning is issued unless * you define DPPP_PL_parser_NO_DUMMY_WARNING. * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access * this variable will croak with a panic message. */

# define PL_expect D_PPP_my_PL_parser_var(expect) # define PL_copline D_PPP_my_PL_parser_var(copline) # define PL_rsfp D_PPP_my_PL_parser_var(rsfp) # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters) # define PL_linestr D_PPP_my_PL_parser_var(linestr) # define PL_bufptr D_PPP_my_PL_parser_var(bufptr) # define PL_bufend D_PPP_my_PL_parser_var(bufend) # define PL_lex_state D_PPP_my_PL_parser_var(lex_state) # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff) # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf) # define PL_in_my D_PPP_my_PL_parser_var(in_my) # define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash) # define PL_error_count D_PPP_my_PL_parser_var(error_count)

#else

/* ensure that PL_parser != NULL and cannot be dereferenced */ # define PL_parser ((void *) 1)

#endif

#define NEED_PL_signals #define NEED_PL_parser #define DPPP_PL_parser_NO_DUMMY_WARNING

U32 get_PL_signals_1(void) { #ifdef PERL_NO_GET_CONTEXT dTHX; #endif return PL_signals; }

extern U32 get_PL_signals_2(void); extern U32 get_PL_signals_3(void); int no_dummy_parser_vars(int); int dummy_parser_warning(void);

/* No PTRSIZE IN 5.004 and below, so PTR2IV would warn and possibly misbehave */ #if { VERSION > 5.004 } #define ppp_TESTVAR(var) STMT_START { mXPUSHi(PTR2IV(&var)); count++; } STMT_END #else #define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var); count++; } STMT_END #endif

#define ppp_PARSERVAR(type, var) STMT_START { \ type volatile my_ ## var; \ type volatile *my_p_ ## var; \ my_ ## var = var; \ my_p_ ## var = &var; \ var = my_ ## var; \ var = *my_p_ ## var; \ mXPUSHi(&var != NULL); \ count++; \ } STMT_END

#define ppp_PARSERVAR_dummy STMT_START { \ mXPUSHi(1); \ count++; \ } STMT_END

#if { VERSION < 5.004 } # define ppp_rsfp_t FILE * #else # define ppp_rsfp_t PerlIO * #endif

#if { VERSION < 5.6.0 } # define ppp_expect_t expectation #elif { VERSION < 5.9.5 } # define ppp_expect_t int #else # define ppp_expect_t U8 #endif

#if { VERSION < 5.9.5 } # define ppp_lex_state_t U32 #else # define ppp_lex_state_t U8 #endif

#if { VERSION < 5.6.0 } # define ppp_in_my_t bool #elif { VERSION < 5.9.5 } # define ppp_in_my_t I32 #else # define ppp_in_my_t U16 #endif

#if { VERSION < 5.9.5 } # define ppp_error_count_t I32 #else # define ppp_error_count_t U8 #endif

int compare_PL_signals() CODE: { U32 ref = get_PL_signals_1(); RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3(); } OUTPUT: RETVAL

SV * PL_sv_undef() CODE: RETVAL = newSVsv(&PL_sv_undef); OUTPUT: RETVAL

SV * PL_sv_yes() CODE: RETVAL = newSVsv(&PL_sv_yes); OUTPUT: RETVAL

SV * PL_sv_no() CODE: RETVAL = newSVsv(&PL_sv_no); OUTPUT: RETVAL

int PL_na(string) char *string CODE: PL_na = strlen(string); RETVAL = PL_na; OUTPUT: RETVAL

SV * PL_Sv() CODE: PL_Sv = newSVpv("mhx", 0); RETVAL = PL_Sv; OUTPUT: RETVAL

SV * PL_tokenbuf() CODE: RETVAL = newSViv(PL_tokenbuf[0]); OUTPUT: RETVAL

SV * PL_parser() CODE: RETVAL = newSViv(PL_parser != NULL); OUTPUT: RETVAL

SV * PL_hexdigit() CODE: RETVAL = newSVpv((char *) PL_hexdigit, 0); OUTPUT: RETVAL

SV * PL_hints() CODE: RETVAL = newSViv((IV) PL_hints); OUTPUT: RETVAL

void PL_ppaddr(string) char *string PPCODE: PUSHMARK(SP); mXPUSHs(newSVpv(string, 0)); PUTBACK; ENTER; (void)*(PL_ppaddr[OP_UC])(aTHXR); SPAGAIN; LEAVE; XSRETURN(1);

void other_variables() PREINIT: int count = 0; PPCODE: ppp_TESTVAR(PL_DBsignal); ppp_TESTVAR(PL_DBsingle); ppp_TESTVAR(PL_DBsub); ppp_TESTVAR(PL_DBtrace); ppp_TESTVAR(PL_compiling); ppp_TESTVAR(PL_curcop); ppp_TESTVAR(PL_curstash); ppp_TESTVAR(PL_debstash); ppp_TESTVAR(PL_defgv); ppp_TESTVAR(PL_diehook); #if { VERSION >= 5.13.7 } /* can't get a pointer any longer */ mXPUSHi(PL_dirty ? 1 : 1); count++; #else ppp_TESTVAR(PL_dirty); #endif ppp_TESTVAR(PL_dowarn); ppp_TESTVAR(PL_errgv); ppp_TESTVAR(PL_laststatval); ppp_TESTVAR(PL_no_modify); ppp_TESTVAR(PL_perl_destruct_level); ppp_TESTVAR(PL_perldb); ppp_TESTVAR(PL_stack_base); ppp_TESTVAR(PL_stack_sp); ppp_TESTVAR(PL_statcache); ppp_TESTVAR(PL_stdingv); ppp_TESTVAR(PL_sv_arenaroot); ppp_TESTVAR(PL_tainted); ppp_TESTVAR(PL_tainting);

ppp_PARSERVAR(ppp_expect_t, PL_expect);
ppp_PARSERVAR(line_t, PL_copline);
ppp_PARSERVAR(ppp_rsfp_t, PL_rsfp);
ppp_PARSERVAR(AV *, PL_rsfp_filters);
ppp_PARSERVAR(SV *, PL_linestr);
ppp_PARSERVAR(char *, PL_bufptr);
ppp_PARSERVAR(char *, PL_bufend);
ppp_PARSERVAR(ppp_lex_state_t, PL_lex_state);
ppp_PARSERVAR(SV *, PL_lex_stuff);
ppp_PARSERVAR(ppp_error_count_t, PL_error_count);
ppp_PARSERVAR(ppp_in_my_t, PL_in_my);
#if { VERSION >= 5.5.0 }
ppp_PARSERVAR(HV*, PL_in_my_stash);
#else
ppp_PARSERVAR_dummy;
#endif
XSRETURN(count);

int no_dummy_parser_vars(check) int check

int dummy_parser_warning()

ok(Devel::PPPort::compare_PL_signals());

ok(!defined(&Devel::PPPort::PL_sv_undef())); ok(&Devel::PPPort::PL_sv_yes()); ok(!&Devel::PPPort::PL_sv_no()); ok(&Devel::PPPort::PL_na("abcd"), 4); ok(&Devel::PPPort::PL_Sv(), "mhx"); ok(defined &Devel::PPPort::PL_tokenbuf()); ok("$]" >= 5.009005 || &Devel::PPPort::PL_parser()); ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/); ok(defined &Devel::PPPort::PL_hints()); ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");

for (&Devel::PPPort::other_variables()) { ok($_ != 0); }

{ my @w; my $fail = 0; { local $SIG{'__WARN__'} = sub { push @w, @_ }; ok(&Devel::PPPort::dummy_parser_warning()); } if ("$]" >= 5.009005) { ok(@w >= 0); for (@w) { print "# $_"; unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) { warn $_; $fail++; } } } else { ok(@w == 0); } ok($fail, 0); }

ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ("$]" < 5.009005 ? 1 : 0));

eval { &Devel::PPPort::no_dummy_parser_vars(0) };

if ("$]" < 5.009005) { ok($@, ''); } else { if ($@) { print "# $@"; ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i); } else { ok(1); } }

cpanm Devel::PPPort

perl -MCPAN -e shell
install Devel::PPPort