From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sat, 19 Feb 2000 17:33:05 +0000 (+0000)
Subject: more B fixups to cope with empty GVs (these can only happen in pads)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=87d7fd28459b8274079ce3260d3e07e306aa70d8;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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;
 		    }