[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_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
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_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
/* 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 is 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());
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);
  }
}
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
c01be2ce MHM	21	PL_bufend
c01be2ce MHM	22	PL_bufptr
679ad62d MHM	23	PL_compiling
	24	PL_copline
	25	PL_curcop
	26	PL_curstash
	27	PL_debstash
	28	PL_defgv
	29	PL_diehook
	30	PL_dirty
	31	PL_dowarn
	32	PL_errgv
8565c31a	33	PL_error_count
679ad62d MHM	34	PL_expect
	35	PL_hexdigit
	36	PL_hints
8565c31a MHM	37	PL_in_my
8565c31a MHM	38	PL_in_my_stash
679ad62d	39	PL_laststatval
c01be2ce MHM	40	PL_lex_state
	41	PL_lex_stuff
	42	PL_linestr
679ad62d	43	PL_na
c01be2ce	44	PL_parser
679ad62d MHM	45	PL_perl_destruct_level
	46	PL_perldb
	47	PL_rsfp_filters
	48	PL_rsfp
	49	PL_stack_base
	50	PL_stack_sp
	51	PL_statcache
	52	PL_stdingv
	53	PL_sv_arenaroot
	54	PL_sv_no
	55	PL_sv_undef
	56	PL_sv_yes
	57	PL_tainted
	58	PL_tainting
c01be2ce	59	PL_tokenbuf
679ad62d	60	PL_signals
0d0f8426 MHM	61	PERL_SIGNALS_UNSAFE_FLAG
	62
	63	=implementation
	64
	65	#ifndef PERL_SIGNALS_UNSAFE_FLAG
	66
	67	#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
	68
cac25305 MHM	69	#if { VERSION < 5.8.0 }
	70	# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
	71	#else
	72	# define D_PPP_PERL_SIGNALS_INIT 0
	73	#endif
	74
	75	__NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT;
	76
	77	#endif
0d0f8426	78
cac25305 MHM	79	/* Hint: PL_ppaddr
	80	* Calling an op via PL_ppaddr requires passing a context argument
	81	* for threaded builds. Since the context argument is different for
	82	* 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
	83	* automatically be defined as the correct argument.
	84	*/
	85
c58e738a	86	#if { VERSION <= 5.005_05 }
cac25305 MHM	87	/* Replace: 1 */
	88	# define PL_ppaddr ppaddr
	89	# define PL_no_modify no_modify
	90	/* Replace: 0 */
	91	#endif
	92
	93	#if { VERSION <= 5.004_05 }
	94	/* Replace: 1 */
	95	# define PL_DBsignal DBsignal
	96	# define PL_DBsingle DBsingle
	97	# define PL_DBsub DBsub
	98	# define PL_DBtrace DBtrace
	99	# define PL_Sv Sv
c01be2ce MHM	100	# define PL_bufend bufend
c01be2ce MHM	101	# define PL_bufptr bufptr
cac25305 MHM	102	# define PL_compiling compiling
	103	# define PL_copline copline
	104	# define PL_curcop curcop
	105	# define PL_curstash curstash
	106	# define PL_debstash debstash
	107	# define PL_defgv defgv
	108	# define PL_diehook diehook
	109	# define PL_dirty dirty
	110	# define PL_dowarn dowarn
	111	# define PL_errgv errgv
8565c31a	112	# define PL_error_count error_count
a89b7ab8	113	# define PL_expect expect
cac25305 MHM	114	# define PL_hexdigit hexdigit
cac25305 MHM	115	# define PL_hints hints
8565c31a	116	# define PL_in_my in_my
cac25305	117	# define PL_laststatval laststatval
c01be2ce MHM	118	# define PL_lex_state lex_state
	119	# define PL_lex_stuff lex_stuff
	120	# define PL_linestr linestr
cac25305 MHM	121	# define PL_na na
	122	# define PL_perl_destruct_level perl_destruct_level
	123	# define PL_perldb perldb
	124	# define PL_rsfp_filters rsfp_filters
	125	# define PL_rsfp rsfp
	126	# define PL_stack_base stack_base
	127	# define PL_stack_sp stack_sp
	128	# define PL_statcache statcache
	129	# define PL_stdingv stdingv
	130	# define PL_sv_arenaroot sv_arenaroot
	131	# define PL_sv_no sv_no
	132	# define PL_sv_undef sv_undef
	133	# define PL_sv_yes sv_yes
	134	# define PL_tainted tainted
	135	# define PL_tainting tainting
c01be2ce	136	# define PL_tokenbuf tokenbuf
cac25305	137	/* Replace: 0 */
0d0f8426 MHM	138	#endif
0d0f8426 MHM	139
c01be2ce MHM	140	/* Warning: PL_parser
	141	* For perl versions earlier than 5.9.5, this is an always
	142	* non-NULL dummy. Also, it cannot be dereferenced. Don't
	143	* use it if you can avoid is and unless you absolutely know
	144	* what you're doing.
	145	* If you always check that PL_parser is non-NULL, you can
	146	* define DPPP_PL_parser_NO_DUMMY to avoid the creation of
	147	* a dummy parser structure.
679ad62d MHM	148	*/
679ad62d MHM	149
53a7735b	150	#if { VERSION >= 5.9.5 }
c01be2ce MHM	151	# ifdef DPPP_PL_parser_NO_DUMMY
	152	# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
	153	(croak("panic: PL_parser == NULL in %s:%d", \
	154	__FILE__, __LINE__), (yy_parser *) NULL))->var)
	155	# else
	156	# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
	157	# define D_PPP_parser_dummy_warning(var)
	158	# else
	159	# define D_PPP_parser_dummy_warning(var) \
	160	warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
	161	# endif
	162	# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
	163	(D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
	164	__NEED_DUMMY_VAR__ yy_parser PL_parser;
	165	# endif
	166
	167	/* 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 */
	168	/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
	169	* Do not use this variable unless you know exactly what you're
94e22bd6	170	* doing. It is internal to the perl parser and may change or even
c01be2ce MHM	171	* be removed in the future. As of perl 5.9.5, you have to check
	172	* for (PL_parser != NULL) for this variable to have any effect.
	173	* An always non-NULL PL_parser dummy is provided for earlier
	174	* perl versions.
	175	* If PL_parser is NULL when you try to access this variable, a
	176	* dummy is being accessed instead and a warning is issued unless
	177	* you define DPPP_PL_parser_NO_DUMMY_WARNING.
	178	* If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
	179	* this variable will croak with a panic message.
	180	*/
	181
	182	# define PL_expect D_PPP_my_PL_parser_var(expect)
	183	# define PL_copline D_PPP_my_PL_parser_var(copline)
	184	# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
	185	# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
	186	# define PL_linestr D_PPP_my_PL_parser_var(linestr)
	187	# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
	188	# define PL_bufend D_PPP_my_PL_parser_var(bufend)
	189	# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
	190	# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
	191	# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
8565c31a MHM	192	# define PL_in_my D_PPP_my_PL_parser_var(in_my)
	193	# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
	194	# define PL_error_count D_PPP_my_PL_parser_var(error_count)
	195
c01be2ce MHM	196
	197	#else
	198
	199	/* ensure that PL_parser != NULL and cannot be dereferenced */
	200	# define PL_parser ((void *) 1)
	201
53a7735b DM	202	#endif
53a7735b DM	203
0d0f8426 MHM	204	=xsinit
	205
	206	#define NEED_PL_signals
c01be2ce MHM	207	#define NEED_PL_parser
c01be2ce MHM	208	#define DPPP_PL_parser_NO_DUMMY_WARNING
0d0f8426 MHM	209
	210	=xsmisc
	211
	212	U32 get_PL_signals_1(void)
	213	{
b2049988 MHM	214	#ifdef PERL_NO_GET_CONTEXT
	215	dTHX;
	216	#endif
0d0f8426 MHM	217	return PL_signals;
	218	}
	219
	220	extern U32 get_PL_signals_2(void);
	221	extern U32 get_PL_signals_3(void);
c01be2ce MHM	222	int no_dummy_parser_vars(int);
	223	int dummy_parser_warning(void);
	224
94e22bd6 MH	225	/* No PTRSIZE IN 5.004 and below, so PTR2IV would warn and possibly misbehave */
	226	#if { VERSION > 5.004 }
	227	#define ppp_TESTVAR(var) STMT_START { mXPUSHi(PTR2IV(&var)); count++; } STMT_END
	228	#else
	229	#define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var); count++; } STMT_END
	230	#endif
c01be2ce MHM	231
	232	#define ppp_PARSERVAR(type, var) STMT_START { \
	233	type volatile my_ ## var; \
	234	type volatile *my_p_ ## var; \
	235	my_ ## var = var; \
	236	my_p_ ## var = &var; \
	237	var = my_ ## var; \
	238	var = *my_p_ ## var; \
	239	mXPUSHi(&var != NULL); \
	240	count++; \
	241	} STMT_END
	242
