[p5sagit/p5-mst-13.2.git] / cpan / Devel-PPPort / parts / inc / variables

################################################################################
##
##  $Revision: 21 $
##  $Author: mhx $
##  $Date: 2010/03/07 13:15:46 +0100 $
##
################################################################################
##
##  Version 3.x, Copyright (C) 2004-2010, 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
 * doint. 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)
{
  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);

#define ppp_TESTVAR(var)          STMT_START { mXPUSHi(&var != NULL); count++; } STMT_END

#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);
		ppp_TESTVAR(PL_dirty);
		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	1	################################################################################
0d0f8426	2	##
bfc37ff7	3	## $Revision: 21 $
0d0f8426	4	## $Author: mhx $
bfc37ff7	5	## $Date: 2010/03/07 13:15:46 +0100 $
0d0f8426	6	##
	7	################################################################################
	8	##
bfc37ff7	9	## Version 3.x, Copyright (C) 2004-2010, Marcus Holland-Moritz.
0d0f8426	10	## Version 2.x, Copyright (C) 2001, Paul Marquess.
	11	## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
	12	##
	13	## This program is free software; you can redistribute it and/or
	14	## modify it under the same terms as Perl itself.
	15	##
	16	################################################################################
	17
	18	=provides
	19
679ad62d	20	PL_ppaddr
	21	PL_no_modify
	22	PL_DBsignal
	23	PL_DBsingle
	24	PL_DBsub
	25	PL_DBtrace
	26	PL_Sv
c01be2ce	27	PL_bufend
c01be2ce	28	PL_bufptr
679ad62d	29	PL_compiling
	30	PL_copline
	31	PL_curcop
	32	PL_curstash
	33	PL_debstash
	34	PL_defgv
	35	PL_diehook
	36	PL_dirty
	37	PL_dowarn
	38	PL_errgv
8565c31a	39	PL_error_count
679ad62d	40	PL_expect
	41	PL_hexdigit
	42	PL_hints
8565c31a	43	PL_in_my
8565c31a	44	PL_in_my_stash
679ad62d	45	PL_laststatval
c01be2ce	46	PL_lex_state
	47	PL_lex_stuff
	48	PL_linestr
679ad62d	49	PL_na
c01be2ce	50	PL_parser
679ad62d	51	PL_perl_destruct_level
	52	PL_perldb
	53	PL_rsfp_filters
	54	PL_rsfp
	55	PL_stack_base
	56	PL_stack_sp
	57	PL_statcache
	58	PL_stdingv
	59	PL_sv_arenaroot
	60	PL_sv_no
	61	PL_sv_undef
	62	PL_sv_yes
	63	PL_tainted
	64	PL_tainting
c01be2ce	65	PL_tokenbuf
679ad62d	66	PL_signals
0d0f8426	67	PERL_SIGNALS_UNSAFE_FLAG
	68
	69	=implementation
	70
	71	#ifndef PERL_SIGNALS_UNSAFE_FLAG
	72
	73	#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
	74
cac25305	75	#if { VERSION < 5.8.0 }
	76	# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
	77	#else
	78	# define D_PPP_PERL_SIGNALS_INIT 0
	79	#endif
	80
	81	__NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT;
	82
	83	#endif
0d0f8426	84
cac25305	85	/* Hint: PL_ppaddr
	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.
	90	*/
	91
c58e738a	92	#if { VERSION <= 5.005_05 }
cac25305	93	/* Replace: 1 */
	94	# define PL_ppaddr ppaddr
	95	# define PL_no_modify no_modify
	96	/* Replace: 0 */
	97	#endif
	98
	99	#if { VERSION <= 5.004_05 }
	100	/* Replace: 1 */
	101	# define PL_DBsignal DBsignal
	102	# define PL_DBsingle DBsingle
	103	# define PL_DBsub DBsub
	104	# define PL_DBtrace DBtrace
	105	# define PL_Sv Sv
c01be2ce	106	# define PL_bufend bufend
c01be2ce	107	# define PL_bufptr bufptr
cac25305	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
8565c31a	118	# define PL_error_count error_count
a89b7ab8	119	# define PL_expect expect
cac25305	120	# define PL_hexdigit hexdigit
cac25305	121	# define PL_hints hints
8565c31a	122	# define PL_in_my in_my
cac25305	123	# define PL_laststatval laststatval
c01be2ce	124	# define PL_lex_state lex_state
	125	# define PL_lex_stuff lex_stuff
	126	# define PL_linestr linestr
