From: Vishal Bhatia <vishal@deja.com>
Date: Mon, 11 Jan 1999 08:02:41 +0000 (+0200)
Subject: B::MAGIC::PTR doesnot check for valid length.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=88b39979ed4ec47a51ecb175fcf086fb7df0ebdb;p=p5sagit%2Fp5-mst-13.2.git

B::MAGIC::PTR doesnot check for valid length.
Lines: 134
Message-ID: <MLIST_19990111052126.27966.qmail@hotmail.com>

p4raw-id: //depot/cfgperl@2602
---

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 3e30024..926791f 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -918,6 +918,7 @@ SvSTASH(sv)
 #define MgTYPE(mg) mg->mg_type
 #define MgFLAGS(mg) mg->mg_flags
 #define MgOBJ(mg) mg->mg_obj
+#define MgLENGTH(mg) mg->mg_len
 
 MODULE = B	PACKAGE = B::MAGIC	PREFIX = Mg	
 
@@ -941,13 +942,23 @@ B::SV
 MgOBJ(mg)
 	B::MAGIC	mg
 
+I32 
+MgLENGTH(mg)
+	B::MAGIC	mg
+ 
 void
 MgPTR(mg)
 	B::MAGIC	mg
     CODE:
 	ST(0) = sv_newmortal();
-	if (mg->mg_ptr)
-	    sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
+ 	if (mg->mg_ptr){
+		if (mg->mg_len >= 0){
+	    		sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
+		} else {
+			if (mg->mg_len == HEf_SVKEY)	
+				sv_setsv(ST(0),newRV((SV*)mg->mg_ptr));
+		}
+	}
 
 MODULE = B	PACKAGE = B::PVLV	PREFIX = Lv
 
diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index 95c5858..fe47f0a 100644
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -104,6 +104,7 @@ sub walk_and_save_optree {
 my $op_seq = 65535;
 
 sub AVf_REAL () { 1 }
+sub define HEf_SVKEY   () { -2 }
 
 # Look this up here so we can do just a number compare
 # rather than looking up the name of every BASEOP in B::OP
@@ -508,19 +509,26 @@ sub B::PVMG::save_magic {
 	$init->add(sprintf("SvSTASH(s\\_%x) = s\\_%x;", $$sv, $$stash));
     }
     my @mgchain = $sv->MAGIC;
-    my ($mg, $type, $obj, $ptr);
+    my ($mg, $type, $obj, $ptr,$len,$ptrsv);
     foreach $mg (@mgchain) {
 	$type = $mg->TYPE;
 	$obj = $mg->OBJ;
 	$ptr = $mg->PTR;
-	my $len = defined($ptr) ? length($ptr) : 0;
+	$len=$mg->LENGTH;
 	if ($debug_mg) {
 	    warn sprintf("magic %s (0x%x), obj %s (0x%x), type %s, ptr %s\n",
 			 class($sv), $$sv, class($obj), $$obj,
 			 cchar($type), cstring($ptr));
 	}
-	$init->add(sprintf("sv_magic((SV*)s\\_%x, (SV*)s\\_%x, %s, %s, %d);",
+	if ($len == HEf_SVKEY){
+		#The pointer is an SV*
+		$ptrsv=svref_2object($ptr)->save;
+		$init->add(sprintf("sv_magic((SV*)s\\_%x, (SV*)s\\_%x, %s, %s, %d);",
+			   $$sv, $$obj, cchar($type),$ptrsv,$len));
+	}else{
+		$init->add(sprintf("sv_magic((SV*)s\\_%x, (SV*)s\\_%x, %s, %s, %d);",
 			   $$sv, $$obj, cchar($type),cstring($ptr),$len));
+	}
     }
 }