################################################################################
##
##  $Revision: 8 $
##  $Author: mhx $
##  $Date: 2007/03/23 16:24:34 +0100 $
##
################################################################################
##
##  Version 3.x, Copyright (C) 2004-2007, 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_\w+/
PERL_SIGNALS_UNSAFE_FLAG

=dontwarn

D_PPP_PERL_SIGNALS_INIT

=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_04 }
/* 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_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_expect                 expect
#  define PL_hexdigit               hexdigit
#  define PL_hints                  hints
#  define PL_laststatval            laststatval
#  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
/* Replace: 0 */
#endif

#if { VERSION >= 5.9.5 }
#  define PL_PARSER_EXISTS
#  define PL_expect   (PL_parser ? PL_parser->expect : 0)
#  define PL_copline  (PL_parser ? PL_parser->copline : 0)
#  define PL_rsfp     (PL_parser ? PL_parser->rsfp : 0)
#  define PL_rsfp_filters (PL_parser ? PL_parser->rsfp_filters : 0)
#endif

=xsinit

#define NEED_PL_signals

=xsmisc

U32 get_PL_signals_1(void)
{
  return PL_signals;
}

extern U32 get_PL_signals_2(void);
extern U32 get_PL_signals_3(void);

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

=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_copline()
	CODE:
		RETVAL = newSViv((IV) PL_copline);
	OUTPUT:
		RETVAL

SV *
PL_hexdigit()
	CODE:
		RETVAL = newSVpv(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);
		XPUSHs(sv_2mortal(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);
#ifdef PL_PARSER_EXISTS
		ppp_TESTVAR(PL_parser); /* just any var that isn't PL_expect */
#else
		ppp_TESTVAR(PL_expect);
#endif
		ppp_TESTVAR(PL_laststatval);
		ppp_TESTVAR(PL_no_modify);
		ppp_TESTVAR(PL_perl_destruct_level);
		ppp_TESTVAR(PL_perldb);
#ifdef PL_PARSER_EXISTS
		ppp_TESTVAR(PL_parser); /* just any var that isn't PL_expect */
		ppp_TESTVAR(PL_parser);
#else
		ppp_TESTVAR(PL_rsfp);
		ppp_TESTVAR(PL_rsfp_filters);
#endif
		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);
		XSRETURN(count);

=tests plan => 37

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_copline());
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);
}