cac25305	127	# define PL_na na
	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
c01be2ce	142	# define PL_tokenbuf tokenbuf
cac25305	143	/* Replace: 0 */
0d0f8426	144	#endif
0d0f8426	145
c01be2ce	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
	150	* what you're doing.
	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.
679ad62d	154	*/
679ad62d	155
53a7735b	156	#if { VERSION >= 5.9.5 }
c01be2ce	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)
	161	# else
	162	# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
	163	# define D_PPP_parser_dummy_warning(var)
	164	# else
	165	# define D_PPP_parser_dummy_warning(var) \
	166	warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
	167	# endif
	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;
	171	# endif
	172
	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
	180	* perl versions.
	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.
	186	*/
	187
	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)
8565c31a	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)
	201
c01be2ce	202
	203	#else
	204
	205	/* ensure that PL_parser != NULL and cannot be dereferenced */
	206	# define PL_parser ((void *) 1)
	207
53a7735b	208	#endif
53a7735b	209
0d0f8426	210	=xsinit
	211
	212	#define NEED_PL_signals
c01be2ce	213	#define NEED_PL_parser
c01be2ce	214	#define DPPP_PL_parser_NO_DUMMY_WARNING
0d0f8426	215
	216	=xsmisc
	217
	218	U32 get_PL_signals_1(void)
	219	{
	220	return PL_signals;
	221	}
	222
	223	extern U32 get_PL_signals_2(void);
	224	extern U32 get_PL_signals_3(void);
c01be2ce	225	int no_dummy_parser_vars(int);
	226	int dummy_parser_warning(void);
	227
	228	#define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var != NULL); count++; } STMT_END
	229
	230	#define ppp_PARSERVAR(type, var) STMT_START { \
	231	type volatile my_ ## var; \
	232	type volatile *my_p_ ## var; \
	233	my_ ## var = var; \
	234	my_p_ ## var = &var; \
	235	var = my_ ## var; \
	236	var = *my_p_ ## var; \
	237	mXPUSHi(&var != NULL); \
	238	count++; \
	239	} STMT_END
	240
8565c31a	241	#define ppp_PARSERVAR_dummy STMT_START { \
	242	mXPUSHi(1); \
	243	count++; \
	244	} STMT_END
	245
fd7af155	246	#if { VERSION < 5.004 }
	247	# define ppp_rsfp_t FILE *
	248	#else
	249	# define ppp_rsfp_t PerlIO *
	250	#endif
	251
	252	#if { VERSION < 5.6.0 }
c01be2ce	253	# define ppp_expect_t expectation
fd7af155	254	#elif { VERSION < 5.9.5 }
c01be2ce	255	# define ppp_expect_t int
	256	#else
	257	# define ppp_expect_t U8
	258	#endif
0d0f8426	259
fd7af155	260	#if { VERSION < 5.9.5 }
c01be2ce	261	# define ppp_lex_state_t U32
	262	#else
	263	# define ppp_lex_state_t U8
	264	#endif
cac25305	265
8565c31a	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
	270	#else
	271	# define ppp_in_my_t U16
	272	#endif
	273
	274	#if { VERSION < 5.9.5 }
	275	# define ppp_error_count_t I32
	276	#else
	277	# define ppp_error_count_t U8
	278	#endif
	279
0d0f8426	280	=xsubs
	281
	282	int
	283	compare_PL_signals()
	284	CODE:
	285	{
	286	U32 ref = get_PL_signals_1();
	287	RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3();
	288	}
	289	OUTPUT:
	290	RETVAL
	291