8565c31a MHM	243	#define ppp_PARSERVAR_dummy STMT_START { \
	244	mXPUSHi(1); \
	245	count++; \
	246	} STMT_END
	247
fd7af155 MHM	248	#if { VERSION < 5.004 }
	249	# define ppp_rsfp_t FILE *
	250	#else
	251	# define ppp_rsfp_t PerlIO *
	252	#endif
	253
	254	#if { VERSION < 5.6.0 }
c01be2ce	255	# define ppp_expect_t expectation
fd7af155	256	#elif { VERSION < 5.9.5 }
c01be2ce MHM	257	# define ppp_expect_t int
	258	#else
	259	# define ppp_expect_t U8
	260	#endif
0d0f8426	261
fd7af155	262	#if { VERSION < 5.9.5 }
c01be2ce MHM	263	# define ppp_lex_state_t U32
	264	#else
	265	# define ppp_lex_state_t U8
	266	#endif
cac25305	267
8565c31a MHM	268	#if { VERSION < 5.6.0 }
	269	# define ppp_in_my_t bool
	270	#elif { VERSION < 5.9.5 }
	271	# define ppp_in_my_t I32
	272	#else
	273	# define ppp_in_my_t U16
	274	#endif
	275
	276	#if { VERSION < 5.9.5 }
	277	# define ppp_error_count_t I32
	278	#else
	279	# define ppp_error_count_t U8
	280	#endif
	281
