From: Matt S Trout Date: Sun, 1 Jul 2007 16:58:39 +0000 (+0000) Subject: pad stuffing by source injection X-Git-Tag: 0.005000~137 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FDevel-Declare.git;a=commitdiff_plain;h=53e3ab3280e00c6a88e4c9e1dd250f82d735ca19 pad stuffing by source injection --- diff --git a/Declare.xs b/Declare.xs index 2e919d6..15ff50c 100644 --- a/Declare.xs +++ b/Declare.xs @@ -9,7 +9,9 @@ #include #include -#define DD_DEBUG 0 +#if 0 +#define DD_DEBUG +#endif #define DD_HANDLE_NAME 1 #define DD_HANDLE_PROTO 2 @@ -26,7 +28,7 @@ /* placeholders for PL_check entries we wrap */ STATIC OP *(*dd_old_ck_rv2cv)(pTHX_ OP *op); -STATIC OP *(*dd_old_ck_nextstate)(pTHX_ OP *op); +STATIC OP *(*dd_old_ck_lineseq)(pTHX_ OP *op); /* flag to trigger removal of temporary declaree sub */ @@ -49,6 +51,9 @@ STATIC OP *dd_ck_rv2cv(pTHX_ OP *o) { SV** is_declarator_flag_ref; int dd_flags; char* cb_args[5]; + dSP; /* define stack pointer for later call stuff */ + char* retstr; + STRLEN n_a; /* for POPpx */ o = dd_old_ck_rv2cv(aTHX_ o); /* let the original do its job */ @@ -156,7 +161,10 @@ STATIC OP *dd_ck_rv2cv(pTHX_ OP *o) { printf("Found proto %s\n", SvPVX(PL_lex_stuff)); #endif found_proto = SvPVX(PL_lex_stuff); - *save_s++ = '='; + if (len) /* foo name () => foo name X, only foo parsed so works */ + *save_s++ = ' '; + else /* foo () => foo =X, TOKEN('&') won't handle foo X */ + *save_s++ = '='; *save_s++ = 'X'; while (save_s < s) { *save_s++ = ' '; @@ -168,25 +176,84 @@ STATIC OP *dd_ck_rv2cv(pTHX_ OP *o) { } } - if (len || found_proto) { - if (!len) - found_name[0] = 0; + if (!len) + found_name[0] = 0; + +#ifdef DD_DEBUG + printf("Calling init_declare\n"); +#endif + cb_args[0] = HvNAME(stash); + cb_args[1] = GvNAME(kGVOP_gv); + cb_args[2] = found_name; + cb_args[3] = found_proto; + cb_args[4] = NULL; + + if (len && found_proto) + in_declare = 2; + else if (len || found_proto) + in_declare = 1; + if (found_proto) + PL_lex_stuff = Nullsv; + s = skipspace(s); +#ifdef DD_DEBUG + printf("cur buf: %s\n", s); + printf("bufend at: %i\n", PL_bufend - s); + printf("linestr: %s\n", SvPVX(PL_linestr)); + printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr)); +#endif + if (*s++ == '{') { + call_argv("Devel::Declare::init_declare", G_SCALAR, cb_args); + SPAGAIN; + retstr = POPpx; + PUTBACK; + if (retstr && strlen(retstr)) { #ifdef DD_DEBUG - printf("Calling init_declare"); + printf("Got string %s\n", retstr); #endif - cb_args[0] = HvNAME(stash); - cb_args[1] = GvNAME(kGVOP_gv); - cb_args[2] = found_name; - cb_args[3] = found_proto; - cb_args[4] = NULL; + SvGROW(PL_linestr, strlen(retstr)); + memmove(s+strlen(retstr), s, (PL_bufend - s)+1); + memmove(s, retstr, strlen(retstr)); + PL_bufend += strlen(retstr); +#ifdef DD_DEBUG + printf("cur buf: %s\n", s); + printf("bufend at: %i\n", PL_bufend - s); + printf("linestr: %s\n", SvPVX(PL_linestr)); + printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr)); +#endif + } + } else { call_argv("Devel::Declare::init_declare", G_VOID|G_DISCARD, cb_args); - if (len && found_proto) - in_declare = 2; - else - in_declare = 1; - if (found_proto) - PL_lex_stuff = Nullsv; } + return o; +} + +STATIC OP *dd_ck_lineseq(pTHX_ OP *o) { + AV* pad_inject_list; + SV** to_inject_ref; + int i, pad_inject_list_last; + + o = dd_old_ck_lineseq(o); + + pad_inject_list = get_av("Devel::Declare::next_pad_inject", FALSE); + if (!pad_inject_list) + return o; + + pad_inject_list_last = av_len(pad_inject_list); + + if (pad_inject_list_last == -1) + return o; + + for (i = 0; i <= pad_inject_list_last; i++) { + to_inject_ref = av_fetch(pad_inject_list, i, FALSE); + if (to_inject_ref && SvPOK(*to_inject_ref)) { +#ifdef DD_DEBUG + printf("Injecting %s into pad\n", SvPVX(*to_inject_ref)); +#endif + allocmy(SvPVX(*to_inject_ref)); + } + } + + av_clear(pad_inject_list); return o; } @@ -203,6 +270,8 @@ setup() if (!initialized++) { dd_old_ck_rv2cv = PL_check[OP_RV2CV]; PL_check[OP_RV2CV] = dd_ck_rv2cv; + dd_old_ck_lineseq = PL_check[OP_LINESEQ]; + PL_check[OP_LINESEQ] = dd_ck_lineseq; } void diff --git a/lib/Devel/Declare.pm b/lib/Devel/Declare.pm index c5cab5a..4f4a473 100644 --- a/lib/Devel/Declare.pm +++ b/lib/Devel/Declare.pm @@ -10,8 +10,9 @@ our $VERSION = 0.001000; use constant DECLARE_NAME => 1; use constant DECLARE_PROTO => 2; +use constant DECLARE_NONE => 4; -use vars qw(%declarators %declarator_handlers); +use vars qw(%declarators %declarator_handlers @next_pad_inject); use base qw(DynaLoader); bootstrap Devel::Declare; @@ -21,8 +22,8 @@ sub import { my $target = caller; if (@_ == 1) { # "use Devel::Declare;" no strict 'refs'; - foreach my $name (qw(DECLARE_NAME DECLARE_PROTO)) { - *{"${target}::${name}"} = *{"${name}"}; + foreach my $name (qw(NAME PROTO NONE)) { + *{"${target}::DECLARE_${name}"} = *{"DECLARE_${name}"}; } } else { $class->setup_for($target => \%args); @@ -67,9 +68,10 @@ my $temp_save; sub init_declare { my ($pack, $use, $name, $proto) = @_; - my ($name_h, $XX_h) = $declarator_handlers{$pack}{$use}->( - $pack, $use, $name, $proto - ); + my ($name_h, $XX_h, $extra_code) + = $declarator_handlers{$pack}{$use}->( + $pack, $use, $name, $proto, defined(wantarray) + ); ($temp_pack, $temp_name, $temp_save) = ($pack, [], []); if ($name) { push(@$temp_name, $name); @@ -87,6 +89,11 @@ sub init_declare { no warnings 'prototype'; *{"${pack}::X"} = $XX_h; } + if (defined wantarray) { + return $extra_code || '0;'; + } else { + return; + } } sub done_declare { @@ -101,6 +108,10 @@ sub done_declare { } } +sub inject_into_next_pad { + shift; @next_pad_inject = @_; +} + =head1 NAME Devel::Declare - diff --git a/t/padstuff.t b/t/padstuff.t new file mode 100644 index 0000000..129a1b7 --- /dev/null +++ b/t/padstuff.t @@ -0,0 +1,22 @@ +use strict; +use warnings; +use Test::More 'no_plan'; + +sub action (&) { return shift; } + +sub handle_action { + return (undef, undef, 'my ($self, $c) = (shift, shift);'); +} + +use Devel::Declare; +use Devel::Declare action => [ DECLARE_NONE, \&handle_action ]; + +my $args; + +my $a = action { + $args = join(', ', $self, $c); +}; + +$a->("SELF", "CONTEXT"); + +is($args, "SELF, CONTEXT", "args passed ok"); diff --git a/t/simple.t b/t/simple.t index dca0887..9b022d0 100644 --- a/t/simple.t +++ b/t/simple.t @@ -24,7 +24,7 @@ method bar { method # blather baz # whee -{ +{ # fweet $args2 = join(', ', @_); };