diff options
| author | Matthew Horsfall <WolfSage@gmail.com> | 2013-10-03 10:09:22 -0400 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2013-10-25 23:40:55 -0700 |
| commit | a854082c1ddc5c6bb8d493a0cc4930601215559b (patch) | |
| tree | 24576a93db781e801beb138d26621fe184474755 /ext | |
| parent | 33ac96a5b7ec024766153eab2d7bb78a951877a2 (diff) | |
| download | perl-a854082c1ddc5c6bb8d493a0cc4930601215559b.tar.gz | |
Add op_other to B::Concise -debug output for LOGOPs
Diffstat (limited to 'ext')
| -rw-r--r-- | ext/B/B/Concise.pm | 4 | ||||
| -rw-r--r-- | ext/B/t/concise.t | 40 |
2 files changed, 42 insertions, 2 deletions
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 40713aa711..632cc66678 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -46,7 +46,8 @@ my %style = "gt_#seq ", "(?(#seq)?)#noise#arg(?([#targarg])?)"], "debug" => - ["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t" + ["#class (#addr)\n\top_next\t\t#nextaddr\n\t(?(op_other\t#otheraddr\n\t)?)" + . "op_sibling\t#sibaddr\n\t" . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n" . "\top_flags\t#flagval\n\top_private\t#privval\t#hintsval\n" . "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)" @@ -887,6 +888,7 @@ sub concise_op { } elsif ($h{class} eq "LOGOP") { undef $lastnext; $h{arg} = "(other->" . seq($op->other) . ")"; + $h{otheraddr} = sprintf("%#x", $ {$op->other}); } elsif ($h{class} eq "SVOP" or $h{class} eq "PADOP") { unless ($h{name} eq 'aelemfast' and $op->flags & OPf_SPECIAL) { diff --git a/ext/B/t/concise.t b/ext/B/t/concise.t index d3ef1f4d92..d43bd977e2 100644 --- a/ext/B/t/concise.t +++ b/ext/B/t/concise.t @@ -10,7 +10,7 @@ BEGIN { require 'test.pl'; # we use runperl from 'test.pl', so can't use Test::More } -plan tests => 161; +plan tests => 163; require_ok("B::Concise"); @@ -466,4 +466,42 @@ $out = ); like $out, '\*<none>::', 'glob(q{.})'; +# Test op_other in -debug +$out = runperl( + switches => ["-MO=Concise,-debug,xx"], + prog => q{sub xx { if ($a) { return $b } }}, + stderr => 1, +); + +$out =~s/\r\n/\n/g; + +# Look for OP_AND +$end = <<'EOF'; +LOGOP \(0x\w+\) + op_next 0x\w+ + op_other (0x\w+) + op_sibling 0 + op_ppaddr PL_ppaddr\[OP_AND\] +EOF + +$end =~ s/\r\n/\n/g; + +like $out, $end, 'OP_AND has op_other'; + +# like(..) above doesn't fill in $1 +$out =~ $end; +my $next = $1; + +# Check it points to a PUSHMARK +$end = <<'EOF'; +OP \(<NEXT>\) + op_next 0x\w+ + op_sibling 0x\w+ + op_ppaddr PL_ppaddr\[OP_PUSHMARK\] +EOF + +$end =~ s/<NEXT>/$next/; + +like $out, $end, 'OP_AND->op_other points correctly'; + __END__ |