[perl5.git] / dist / Devel-PPPort / parts / inc / variables

################################################################################
##
##  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
##  Version 2.x, Copyright (C) 2001, Paul Marquess.
##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
##
##  This program is free software; you can redistribute it and/or
##  modify it under the same terms as Perl itself.
##
################################################################################

=provides

PL_ppaddr
PL_no_modify
PL_DBsignal
PL_DBsingle
PL_DBsub
PL_DBtrace
PL_Sv
PL_Xpv
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

=implementation

#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_Xpv                    Xpv
#  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

=xsinit

#define NEED_PL_signals
#define NEED_PL_parser
#define DPPP_PL_parser_NO_DUMMY_WARNING

=xsmisc

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

=xsubs

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()

=tests plan => 52

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());
is(&Devel::PPPort::PL_na("abcd"), 4);
is(&Devel::PPPort::PL_Sv(), "mhx");
ok(defined &Devel::PPPort::PL_tokenbuf());
ok(ivers($]) >= ivers("5.009005") || &Devel::PPPort::PL_parser());
ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
ok(defined &Devel::PPPort::PL_hints());
is(&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 (ivers($]) >= ivers("5.009005")) {
    ok(@w >= 0);
    for (@w) {
      print "# $_";
      unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) {
        warn $_;
        $fail++;
      }
    }
  }
  else {
    ok(@w == 0);
  }
  is($fail, 0);
}

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

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

if (ivers($]) < ivers("5.009005")) {
  is($@, '');
}
else {
  if ($@) {
    print "# $@";
    ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i);
  }
  else {
    ok(1);
  }
}
Commit	Line	Data
0d0f8426 MHM	1	################################################################################
0d0f8426 MHM	2	##
b2049988	3	## Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
0d0f8426 MHM	4	## Version 2.x, Copyright (C) 2001, Paul Marquess.
	5	## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
	6	##
	7	## This program is free software; you can redistribute it and/or
	8	## modify it under the same terms as Perl itself.
	9	##
	10	################################################################################
	11
	12	=provides
	13
679ad62d MHM	14	PL_ppaddr
	15	PL_no_modify
	16	PL_DBsignal
	17	PL_DBsingle
	18	PL_DBsub
	19	PL_DBtrace
	20	PL_Sv
8f62b02f	21	PL_Xpv
c01be2ce MHM	22	PL_bufend
c01be2ce MHM	23	PL_bufptr
679ad62d MHM	24	PL_compiling
	25	PL_copline
	26	PL_curcop
	27	PL_curstash
	28	PL_debstash
	29	PL_defgv
	30	PL_diehook
	31	PL_dirty
	32	PL_dowarn
	33	PL_errgv
8565c31a	34	PL_error_count
679ad62d MHM	35	PL_expect
	36	PL_hexdigit
	37	PL_hints
8565c31a MHM	38	PL_in_my
8565c31a MHM	39	PL_in_my_stash
679ad62d	40	PL_laststatval
c01be2ce MHM	41	PL_lex_state
	42	PL_lex_stuff
	43	PL_linestr
679ad62d	44	PL_na
c01be2ce	45	PL_parser
679ad62d MHM	46	PL_perl_destruct_level
	47	PL_perldb
	48	PL_rsfp_filters
	49	PL_rsfp
	50	PL_stack_base
	51	PL_stack_sp
	52	PL_statcache
	53	PL_stdingv
	54	PL_sv_arenaroot
	55	PL_sv_no
	56	PL_sv_undef
	57	PL_sv_yes
	58	PL_tainted
	59	PL_tainting
c01be2ce	60	PL_tokenbuf
679ad62d	61	PL_signals
a2347a4b	62	PL_mess_sv
0d0f8426 MHM	63	PERL_SIGNALS_UNSAFE_FLAG
	64
	65	=implementation
	66
	67	#ifndef PERL_SIGNALS_UNSAFE_FLAG
	68
	69	#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
	70