0d0f8426 MHM	282	=xsubs
	283
	284	int
	285	compare_PL_signals()
b2049988 MHM	286	CODE:
	287	{
	288	U32 ref = get_PL_signals_1();
	289	RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3();
	290	}
	291	OUTPUT:
	292	RETVAL
0d0f8426	293
cac25305 MHM	294	SV *
cac25305 MHM	295	PL_sv_undef()
b2049988 MHM	296	CODE:
	297	RETVAL = newSVsv(&PL_sv_undef);
	298	OUTPUT:
	299	RETVAL
cac25305 MHM	300
	301	SV *
	302	PL_sv_yes()
b2049988 MHM	303	CODE:
	304	RETVAL = newSVsv(&PL_sv_yes);
	305	OUTPUT:
	306	RETVAL
cac25305 MHM	307
	308	SV *
	309	PL_sv_no()
b2049988 MHM	310	CODE:
	311	RETVAL = newSVsv(&PL_sv_no);
	312	OUTPUT:
	313	RETVAL
cac25305 MHM	314
	315	int
	316	PL_na(string)
b2049988 MHM	317	char *string
	318	CODE:
	319	PL_na = strlen(string);
	320	RETVAL = PL_na;
	321	OUTPUT:
	322	RETVAL
cac25305 MHM	323
	324	SV *
	325	PL_Sv()
b2049988 MHM	326	CODE:
	327	PL_Sv = newSVpv("mhx", 0);
	328	RETVAL = PL_Sv;
	329	OUTPUT:
	330	RETVAL
cac25305 MHM	331
cac25305 MHM	332	SV *
c01be2ce	333	PL_tokenbuf()
b2049988 MHM	334	CODE:
	335	RETVAL = newSViv(PL_tokenbuf[0]);
	336	OUTPUT:
	337	RETVAL
679ad62d MHM	338
679ad62d MHM	339	SV *
c01be2ce	340	PL_parser()
b2049988 MHM	341	CODE:
	342	RETVAL = newSViv(PL_parser != NULL);
	343	OUTPUT:
	344	RETVAL
679ad62d MHM	345
679ad62d MHM	346	SV *
cac25305	347	PL_hexdigit()
b2049988 MHM	348	CODE:
	349	RETVAL = newSVpv((char *) PL_hexdigit, 0);
	350	OUTPUT:
	351	RETVAL
cac25305 MHM	352
	353	SV *
	354	PL_hints()
b2049988 MHM	355	CODE:
	356	RETVAL = newSViv((IV) PL_hints);
	357	OUTPUT:
	358	RETVAL
cac25305 MHM	359
	360	void
	361	PL_ppaddr(string)
b2049988 MHM	362	char *string
	363	PPCODE:
	364	PUSHMARK(SP);
	365	mXPUSHs(newSVpv(string, 0));
	366	PUTBACK;
	367	ENTER;
	368	(void)*(PL_ppaddr[OP_UC])(aTHXR);
	369	SPAGAIN;
	370	LEAVE;
	371	XSRETURN(1);
cac25305 MHM	372
	373	void
	374	other_variables()
b2049988 MHM	375	PREINIT:
	376	int count = 0;
	377	PPCODE:
	378	ppp_TESTVAR(PL_DBsignal);
	379	ppp_TESTVAR(PL_DBsingle);
	380	ppp_TESTVAR(PL_DBsub);
	381	ppp_TESTVAR(PL_DBtrace);
	382	ppp_TESTVAR(PL_compiling);
	383	ppp_TESTVAR(PL_curcop);
	384	ppp_TESTVAR(PL_curstash);
	385	ppp_TESTVAR(PL_debstash);
	386	ppp_TESTVAR(PL_defgv);
	387	ppp_TESTVAR(PL_diehook);
