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

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

p4raw-id: //depot/perl@20198

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 755c837..a95f718 100644 (file)
--- 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 6829d92..21bab82 100644 (file)
--- 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);
     }