From: Florian Ragwitz Date: Tue, 9 Mar 2010 01:48:10 +0000 (+0100) Subject: Make things work on 5.11.2 and newer. X-Git-Tag: 0.006000~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=023db2fba97b8b676d5ab45c99328b66409151b4;p=p5sagit%2FDevel-Declare.git Make things work on 5.11.2 and newer. --- diff --git a/Declare.xs b/Declare.xs index 3a4ff95..b11d65d 100644 --- a/Declare.xs +++ b/Declare.xs @@ -7,6 +7,12 @@ #include #include +#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)) + #ifndef Newx # define Newx(v,n,t) New(0,v,n,t) #endif /* !Newx */ @@ -18,6 +24,8 @@ #define DD_DEBUG_TRACE (dd_debug & DD_DEBUGf_TRACE) static int dd_debug = 0; +#define DD_CONST_VIA_RV2CV PERL_VERSION_GE(5,11,2) + #define LEX_NORMAL 10 #define LEX_INTERPNORMAL 9 @@ -224,41 +232,48 @@ int dd_toke_skipspace(pTHX_ int offset) { return s - base_s; } +static void call_done_declare(pTHX) { + dSP; + + if (DD_DEBUG_TRACE) { + printf("Deconstructing declare\n"); + printf("PL_bufptr: %s\n", PL_bufptr); + printf("bufend at: %i\n", PL_bufend - PL_bufptr); + printf("linestr: %s\n", SvPVX(PL_linestr)); + printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr)); + } + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + + call_pv("Devel::Declare::done_declare", G_VOID|G_DISCARD); + + FREETMPS; + LEAVE; + + if (DD_DEBUG_TRACE) { + printf("PL_bufptr: %s\n", PL_bufptr); + printf("bufend at: %i\n", PL_bufend - PL_bufptr); + printf("linestr: %s\n", SvPVX(PL_linestr)); + printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr)); + printf("actual len: %i\n", strlen(PL_bufptr)); + } +} + +static int dd_handle_const(pTHX_ char *name); + /* 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_TRACE) { - printf("Deconstructing declare\n"); - printf("PL_bufptr: %s\n", PL_bufptr); - printf("bufend at: %i\n", PL_bufend - PL_bufptr); - printf("linestr: %s\n", SvPVX(PL_linestr)); - printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr)); - } - - ENTER; - SAVETMPS; - - PUSHMARK(SP); - - call_pv("Devel::Declare::done_declare", G_VOID|G_DISCARD); - - FREETMPS; - LEAVE; - - if (DD_DEBUG_TRACE) { - printf("PL_bufptr: %s\n", PL_bufptr); - printf("bufend at: %i\n", PL_bufend - PL_bufptr); - printf("linestr: %s\n", SvPVX(PL_linestr)); - printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr)); - printf("actual len: %i\n", strlen(PL_bufptr)); - } + call_done_declare(aTHX); return o; } @@ -284,6 +299,24 @@ STATIC OP *dd_ck_rv2cv(pTHX_ OP *o, void *user_data) { printf("PL_tokenbuf: %s\n", PL_tokenbuf); } +#if DD_CONST_VIA_RV2CV + if (PL_expect != XOPERATOR) { + if (!dd_handle_const(aTHX_ GvNAME(kGVOP_gv))) + return o; + CopLINE(PL_curcop) = PL_copline; + /* The parser behaviour that we're simulating depends on what comes + after the declarator. */ + if (*skipspace(PL_bufptr + strlen(GvNAME(kGVOP_gv))) != '(') { + if (in_declare) { + call_done_declare(aTHX); + } else { + dd_linestr_callback(aTHX_ "rv2cv", GvNAME(kGVOP_gv)); + } + } + return o; + } +#endif /* DD_CONST_VIA_RV2CV */ + dd_linestr_callback(aTHX_ "rv2cv", GvNAME(kGVOP_gv)); return o; @@ -341,33 +374,7 @@ static I32 dd_filter_realloc(pTHX_ int idx, SV *sv, int maxlen) return count; } -STATIC OP *dd_ck_const(pTHX_ OP *o, void *user_data) { - int dd_flags; - char* name; - - PERL_UNUSED_VAR(user_data); - - if (DD_HAVE_PARSER && PL_expect == XOPERATOR) { - return o; - } - - /* if this is set, we just grabbed a delimited string or something, - not a bareword, so NO TOUCHY */ - - if (DD_HAVE_LEX_STUFF) - return o; - - /* don't try and look this up if it's not a string const */ - if (!SvPOK(cSVOPo->op_sv)) - return o; - - name = SvPVX(cSVOPo->op_sv); - - dd_flags = dd_is_declarator(aTHX_ name); - - if (dd_flags == -1) - return o; - +static int dd_handle_const(pTHX_ char *name) { switch (PL_lex_inwhat) { case OP_QR: case OP_MATCH: @@ -375,14 +382,14 @@ STATIC OP *dd_ck_const(pTHX_ OP *o, void *user_data) { case OP_TRANS: case OP_BACKTICK: case OP_STRINGIFY: - return o; + return 0; break; default: break; } if (strnEQ(PL_bufptr, "->", 2)) { - return o; + return 0; } { @@ -401,7 +408,7 @@ STATIC OP *dd_ck_const(pTHX_ OP *o, void *user_data) { sv_catpvn(inject, s, d - s); if ((PL_bufend - d) >= 2 && strnEQ(d, "=>", 2)) { - return o; + return 0; } sv_catpv(inject, d); @@ -413,9 +420,45 @@ STATIC OP *dd_ck_const(pTHX_ OP *o, void *user_data) { dd_linestr_callback(aTHX_ "const", name); + return 1; +} + +#if !DD_CONST_VIA_RV2CV + +STATIC OP *dd_ck_const(pTHX_ OP *o, void *user_data) { + int dd_flags; + char* name; + + PERL_UNUSED_VAR(user_data); + + if (DD_HAVE_PARSER && PL_expect == XOPERATOR) { + return o; + } + + /* if this is set, we just grabbed a delimited string or something, + not a bareword, so NO TOUCHY */ + + if (DD_HAVE_LEX_STUFF) + return o; + + /* don't try and look this up if it's not a string const */ + if (!SvPOK(cSVOPo->op_sv)) + return o; + + name = SvPVX(cSVOPo->op_sv); + + dd_flags = dd_is_declarator(aTHX_ name); + + if (dd_flags == -1) + return o; + + dd_handle_const(aTHX_ name); + return o; } +#endif /* !DD_CONST_VIA_RV2CV */ + static int initialized = 0; MODULE = Devel::Declare PACKAGE = Devel::Declare @@ -428,7 +471,9 @@ setup() if (!initialized++) { hook_op_check(OP_RV2CV, dd_ck_rv2cv, NULL); hook_op_check(OP_ENTEREVAL, dd_ck_entereval, NULL); +#if !DD_CONST_VIA_RV2CV hook_op_check(OP_CONST, dd_ck_const, NULL); +#endif /* !DD_CONST_VIA_RV2CV */ } filter_add(dd_filter_realloc, NULL); diff --git a/t/debug.t b/t/debug.t index 62b8721..9373421 100644 --- a/t/debug.t +++ b/t/debug.t @@ -1,7 +1,13 @@ use strict; use warnings; -use Test::More tests => 1; +use Test::More; + +BEGIN { + if($] eq "5.011002") { + plan skip_all => "line debugging broken on 5.11.2"; + } +} use Cwd qw/cwd/; use FindBin qw/$Bin/; @@ -25,4 +31,5 @@ my $output = `$^X -d t/debug.pl`; like($output, qr/method new {}, sub {my \$self = shift;/, "replaced line string visible in debug lines"); -1; + +done_testing;