cac25305 MHM	71	#if { VERSION < 5.8.0 }
	72	# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
	73	#else
	74	# define D_PPP_PERL_SIGNALS_INIT 0
	75	#endif
	76
	77	__NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT;
	78
	79	#endif
0d0f8426	80
cac25305 MHM	81	/* Hint: PL_ppaddr
	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.
	86	*/
	87
c58e738a	88	#if { VERSION <= 5.005_05 }
cac25305 MHM	89	/* Replace: 1 */
	90	# define PL_ppaddr ppaddr
	91	# define PL_no_modify no_modify
	92	/* Replace: 0 */
	93	#endif
	94
	95	#if { VERSION <= 5.004_05 }
	96	/* Replace: 1 */
	97	# define PL_DBsignal DBsignal
	98	# define PL_DBsingle DBsingle
	99	# define PL_DBsub DBsub
	100	# define PL_DBtrace DBtrace
	101	# define PL_Sv Sv
8f62b02f	102	# define PL_Xpv Xpv
c01be2ce MHM	103	# define PL_bufend bufend
c01be2ce MHM	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
8565c31a	115	# define PL_error_count error_count
a89b7ab8	116	# define PL_expect expect
cac25305 MHM	117	# define PL_hexdigit hexdigit
cac25305 MHM	118	# define PL_hints hints
8565c31a	119	# define PL_in_my in_my
cac25305	120	# define PL_laststatval laststatval
c01be2ce MHM	121	# define PL_lex_state lex_state
	122	# define PL_lex_stuff lex_stuff
	123	# define PL_linestr linestr
cac25305 MHM	124	# define PL_na na
	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
c01be2ce	139	# define PL_tokenbuf tokenbuf
a2347a4b	140	# define PL_mess_sv mess_sv
cac25305	141	/* Replace: 0 */
0d0f8426 MHM	142	#endif
0d0f8426 MHM	143
c01be2ce MHM	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
cf8ff603	147	* use it if you can avoid it, and unless you absolutely know
c01be2ce MHM	148	* what you're doing.
	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.
679ad62d MHM	152	*/
679ad62d MHM	153
53a7735b	154	#if { VERSION >= 5.9.5 }
c01be2ce MHM	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)
	159	# else
	160	# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
	161	# define D_PPP_parser_dummy_warning(var)
	162	# else
	163	# define D_PPP_parser_dummy_warning(var) \
	164	warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
	165	# endif
	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;
	169	# endif
	170
	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
94e22bd6	174	* doing. It is internal to the perl parser and may change or even
c01be2ce MHM	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
	178	* perl versions.
	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.
	184	*/
	185
	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)
8565c31a MHM	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)
	199
c01be2ce MHM	200
	201	#else
	202
	203	/* ensure that PL_parser != NULL and cannot be dereferenced */
	204	# define PL_parser ((void *) 1)
	205
53a7735b DM	206	#endif
53a7735b DM	207
0d0f8426 MHM	208	=xsinit
	209
	210	#define NEED_PL_signals
c01be2ce MHM	211	#define NEED_PL_parser
c01be2ce MHM	212	#define DPPP_PL_parser_NO_DUMMY_WARNING
0d0f8426 MHM	213
	214	=xsmisc
	215
	216	U32 get_PL_signals_1(void)
	217	{
b2049988 MHM	218	#ifdef PERL_NO_GET_CONTEXT
	219	dTHX;
	220	#endif
0d0f8426 MHM	221	return PL_signals;
	222	}
	223
	224	extern U32 get_PL_signals_2(void);
	225	extern U32 get_PL_signals_3(void);
c01be2ce MHM	226	int no_dummy_parser_vars(int);
	227	int dummy_parser_warning(void);
	228
94e22bd6 MH	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
	232	#else
	233	#define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var); count++; } STMT_END
	234	#endif
c01be2ce MHM	235
	236	#define ppp_PARSERVAR(type, var) STMT_START { \
	237	type volatile my_ ## var; \
	238	type volatile *my_p_ ## var; \
	239	my_ ## var = var; \
	240	my_p_ ## var = &var; \
	241	var = my_ ## var; \
	242	var = *my_p_ ## var; \
	243	mXPUSHi(&var != NULL); \
	244	count++; \
	245	} STMT_END
	246
