X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Declare.xs;h=2e5c58d858c59cf2754cba84d9654ff18c6212ef;hb=1795217cf8c82770d98159af3d315d0f56e15d34;hp=af640e99614311502185f0e2bb6700a9b89ecf38;hpb=18aa1122598b682f0af6bcd24f182861b9531b57;p=p5sagit%2FDevel-Declare.git diff --git a/Declare.xs b/Declare.xs index af640e9..2e5c58d 100644 --- a/Declare.xs +++ b/Declare.xs @@ -114,7 +114,7 @@ char* dd_get_linestr(pTHX) { } void dd_set_linestr(pTHX_ char* new_value) { - int new_len = strlen(new_value); + unsigned int new_len = strlen(new_value); if (SvLEN(PL_linestr) < new_len) { croak("forced to realloc PL_linestr for line %s, bailing out before we crash harder", SvPVX(PL_linestr)); @@ -179,6 +179,13 @@ int dd_toke_scan_word(pTHX_ int offset, int handle_package) { return s - base_s; } +int dd_toke_scan_ident(pTHX_ int offset) { + char tmpbuf[sizeof PL_tokenbuf]; + char* base_s = SvPVX(PL_linestr) + offset; + char* s = scan_ident(base_s, PL_bufend, tmpbuf, sizeof tmpbuf, 0); + return s - base_s; +} + int dd_toke_scan_str(pTHX_ int offset) { char* base_s = SvPVX(PL_linestr) + offset; char* s = scan_str(base_s, FALSE, FALSE); @@ -194,9 +201,12 @@ int dd_toke_skipspace(pTHX_ int offset) { /* replacement PL_check rv2cv entry */ STATIC OP *dd_ck_rv2cv(pTHX_ OP *o, void *user_data) { + dSP; OP* kid; int dd_flags; + PERL_UNUSED_VAR(user_data); + if (in_declare) { if (dd_debug) { printf("Deconstructing declare\n"); @@ -206,13 +216,11 @@ STATIC OP *dd_ck_rv2cv(pTHX_ OP *o, void *user_data) { printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr)); } - dSP; - ENTER; SAVETMPS; - + PUSHMARK(SP); - + call_pv("Devel::Declare::done_declare", G_VOID|G_DISCARD); FREETMPS; @@ -257,9 +265,16 @@ STATIC OP *dd_ck_rv2cv(pTHX_ OP *o, void *user_data) { 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"); @@ -276,10 +291,17 @@ 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, void *user_data) { + PERL_UNUSED_VAR(user_data); + if (o->op_ppaddr == PL_ppaddr[OP_ENTEREVAL]) o->op_ppaddr = dd_pp_entereval; return o; @@ -297,6 +319,8 @@ STATIC OP *dd_ck_const(pTHX_ OP *o, void *user_data) { int dd_flags; char* name; + PERL_UNUSED_VAR(user_data); + /* if this is set, we just grabbed a delimited string or something, not a bareword, so NO TOUCHY */ @@ -395,6 +419,13 @@ toke_scan_str(int offset); RETVAL int +toke_scan_ident(int offset) + CODE: + RETVAL = dd_toke_scan_ident(aTHX_ offset); + OUTPUT: + RETVAL + +int toke_skipspace(int offset) CODE: RETVAL = dd_toke_skipspace(aTHX_ offset);