X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Declare.xs;h=635d946937e79a6f9299b2a3eaa03d30b85a6514;hb=92997e69bf120e4888fc4dba09300e68606e6740;hp=3ad99ad2da6eb57485878ed952546a1231d1ab48;hpb=78678dfd92dd5cf8f08ba2479efcd8e2f673d622;p=p5sagit%2FDevel-Declare.git diff --git a/Declare.xs b/Declare.xs index 3ad99ad..635d946 100644 --- a/Declare.xs +++ b/Declare.xs @@ -1,6 +1,7 @@ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#include "hook_op_check.h" #undef printf #include "stolen_chunk_of_toke.c" #include @@ -25,7 +26,7 @@ static int in_declare = 0; #define DD_AM_LEXING_CHECK (PL_lex_state == LEX_NORMAL || PL_lex_state == LEX_INTERPNORMAL) -#ifdef PL_parser +#if defined(PL_parser) || defined(PERL_5_9_PLUS) #define DD_HAVE_PARSER PL_parser #define DD_HAVE_LEX_STUFF (PL_parser && PL_lex_stuff) #define DD_AM_LEXING (PL_parser && DD_AM_LEXING_CHECK) @@ -51,6 +52,9 @@ int dd_is_declarator(pTHX_ char* name) { /* $declarators{$current_package_name} */ + if (!HvNAME(PL_curstash)) + return -1; + is_declarator_pack_ref = hv_fetch(is_declarator, HvNAME(PL_curstash), strlen(HvNAME(PL_curstash)), FALSE); @@ -103,6 +107,9 @@ void dd_linestr_callback (pTHX_ char* type, char* name) { } char* dd_get_linestr(pTHX) { + if (!DD_HAVE_PARSER) { + return NULL; + } return SvPVX(PL_linestr); } @@ -126,7 +133,7 @@ char* dd_get_lex_stuff(pTHX) { return (DD_HAVE_LEX_STUFF ? SvPVX(PL_lex_stuff) : ""); } -char* dd_clear_lex_stuff(pTHX) { +void dd_clear_lex_stuff(pTHX) { if (DD_HAVE_PARSER) PL_lex_stuff = (SV*)NULL; } @@ -136,7 +143,11 @@ char* dd_get_curstash_name(pTHX) { } int dd_get_linestr_offset(pTHX) { - char* linestr = SvPVX(PL_linestr); + char* linestr; + if (!DD_HAVE_PARSER) { + return -1; + } + linestr = SvPVX(PL_linestr); return PL_bufptr - linestr; } @@ -182,17 +193,12 @@ int dd_toke_skipspace(pTHX_ int offset) { /* replacement PL_check rv2cv entry */ -STATIC OP *(*dd_old_ck_rv2cv)(pTHX_ OP *op); - -STATIC OP *dd_ck_rv2cv(pTHX_ OP *o) { +STATIC OP *dd_ck_rv2cv(pTHX_ OP *o, void *user_data) { + dSP; OP* kid; int dd_flags; - char* cb_args[6]; - - o = dd_old_ck_rv2cv(aTHX_ o); /* let the original do its job */ if (in_declare) { - cb_args[0] = NULL; if (dd_debug) { printf("Deconstructing declare\n"); printf("PL_bufptr: %s\n", PL_bufptr); @@ -200,7 +206,17 @@ STATIC OP *dd_ck_rv2cv(pTHX_ OP *o) { printf("linestr: %s\n", SvPVX(PL_linestr)); printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr)); } - call_argv("Devel::Declare::done_declare", G_VOID|G_DISCARD, cb_args); + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + + call_pv("Devel::Declare::done_declare", G_VOID|G_DISCARD); + + FREETMPS; + LEAVE; + if (dd_debug) { printf("PL_bufptr: %s\n", PL_bufptr); printf("bufend at: %i\n", PL_bufend - PL_bufptr); @@ -238,13 +254,18 @@ STATIC OP *dd_ck_rv2cv(pTHX_ OP *o) { return o; } -STATIC OP *(*dd_old_ck_entereval)(pTHX_ OP *op); - OP* dd_pp_entereval(pTHX) { dSP; - dPOPss; STRLEN len; const char* s; + SV *sv; +#ifdef PERL_5_9_PLUS + SV *saved_hh; + if (PL_op->op_private & OPpEVAL_HAS_HH) { + saved_hh = POPs; + } +#endif + sv = POPs; if (SvPOK(sv)) { if (dd_debug) { printf("mangling eval sv\n"); @@ -261,11 +282,15 @@ OP* dd_pp_entereval(pTHX) { SvGROW(sv, 8192); } PUSHs(sv); +#ifdef PERL_5_9_PLUS + if (PL_op->op_private & OPpEVAL_HAS_HH) { + PUSHs(saved_hh); + } +#endif return PL_ppaddr[OP_ENTEREVAL](aTHX); } -STATIC OP *dd_ck_entereval(pTHX_ OP *o) { - o = dd_old_ck_entereval(aTHX_ o); /* let the original do its job */ +STATIC OP *dd_ck_entereval(pTHX_ OP *o, void *user_data) { if (o->op_ppaddr == PL_ppaddr[OP_ENTEREVAL]) o->op_ppaddr = dd_pp_entereval; return o; @@ -279,14 +304,10 @@ static I32 dd_filter_realloc(pTHX_ int idx, SV *sv, int maxlen) return count; } -STATIC OP *(*dd_old_ck_const)(pTHX_ OP*op); - -STATIC OP *dd_ck_const(pTHX_ OP *o) { +STATIC OP *dd_ck_const(pTHX_ OP *o, void *user_data) { int dd_flags; char* name; - o = dd_old_ck_const(aTHX_ o); /* let the original do its job */ - /* if this is set, we just grabbed a delimited string or something, not a bareword, so NO TOUCHY */ @@ -319,12 +340,9 @@ void setup() CODE: if (!initialized++) { - dd_old_ck_rv2cv = PL_check[OP_RV2CV]; - PL_check[OP_RV2CV] = dd_ck_rv2cv; - dd_old_ck_entereval = PL_check[OP_ENTEREVAL]; - PL_check[OP_ENTEREVAL] = dd_ck_entereval; - dd_old_ck_const = PL_check[OP_CONST]; - PL_check[OP_CONST] = dd_ck_const; + hook_op_check(OP_RV2CV, dd_ck_rv2cv, NULL); + hook_op_check(OP_ENTEREVAL, dd_ck_entereval, NULL); + hook_op_check(OP_CONST, dd_ck_const, NULL); } filter_add(dd_filter_realloc, NULL);