8565c31a MHM	247	#define ppp_PARSERVAR_dummy STMT_START { \
	248	mXPUSHi(1); \
	249	count++; \
	250	} STMT_END
	251
fd7af155 MHM	252	#if { VERSION < 5.004 }
	253	# define ppp_rsfp_t FILE *
	254	#else
	255	# define ppp_rsfp_t PerlIO *
	256	#endif
	257
	258	#if { VERSION < 5.6.0 }
c01be2ce	259	# define ppp_expect_t expectation
fd7af155	260	#elif { VERSION < 5.9.5 }
c01be2ce MHM	261	# define ppp_expect_t int
	262	#else
	263	# define ppp_expect_t U8
	264	#endif
0d0f8426	265
fd7af155	266	#if { VERSION < 5.9.5 }
c01be2ce MHM	267	# define ppp_lex_state_t U32
	268	#else
	269	# define ppp_lex_state_t U8
	270	#endif
cac25305	271
8565c31a MHM	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
	276	#else
	277	# define ppp_in_my_t U16
	278	#endif
	279
	280	#if { VERSION < 5.9.5 }
	281	# define ppp_error_count_t I32
	282	#else
	283	# define ppp_error_count_t U8
	284	#endif
	285
0d0f8426 MHM	286	=xsubs
	287
	288	int
	289	compare_PL_signals()
b2049988 MHM	290	CODE:
	291	{
	292	U32 ref = get_PL_signals_1();
	293	RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3();
	294	}
	295	OUTPUT:
	296	RETVAL
0d0f8426	297
cac25305 MHM	298	SV *
cac25305 MHM	299	PL_sv_undef()
b2049988 MHM	300	CODE:
	301	RETVAL = newSVsv(&PL_sv_undef);
	302	OUTPUT:
	303	RETVAL
cac25305 MHM	304
	305	SV *
	306	PL_sv_yes()
b2049988 MHM	307	CODE:
	308	RETVAL = newSVsv(&PL_sv_yes);
	309	OUTPUT:
	310	RETVAL
cac25305 MHM	311
	312	SV *
	313	PL_sv_no()
b2049988 MHM	314	CODE:
	315	RETVAL = newSVsv(&PL_sv_no);
	316	OUTPUT:
	317	RETVAL
cac25305 MHM	318
	319	int
	320	PL_na(string)
b2049988 MHM	321	char *string
	322	CODE:
	323	PL_na = strlen(string);
	324	RETVAL = PL_na;
	325	OUTPUT:
	326	RETVAL
cac25305 MHM	327
	328	SV *
	329	PL_Sv()
b2049988 MHM	330	CODE:
	331	PL_Sv = newSVpv("mhx", 0);
	332	RETVAL = PL_Sv;
	333	OUTPUT:
	334	RETVAL
cac25305 MHM	335
cac25305 MHM	336	SV *
c01be2ce	337	PL_tokenbuf()
b2049988 MHM	338	CODE:
	339	RETVAL = newSViv(PL_tokenbuf[0]);
	340	OUTPUT:
	341	RETVAL
679ad62d MHM	342
679ad62d MHM	343	SV *
c01be2ce	344	PL_parser()
b2049988 MHM	345	CODE:
	346	RETVAL = newSViv(PL_parser != NULL);
	347	OUTPUT:
	348	RETVAL
679ad62d MHM	349
679ad62d MHM	350	SV *
cac25305	351	PL_hexdigit()
b2049988 MHM	352	CODE:
	353	RETVAL = newSVpv((char *) PL_hexdigit, 0);
	354	OUTPUT:
	355	RETVAL
cac25305 MHM	356
	357	SV *
	358	PL_hints()
b2049988 MHM	359	CODE:
	360	RETVAL = newSViv((IV) PL_hints);
	361	OUTPUT:
	362	RETVAL
