diff options
| author | Vishal Bhatia <vishal@deja.com> | 1999-01-11 10:02:41 +0200 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 1999-01-13 18:05:43 +0000 |
| commit | 88b39979ed4ec47a51ecb175fcf086fb7df0ebdb (patch) | |
| tree | 27a5b51a617c35843692dabdca3468a8e02acb8d /ext | |
| parent | a297ace274c6f16f4e0bf9e7bfbe05a4984ed802 (diff) | |
| download | perl-88b39979ed4ec47a51ecb175fcf086fb7df0ebdb.tar.gz | |
B::MAGIC::PTR doesnot check for valid length.
Lines: 134
Message-ID: <MLIST_19990111052126.27966.qmail@hotmail.com>
p4raw-id: //depot/cfgperl@2602
Diffstat (limited to 'ext')
| -rw-r--r-- | ext/B/B.xs | 15 | ||||
| -rw-r--r-- | ext/B/B/C.pm | 14 |
2 files changed, 24 insertions, 5 deletions
diff --git a/ext/B/B.xs b/ext/B/B.xs index 3e300240ea..926791f98b 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 95c5858df8..fe47f0abdf 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)); + } } } |