view release on metacpan or  search on metacpan

lib/Parse/Perl.xs  view on Meta::CPAN

#include "perl.h"
#include "callchecker0.h"
#include "XSUB.h"

#define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
#define PERL_DECIMAL_VERSION \
	PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
#define PERL_VERSION_GE(r,v,s) \
	(PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))

#define QHAVE_UNITCHECK PERL_VERSION_GE(5,9,5)

#define QHAVE_WARNINGS_AS_SV (!PERL_VERSION_GE(5,9,4))
#if QHAVE_WARNINGS_AS_SV
# define WARNINGS_t SV
#else /* !QHAVE_WARNINGS_AS_SV */
# define WARNINGS_t STRLEN
#endif /* !QHAVE_WARNINGS_AS_SV */

#define QLEX_START_LINE_IS_SAFE PERL_VERSION_GE(5,13,7)
#define QHAVE_PARSE_STMTSEQ PERL_VERSION_GE(5,13,6)

lib/Parse/Perl.xs  view on Meta::CPAN

	CvOUTSIDE(PL_compcv) =
		function_from_sv(safe_av_fetch(enva, ENV_OUTSIDECV));
	CvOUTSIDE_SEQ(PL_compcv) =
		uv_from_sv(safe_av_fetch(enva, ENV_OUTSIDESEQ));
	CvPADLIST(PL_compcv) = pad_new(padnew_SAVE);
	/* initialise other parser state */
	SAVEOP();
	PL_op = NULL;
	SAVEGENERICSV(PL_beginav);
	PL_beginav = newAV();
#if QHAVE_UNITCHECK
	SAVEGENERICSV(PL_unitcheckav);
	PL_unitcheckav = newAV();
#endif /* QHAVE_UNITCHECK */
	/* parse */
#if !QLEX_START_LINE_IS_SAFE
	source = sv_mortalcopy(source);
#endif /* !QLEX_START_LINE_IS_SAFE */
	lex_start_simple(source);
	parse_file_as_sub_body(
		array_from_sv(safe_av_fetch(enva, ENV_OUTSIDEPAD)));
	lex_end();
	if(PL_error_count) {
		if(!(SvPOK(ERRSV) && SvCUR(ERRSV) != 0))
			sv_setpvs(ERRSV, "Compilation error");
		Perl_die(aTHX_ NULL);
	}
	/* finalise */
#if QHAVE_UNITCHECK
	if(PL_unitcheckav) call_list(PL_scopestack_ix, PL_unitcheckav);
#endif /* QHAVE_UNITCHECK */
	RETVAL = (CV*)SvREFCNT_inc((SV*)PL_compcv);
	FREETMPS;
	LEAVE;
OUTPUT:
	RETVAL

MODULE = Parse::Perl PACKAGE = Parse::Perl::CopHintsHash

void
DESTROY(SV *sv)

t/magicblock.t  view on Meta::CPAN

my $have_unitcheck = "$]" >= 5.009005;

@main::activity = ();
my $func = parse_perl(current_environment, q{
	BEGIN { push @main::activity, "begin 0"; }
	CHECK { push @main::activity, "check 0"; }
	END { push @main::activity, "end 0"; }
	INIT { push @main::activity, "init 0"; }
	}.($have_unitcheck ?
		q{UNITCHECK { push @main::activity, "unitcheck 0"; }}
	: "").q{
	push @main::activity, "running";
	}.($have_unitcheck ?
		q{UNITCHECK { push @main::activity, "unitcheck 1"; }}
	: "").q{
	INIT { push @main::activity, "init 1"; }
	END { push @main::activity, "end 1"; }
	CHECK { push @main::activity, "check 1"; }
	BEGIN { push @main::activity, "begin 1"; }
	123;
});
is_deeply \@main::activity, [
	"begin 0",
	"WARNING: Too late to run CHECK block",