This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix B::PADOP->sv and ->gv
authorDavid Mitchell <davem@iabyn.com>
Fri, 19 Sep 2014 15:07:08 +0000 (16:07 +0100)
committerDavid Mitchell <davem@iabyn.com>
Fri, 19 Sep 2014 15:33:08 +0000 (16:33 +0100)
PADOP structs, which are only used on threaded builds, have an op_padix
field rather than an op_sv or op_gv.

The B::PADOP sv and gv methods would do PL_curpad[o->op_padix] to
look up the value, That is completely wrong. PL_curpad is the pad of the
caller of B::PADOP::sv/gv, not the pad of the sub containing the PADOP op.

This fault appears to to go back to 1999, when PADOP was first added.
It's probably never been spotted because:

a) PADOP only ever used for creating GV ops on threaded builds (so
->sv is probably never called),

b) it has a check where if the thing it retrieved from the pad isn't a GV,
it returns NULL instead.

Fix this by always returning NULL. This is comparable with B::SVOP_>sv,
which always returns op_sv, which on threaded builds always happens to be
NULL. Note that B::SVOP->sv expects the caller to retrieve op_targ and do
the pad lookup.

NB just to avoid confusion (I was certainly confused), these ops are
implemented with the types shown:

    unthreaded:

        const: B::SVOP
        gvsv:  B::SVOP

    threaded:

        const: B::SVOP
        gvsv:  B::PADOP

ext/B/B.xs
ext/B/t/b.t

index a130ad3..b048f80 100644 (file)
@@ -1159,20 +1159,15 @@ next(o)
                    }
                }
                break;
-           case 39: /* sv */
-           case 40: /* gv */
-               /* It happens that the output typemaps for B::SV and B::GV
-                * are identical. The "smarts" are in make_sv_object(),
-                * which determines which class to use based on SvTYPE(),
-                * rather than anything baked in at compile time.  */
-               if (cPADOPo->op_padix) {
-                   ret = PAD_SVl(cPADOPo->op_padix);
-                   if (ix == 40 && SvTYPE(ret) != SVt_PVGV)
-                       ret = NULL;
-               } else {
-                   ret = NULL;
-               }
-               ret = make_sv_object(aTHX_ ret);
+           case 39: /* B::PADOP::sv */
+           case 40: /* B::PADOP::gv */
+               /* PADOPs should only be created on threaded builds.
+                 * They don't have an sv or gv field, just an op_padix
+                 * field. Leave it to the caller to retrieve padix
+                 * and look up th value in the pad. Don't do it here,
+                 * becuase PL_curpad is the pad of the caller, not the
+                 * pad of the sub the op is part of */
+               ret = make_sv_object(aTHX_ NULL);
                break;
            case 41: /* pv */
                /* OP_TRANS uses op_pv to point to a table of 256 or >=258
index 9933978..271eb37 100644 (file)
@@ -443,4 +443,42 @@ SKIP: {
 }
 
 
+# make sure ->sv, -gv methods do the right thing on threaded builds
+{
+
+    # for some reason B::walkoptree only likes a sub name, not a code ref
+    my ($gv, $sv);
+    sub gvsv_const {
+        # make the early pad slots something unlike a threaded const or
+        # gvsv
+        my ($dummy1, $dummy2, $dummy3, $dummy4) = qw(foo1 foo2 foo3 foo4);
+        my $self = shift;
+        if ($self->name eq 'gvsv') {
+            $gv = $self->gv;
+        }
+        elsif ($self->name eq 'const') {
+            $sv = $self->sv;
+        }
+    };
+
+    B::walkoptree(B::svref_2object(sub {our $x = 1})->ROOT, "::gvsv_const");
+    ok(defined $gv, "gvsv->gv seen");
+    ok(defined $sv, "const->sv seen");
+    if ($Config::Config{useithreads}) {
+        # should get NULLs
+        is(ref($gv), "B::SPECIAL", "gvsv->gv is special");
+        is(ref($sv), "B::SPECIAL", "const->sv is special");
+        is($$gv, 0, "gvsv->gv special is 0 (NULL)");
+        is($$sv, 0, "const->sv special is 0 (NULL)");
+    }
+    else {
+        is(ref($gv), "B::GV", "gvsv->gv is GV");
+        is(ref($sv), "B::IV", "const->sv is IV");
+        pass();
+        pass();
+    }
+
+}
+
+
 done_testing();