Re: Bug in B::Deparse/Concise with ithreads

Message-ID: <16153.27783.300094.464863@syllepsis.MIT.EDU>

p4raw-id: //depot/perl@20198

2 files changed, 30 insertions, 10 deletions

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 755c837d32..a95f7181bd 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -275,9 +275,13 @@ sub walk_topdown {
 	    walk_topdown($kid, $sub, $level + 1);
 	}
     }
-    if (class($op) eq "PMOP" and $op->pmreplroot and $ {$op->pmreplroot}
-	and $op->pmreplroot->isa("B::OP")) {
-	walk_topdown($op->pmreplroot, $sub, $level + 1);
+    if (class($op) eq "PMOP") {
+	my $maybe_root = $op->pmreplroot;
+	if (ref($maybe_root) and $maybe_root->isa("B::OP")) {
+	    # It really is the root of the replacement, not something
+	    # else stored here for lack of space elsewhere
+	    walk_topdown($maybe_root, $sub, $level + 1);
+	}
     }
 }
 
@@ -520,10 +524,16 @@ sub concise_op {
 	}
 	my $pmreplroot = $op->pmreplroot;
 	my $pmreplstart;
-	if ($pmreplroot && $$pmreplroot && $pmreplroot->isa("B::GV")) {
+	if (ref($pmreplroot) eq "B::GV") {
 	    # with C<@stash_array = split(/pat/, str);>,
-	    #  *stash_array is stored in pmreplroot.
+	    #  *stash_array is stored in /pat/'s pmreplroot.
 	    $h{arg} = "($precomp => \@" . $pmreplroot->NAME . ")";
+	} elsif (!ref($pmreplroot) and $pmreplroot) {
+	    # same as the last case, except the value is actually a
+	    # pad offset for where the GV is kept (this happens under
+	    # ithreads)
+	    my $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$pmreplroot];
+	    $h{arg} = "($precomp => \@" . $gv->NAME . ")";
 	} elsif ($ {$op->pmreplstart}) {
 	    undef $lastnext;
 	    $pmreplstart = "replstart->" . seq($op->pmreplstart);
diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index 6829d92c17..21bab8256e 100644
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -1102,7 +1102,7 @@ BEGIN { map($globalnames{$_}++, "SIG", "STDIN", "STDOUT", "STDERR", "INC",
 sub gv_name {
     my $self = shift;
     my $gv = shift;
-Carp::confess() if $gv->isa("B::CV");
+Carp::confess() unless ref($gv) eq "B::GV";
     my $stash = $gv->STASH->NAME;
     my $name = $gv->SAFENAME;
     if (($stash eq 'main' && $globalnames{$name})
@@ -3725,12 +3725,22 @@ sub pp_split {
     my($op, $cx) = @_;
     my($kid, @exprs, $ary, $expr);
     $kid = $op->first;
-    # under ithreads pmreplroot is an integer, not an SV
+
+    # For our kid (an OP_PUSHRE), pmreplroot is never actually the
+    # root of a replacement; it's either empty, or abused to point to
+    # the GV for an array we split into (an optimization to save
+    # assignment overhead). Depending on whether we're using ithreads,
+    # this OP* holds either a GV* or a PADOFFSET. Luckily, B.xs
+    # figures out for us which it is.
     my $replroot = $kid->pmreplroot;
-    if ( ( ref($replroot) && $$replroot ) ||
-         ( !ref($replroot) && $replroot ) ) {
-	$ary = $self->stash_variable('@', $self->gv_name($kid->pmreplroot));
+    my $gv = 0;
+    if (ref($replroot) eq "B::GV") {
+	$gv = $replroot;
+    } elsif (!ref($replroot) and $replroot > 0) {
+	$gv = $self->padval($replroot);
     }
+    $ary = $self->stash_variable('@', $self->gv_name($gv)) if $gv;
+
     for (; !null($kid); $kid = $kid->sibling) {
 	push @exprs, $self->deparse($kid, 6);
     }