more B fixups to cope with empty GVs (these can only happen in pads)

p4raw-id: //depot/perl@5150

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 38e56a8..4512d91 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -420,6 +420,10 @@ C<REFCNT> (corresponding to the C function C<SvREFCNT>).
 
 =over 4
 
+=item is_empty
+
+This method returns TRUE if the GP field of the GV is NULL.
+
 =item NAME
 
 =item STASH

diff --git a/ext/B/B.xs b/ext/B/B.xs
index ba22180..df0b501 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -998,6 +998,14 @@ GvNAME(gv)
     CODE:
        ST(0) = sv_2mortal(newSVpvn(GvNAME(gv), GvNAMELEN(gv)));
 
+bool
+is_empty(gv)
+        B::GV   gv
+    CODE:
+        RETVAL = GvGP(gv) == Null(GP*);
+    OUTPUT:
+        RETVAL
+
 B::HV
 GvSTASH(gv)
        B::GV   gv

diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index 438c2c2..c8fd96b 100644 (file)
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -391,9 +391,10 @@ sub B::NULL::save {
     return $sym if defined $sym;
 #   warn "Saving SVt_NULL SV\n"; # debug
     # debug
-    #if ($$sv == 0) {
-    #  warn "NULL::save for sv = 0 called from @{[(caller(1))[3]]}\n";
-    #}
+    if ($$sv == 0) {
+       warn "NULL::save for sv = 0 called from @{[(caller(1))[3]]}\n";
+       return savesym($sv, "Nullsv /* XXX */");
+    }
     $svsect->add(sprintf("0, %u, 0x%x", $sv->REFCNT , $sv->FLAGS));
     return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
 }
@@ -764,24 +765,31 @@ sub B::GV::save {
        $sym = savesym($gv, "gv_list[$ix]");
        #warn sprintf("Saving GV 0x%x as $sym\n", $$gv); # debug
     }
+    my $is_empty = $gv->is_empty;
     my $gvname = $gv->NAME;
     my $name = cstring($gv->STASH->NAME . "::" . $gvname);
     #warn "GV name is $name\n"; # debug
-    my $egv = $gv->EGV;
     my $egvsym;
-    if ($$gv != $$egv) {
-       #warn(sprintf("EGV name is %s, saving it now\n",
-       #            $egv->STASH->NAME . "::" . $egv->NAME)); # debug
-       $egvsym = $egv->save;
+    unless ($is_empty) {
+       my $egv = $gv->EGV;
+       if ($$gv != $$egv) {
+           #warn(sprintf("EGV name is %s, saving it now\n",
+           #        $egv->STASH->NAME . "::" . $egv->NAME)); # debug
+           $egvsym = $egv->save;
+       }
     }
     $init->add(qq[$sym = gv_fetchpv($name, TRUE, SVt_PV);],
               sprintf("SvFLAGS($sym) = 0x%x;", $gv->FLAGS),
-              sprintf("GvFLAGS($sym) = 0x%x;", $gv->GvFLAGS),
-              sprintf("GvLINE($sym) = %u;", $gv->LINE));
+              sprintf("GvFLAGS($sym) = 0x%x;", $gv->GvFLAGS));
+    $init->add(sprintf("GvLINE($sym) = %u;", $gv->LINE)) unless $is_empty;
+
     # Shouldn't need to do save_magic since gv_fetchpv handles that
     #$gv->save_magic;
     my $refcnt = $gv->REFCNT + 1;
     $init->add(sprintf("SvREFCNT($sym) += %u;", $refcnt - 1)) if $refcnt > 1;
+
+    return $sym if $is_empty;
+
     my $gvrefcnt = $gv->GvREFCNT;
     if ($gvrefcnt > 1) {
        $init->add(sprintf("GvREFCNT($sym) += %u;", $gvrefcnt - 1));

diff --git a/op.c b/op.c
index 32eb7b0..eb60ec1 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1412,18 +1412,19 @@ Perl_mod(pTHX_ OP *o, I32 type)
                    if (kid->op_type == OP_METHOD_NAMED
                        || kid->op_type == OP_METHOD)
                    {
-                       OP *newop;
+                       UNOP *newop;
 
                        if (kid->op_sibling || kid->op_next != kid) {
                            yyerror("panic: unexpected optree near method call");
                            break;
                        }
                        
-                       NewOp(1101, newop, 1, OP);
+                       NewOp(1101, newop, 1, UNOP);
                        newop->op_type = OP_RV2CV;
                        newop->op_ppaddr = PL_ppaddr[OP_RV2CV];
-                       newop->op_next = newop;
-                       kid->op_sibling = newop;
+                       newop->op_first = Nullop;
+                        newop->op_next = (OP*)newop;
+                       kid->op_sibling = (OP*)newop;
                        newop->op_private |= OPpLVAL_INTRO;
                        break;
                    }