Bug #23534 for Devel-Caller: patch for print foo( $bar ), baz( $quux );

I Wrote a patch which fixes the problem "print foo( $bar ), baz( $quux );", written in pod. before: Show quoted text
'*foo=*baz=sub{called_with(0,1)};print foo(my$bar), baz(my$quux);' $bar$bar after: Show quoted text
'*foo=*baz=sub{called_with(0,1)};print foo(my$bar), baz(my$quux);' $bar$quux tested on SUSE 10 (x86_64).

diff -urN Devel-Caller-0.11.orig/lib/Devel/Caller.xs Devel-Caller-0.11.my/lib/Devel/Caller.xs --- Devel-Caller-0.11.orig/lib/Devel/Caller.xs 2006-07-09 10:58:13.000000000 +0900 +++ Devel-Caller-0.11.my/lib/Devel/Caller.xs 2006-11-22 12:02:35.000000000 +0900 @@ -24,12 +24,9 @@ SV* glob_out(char sigil, GVOP* op, I32 want_name) { - GV* gv = OPGV(op); - SV* ret; - #if WORK_DAMN_YOU printf("%c op:%x defgv:%x gv:%x want_name:%d padix:%d\n", - sigil, op, PL_defgv, gv, want_name, cPADOPx(op)->op_padix ); + sigil, op, PL_defgv, OPGV(op), want_name, cPADOPx(op)->op_padix ); #endif #if defined(USE_ITHREADS) && (PERL_VERSION == 8) @@ -39,6 +36,10 @@ } return sv_2mortal(newSVsv(&PL_sv_undef)); #else + { + GV* gv = OPGV(op); + SV* ret; + if (want_name) { return sv_2mortal(newSVpvf("%c%s::%s", sigil, HvNAME(GvSTASH(gv)), @@ -52,6 +53,7 @@ case '*': ret = (SV*) GvEGV(gv); break; } return sv_2mortal(newRV_inc(ret)); + } #endif } @@ -66,7 +68,7 @@ SV *sv; if (op->op_type != OP_PUSHMARK) - croak("was expecting a pushmark, not a '%s'", OP_NAME(op)); + croak("was expecting a pushmark, not a '%s' (scan_forward)", OP_NAME(op)); for (; op && op->op_type != OP_ENTERSUB; op = op->op_next) { #if WORK_DAMN_YOU @@ -89,11 +91,11 @@ break; } } -#if WORK_DAMN_YOU - printf("SCAN END\n"); -#endif sv = av_pop(markstack); +#if WORK_DAMN_YOU + printf("SCAN END op %lx\n", INT2PTR(OP*, SvIV(sv))); +#endif return (OP*) SvIV(sv); } @@ -113,7 +115,7 @@ SV** oldpad; OP* op, *prev_op; int skip_next = 0; - GV* gv; + SV** sp_rollback; PPCODE: { @@ -133,11 +135,34 @@ if (op->op_type != OP_PUSHMARK) croak("was expecting a pushmark, not a '%s'", OP_NAME(op)); - while ((prev_op = op) && (op = op->op_next) && (op->op_type != OP_ENTERSUB)) { + sp_rollback = sp; + while ((prev_op = op) && (op = op->op_next) ) { #if WORK_DAMN_YOU printf("op %x %s next %x sibling %x targ %d\n", op, OP_NAME(op), op->op_next, op->op_sibling, op->op_targ); #endif + if( op->op_type == OP_ENTERSUB ) + { +#if WORK_DAMN_YOU + printf("take it? %s\n", op->op_next==PL_retstack[cx->blk_oldretsp-1]?"yes":"no"); +#endif + if( op->op_next!=NULL && op->op_next!=PL_retstack[cx->blk_oldretsp-1] ) + { + sp = sp_rollback; + while( op && op->op_type!=OP_PUSHMARK ) + { + op = op->op_next; + } + if (!op) + croak("pushmark not found"); + op = scan_forward(op); + if (op->op_type != OP_PUSHMARK) + croak("was expecting a pushmark, not a '%s' (_caller_with)", OP_NAME(op)); + continue; + } + break; + } + switch (op->op_type) { case OP_PUSHMARK: /* if it's a pushmark there's a probably a sub-operation brewing, diff -urN Devel-Caller-0.11.orig/t/70_todo_multicall.t Devel-Caller-0.11.my/t/70_todo_multicall.t --- Devel-Caller-0.11.orig/t/70_todo_multicall.t 1970-01-01 09:00:00.000000000 +0900 +++ Devel-Caller-0.11.my/t/70_todo_multicall.t 2006-11-22 12:00:51.000000000 +0900 @@ -0,0 +1,31 @@ + +use strict; +use warnings; +use Test::More tests => 3; +use Devel::Caller qw(called_with); + +&test01_multi_call; + +sub my_caller_vars{ called_with 0, 1; }; + +sub test01_multi_call +{ + { + my @names = (my_caller_vars(my$a, my$b), my_caller_vars(my ($x,$y))); + is_deeply(\@names,[qw($a $b $x $y)]); + #print Dumper(\@names); use Data::Dumper; + } + + { + my @names = (my_caller_vars(my($i, $j)), my_caller_vars(my $u,my $v)); + is_deeply(\@names,[qw($i $j $u $v)]); + #print Dumper(\@names); use Data::Dumper; + } + + { + my @names = (my_caller_vars(my$n), '++', my_caller_vars(my$m)); + is_deeply(\@names,[qw($n ++ $m)]); + #print Dumper(\@names); use Data::Dumper; + } +} +