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 (file)
--- 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 (file)
--- 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));
+       }
     }
 }