cac25305	292	SV *
	293	PL_sv_undef()
	294	CODE:
	295	RETVAL = newSVsv(&PL_sv_undef);
	296	OUTPUT:
	297	RETVAL
	298
	299	SV *
	300	PL_sv_yes()
	301	CODE:
	302	RETVAL = newSVsv(&PL_sv_yes);
	303	OUTPUT:
	304	RETVAL
	305
	306	SV *
	307	PL_sv_no()
	308	CODE:
	309	RETVAL = newSVsv(&PL_sv_no);
	310	OUTPUT:
	311	RETVAL
	312
	313	int
	314	PL_na(string)
	315	char *string
	316	CODE:
	317	PL_na = strlen(string);
	318	RETVAL = PL_na;
	319	OUTPUT:
	320	RETVAL
	321
	322	SV *
	323	PL_Sv()
	324	CODE:
	325	PL_Sv = newSVpv("mhx", 0);
	326	RETVAL = PL_Sv;
	327	OUTPUT:
	328	RETVAL
	329
	330	SV *
c01be2ce	331	PL_tokenbuf()
679ad62d	332	CODE:
c01be2ce	333	RETVAL = newSViv(PL_tokenbuf[0]);
679ad62d	334	OUTPUT:
	335	RETVAL
	336
	337	SV *
c01be2ce	338	PL_parser()
679ad62d	339	CODE:
c01be2ce	340	RETVAL = newSViv(PL_parser != NULL);
679ad62d	341	OUTPUT:
	342	RETVAL
	343
	344	SV *
cac25305	345	PL_hexdigit()
cac25305	346	CODE:
aab9a3b6	347	RETVAL = newSVpv((char *) PL_hexdigit, 0);
cac25305	348	OUTPUT:
	349	RETVAL
	350
	351	SV *
	352	PL_hints()
	353	CODE:
	354	RETVAL = newSViv((IV) PL_hints);
	355	OUTPUT:
	356	RETVAL
	357
	358	void
	359	PL_ppaddr(string)
	360	char *string
	361	PPCODE:
	362	PUSHMARK(SP);
c1a049cb	363	mXPUSHs(newSVpv(string, 0));
cac25305	364	PUTBACK;
	365	ENTER;
	366	(void)*(PL_ppaddr[OP_UC])(aTHXR);
	367	SPAGAIN;
	368	LEAVE;
	369	XSRETURN(1);
	370
	371	void
	372	other_variables()
	373	PREINIT:
	374	int count = 0;
	375	PPCODE:
	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);
cac25305	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);
c01be2ce	400
	401	ppp_PARSERVAR(ppp_expect_t, PL_expect);
	402	ppp_PARSERVAR(line_t, PL_copline);
fd7af155	403	ppp_PARSERVAR(ppp_rsfp_t, PL_rsfp);
c01be2ce	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);
8565c31a	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);
	414	#else
	415	ppp_PARSERVAR_dummy;
	416	#endif
cac25305	417	XSRETURN(count);
cac25305	418
c01be2ce	419	int
	420	no_dummy_parser_vars(check)
	421	int check
	422
	423	int
	424	dummy_parser_warning()
	425
8565c31a	426	=tests plan => 52
0d0f8426	427
	428	ok(Devel::PPPort::compare_PL_signals());
	429
cac25305	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");
c01be2ce	435	ok(defined &Devel::PPPort::PL_tokenbuf());
c01be2ce	436	ok($] >= 5.009005 \|\| &Devel::PPPort::PL_parser());
cac25305	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");
	440
	441	for (&Devel::PPPort::other_variables()) {
	442	ok($_ != 0);
	443	}
c01be2ce	444
	445	{
	446	my @w;
	447	my $fail = 0;
	448	{
	449	local $SIG{'__WARN__'} = sub { push @w, @_ };
	450	ok(&Devel::PPPort::dummy_parser_warning());
	451	}
	452	if ($] >= 5.009005) {
	453	ok(@w >= 0);
	454	for (@w) {
	455	print "# $_";
	456	unless (/^warning: dummy PL_bufptr used in.module3.:\d+/i) {
	457	warn $_;
	458	$fail++;
	459	}
	460	}
	461	}
	462	else {
	463	ok(@w == 0);
	464	}
	465	ok($fail, 0);
	466	}
	467
	468	ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ($] < 5.009005 ? 1 : 0));
	469
	470	eval { &Devel::PPPort::no_dummy_parser_vars(0) };
	471
	472	if ($] < 5.009005) {
	473	ok($@, '');
	474	}
	475	else {
	476	if ($@) {
	477	print "# $@";
	478	ok($@ =~ /^panic: PL_parser == NULL in.module2.:\d+/i);
	479	}
	480	else {
	481	ok(1);
	482	}
	483	}