49ef49fe CBW	388	#if { VERSION >= 5.13.7 }
	389	/* can't get a pointer any longer */
	390	mXPUSHi(PL_dirty ? 1 : 1);
	391	count++;
627364f1	392	#else
b2049988	393	ppp_TESTVAR(PL_dirty);
627364f1	394	#endif
b2049988 MHM	395	ppp_TESTVAR(PL_dowarn);
	396	ppp_TESTVAR(PL_errgv);
	397	ppp_TESTVAR(PL_laststatval);
	398	ppp_TESTVAR(PL_no_modify);
	399	ppp_TESTVAR(PL_perl_destruct_level);
	400	ppp_TESTVAR(PL_perldb);
	401	ppp_TESTVAR(PL_stack_base);
	402	ppp_TESTVAR(PL_stack_sp);
	403	ppp_TESTVAR(PL_statcache);
	404	ppp_TESTVAR(PL_stdingv);
	405	ppp_TESTVAR(PL_sv_arenaroot);
	406	ppp_TESTVAR(PL_tainted);
	407	ppp_TESTVAR(PL_tainting);
	408
	409	ppp_PARSERVAR(ppp_expect_t, PL_expect);
	410	ppp_PARSERVAR(line_t, PL_copline);
	411	ppp_PARSERVAR(ppp_rsfp_t, PL_rsfp);
	412	ppp_PARSERVAR(AV *, PL_rsfp_filters);
	413	ppp_PARSERVAR(SV *, PL_linestr);
	414	ppp_PARSERVAR(char *, PL_bufptr);
	415	ppp_PARSERVAR(char *, PL_bufend);
	416	ppp_PARSERVAR(ppp_lex_state_t, PL_lex_state);
	417	ppp_PARSERVAR(SV *, PL_lex_stuff);
	418	ppp_PARSERVAR(ppp_error_count_t, PL_error_count);
	419	ppp_PARSERVAR(ppp_in_my_t, PL_in_my);
8565c31a	420	#if { VERSION >= 5.5.0 }
b2049988	421	ppp_PARSERVAR(HV*, PL_in_my_stash);
8565c31a	422	#else
b2049988	423	ppp_PARSERVAR_dummy;
8565c31a	424	#endif
b2049988	425	XSRETURN(count);
cac25305	426
c01be2ce MHM	427	int
c01be2ce MHM	428	no_dummy_parser_vars(check)
b2049988	429	int check
c01be2ce MHM	430
	431	int
	432	dummy_parser_warning()
	433
8565c31a	434	=tests plan => 52
0d0f8426 MHM	435
	436	ok(Devel::PPPort::compare_PL_signals());
	437
cac25305 MHM	438	ok(!defined(&Devel::PPPort::PL_sv_undef()));
	439	ok(&Devel::PPPort::PL_sv_yes());
	440	ok(!&Devel::PPPort::PL_sv_no());
	441	ok(&Devel::PPPort::PL_na("abcd"), 4);
	442	ok(&Devel::PPPort::PL_Sv(), "mhx");
c01be2ce	443	ok(defined &Devel::PPPort::PL_tokenbuf());
f551177d	444	ok("$]" >= 5.009005 \|\| &Devel::PPPort::PL_parser());
cac25305 MHM	445	ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
	446	ok(defined &Devel::PPPort::PL_hints());
	447	ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
	448
	449	for (&Devel::PPPort::other_variables()) {
	450	ok($_ != 0);
	451	}
c01be2ce MHM	452
	453	{
	454	my @w;
	455	my $fail = 0;
	456	{
	457	local $SIG{'__WARN__'} = sub { push @w, @_ };
	458	ok(&Devel::PPPort::dummy_parser_warning());
	459	}
f551177d	460	if ("$]" >= 5.009005) {
c01be2ce MHM	461	ok(@w >= 0);
	462	for (@w) {
	463	print "# $_";
	464	unless (/^warning: dummy PL_bufptr used in.module3.:\d+/i) {
	465	warn $_;
	466	$fail++;
	467	}
	468	}
	469	}
	470	else {
	471	ok(@w == 0);
	472	}
	473	ok($fail, 0);
	474	}
	475
f551177d	476	ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ("$]" < 5.009005 ? 1 : 0));
c01be2ce MHM	477
	478	eval { &Devel::PPPort::no_dummy_parser_vars(0) };
	479
f551177d	480	if ("$]" < 5.009005) {
c01be2ce MHM	481	ok($@, '');
	482	}
	483	else {
	484	if ($@) {
	485	print "# $@";
	486	ok($@ =~ /^panic: PL_parser == NULL in.module2.:\d+/i);
	487	}
	488	else {
	489	ok(1);
	490	}
	491	}