cac25305 MHM	363
	364	void
	365	PL_ppaddr(string)
b2049988 MHM	366	char *string
	367	PPCODE:
	368	PUSHMARK(SP);
	369	mXPUSHs(newSVpv(string, 0));
	370	PUTBACK;
	371	ENTER;
	372	(void)*(PL_ppaddr[OP_UC])(aTHXR);
	373	SPAGAIN;
	374	LEAVE;
	375	XSRETURN(1);
cac25305 MHM	376
	377	void
	378	other_variables()
b2049988 MHM	379	PREINIT:
	380	int count = 0;
	381	PPCODE:
	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);
49ef49fe CBW	392	#if { VERSION >= 5.13.7 }
	393	/* can't get a pointer any longer */
	394	mXPUSHi(PL_dirty ? 1 : 1);
	395	count++;
627364f1	396	#else
b2049988	397	ppp_TESTVAR(PL_dirty);
627364f1	398	#endif
b2049988 MHM	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);
	412
	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);
8565c31a	424	#if { VERSION >= 5.5.0 }
b2049988	425	ppp_PARSERVAR(HV*, PL_in_my_stash);
8565c31a	426	#else
b2049988	427	ppp_PARSERVAR_dummy;
8565c31a	428	#endif
b2049988	429	XSRETURN(count);
cac25305	430
c01be2ce MHM	431	int
c01be2ce MHM	432	no_dummy_parser_vars(check)
b2049988	433	int check
c01be2ce MHM	434
	435	int
	436	dummy_parser_warning()
	437
8565c31a	438	=tests plan => 52
0d0f8426 MHM	439
	440	ok(Devel::PPPort::compare_PL_signals());
	441
cac25305 MHM	442	ok(!defined(&Devel::PPPort::PL_sv_undef()));
	443	ok(&Devel::PPPort::PL_sv_yes());
	444	ok(!&Devel::PPPort::PL_sv_no());
8154c0b1 KW	445	is(&Devel::PPPort::PL_na("abcd"), 4);
8154c0b1 KW	446	is(&Devel::PPPort::PL_Sv(), "mhx");
c01be2ce	447	ok(defined &Devel::PPPort::PL_tokenbuf());
c8799aff	448	ok(ivers($]) >= ivers("5.009005") \|\| &Devel::PPPort::PL_parser());
cac25305 MHM	449	ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
cac25305 MHM	450	ok(defined &Devel::PPPort::PL_hints());
8154c0b1	451	is(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
cac25305 MHM	452
	453	for (&Devel::PPPort::other_variables()) {
	454	ok($_ != 0);
	455	}
c01be2ce MHM	456
	457	{
	458	my @w;
	459	my $fail = 0;
	460	{
	461	local $SIG{'__WARN__'} = sub { push @w, @_ };
	462	ok(&Devel::PPPort::dummy_parser_warning());
	463	}
c8799aff	464	if (ivers($]) >= ivers("5.009005")) {
c01be2ce MHM	465	ok(@w >= 0);
	466	for (@w) {
	467	print "# $_";
	468	unless (/^warning: dummy PL_bufptr used in.module3.:\d+/i) {
	469	warn $_;
	470	$fail++;
	471	}
	472	}
	473	}
	474	else {
	475	ok(@w == 0);
	476	}
8154c0b1	477	is($fail, 0);
c01be2ce MHM	478	}
c01be2ce MHM	479
c8799aff	480	ok(&Devel::PPPort::no_dummy_parser_vars(1) >= (ivers($]) < ivers("5.009005") ? 1 : 0));
c01be2ce MHM	481
	482	eval { &Devel::PPPort::no_dummy_parser_vars(0) };
	483
c8799aff	484	if (ivers($]) < ivers("5.009005")) {
8154c0b1	485	is($@, '');
c01be2ce MHM	486	}
	487	else {
	488	if ($@) {
	489	print "# $@";
	490	ok($@ =~ /^panic: PL_parser == NULL in.module2.:\d+/i);
	491	}
	492	else {
	493	ok(1);
	494	}
	495	}