################################################################################
##
## $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);
}