search

Perl / perl5

🐪 The Perl programming language
https://dev.perl.org/perl5/
Other
1.9k stars 540 forks source link

lvalue substr keeping lexical alive #9800

Closed p5pRT closed 14 years ago

p5pRT commented 15 years ago

Migrated from rt.perl.org#67838 (status was 'resolved')

Searchable as RT67838$

p5pRT commented 14 years ago

From @ikegami

0004-Fix-untimely-destruction-introduced-by-lvalue-ops-RT.patch ```diff From ccc36f4e94c1a8a70d1c701c2393930a104ff58c Mon Sep 17 00:00:00 2001 From: Eric Brine Date: Sat, 31 Jul 2010 01:56:43 -0700 Subject: [PATCH 4/4] Fix untimely destruction introduced by lvalue ops [RT#67838] by returning a TEMP instead of using TARG. Made appropriate TODO tests live. --- doop.c | 38 +++++++---------- pp.c | 123 ++++++++++++++++++++++++-------------------------------- t/op/hash.t | 5 +-- t/op/pos.t | 5 +-- t/op/vec.t | 5 +-- t/re/substr.t | 5 +-- 6 files changed, 73 insertions(+), 108 deletions(-) diff --git a/doop.c b/doop.c index c1a357c..903144c 100644 --- a/doop.c +++ b/doop.c @@ -1456,32 +1456,26 @@ Perl_do_kv(pTHX) RETURN; if (gimme == G_SCALAR) { - IV i; - dTARGET; - if (PL_op->op_flags & OPf_MOD || LVRET) { /* lvalue */ - if (SvTYPE(TARG) < SVt_PVLV) { - sv_upgrade(TARG, SVt_PVLV); - sv_magic(TARG, NULL, PERL_MAGIC_nkeys, NULL, 0); - } - LvTYPE(TARG) = 'k'; - if (LvTARG(TARG) != (const SV *)keys) { - SvREFCNT_dec(LvTARG(TARG)); - LvTARG(TARG) = SvREFCNT_inc_simple(keys); - } - PUSHs(TARG); - RETURN; - } - - if (! SvTIED_mg((const SV *)keys, PERL_MAGIC_tied) ) - { - i = HvKEYS(keys); + SV * const ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */ + sv_magic(ret, NULL, PERL_MAGIC_nkeys, NULL, 0); + LvTYPE(ret) = 'k'; + LvTARG(ret) = SvREFCNT_inc_simple(keys); + PUSHs(ret); } else { - i = 0; - while (hv_iternext(keys)) i++; + IV i; + dTARGET; + + if (! SvTIED_mg((const SV *)keys, PERL_MAGIC_tied) ) { + i = HvKEYS(keys); + } + else { + i = 0; + while (hv_iternext(keys)) i++; + } + PUSHi( i ); } - PUSHi( i ); RETURN; } diff --git a/pp.c b/pp.c index 129c948..8d7952b 100644 --- a/pp.c +++ b/pp.c @@ -336,26 +336,21 @@ PP(pp_av2arylen) PP(pp_pos) { - dVAR; dSP; dTARGET; dPOPss; + dVAR; dSP; dPOPss; if (PL_op->op_flags & OPf_MOD || LVRET) { - if (SvTYPE(TARG) < SVt_PVLV) { - sv_upgrade(TARG, SVt_PVLV); - sv_magic(TARG, NULL, PERL_MAGIC_pos, NULL, 0); - } - - LvTYPE(TARG) = '.'; - if (LvTARG(TARG) != sv) { - SvREFCNT_dec(LvTARG(TARG)); - LvTARG(TARG) = SvREFCNT_inc_simple(sv); - } - PUSHs(TARG); /* no SvSETMAGIC */ + SV * const ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */ + sv_magic(ret, NULL, PERL_MAGIC_pos, NULL, 0); + LvTYPE(ret) = '.'; + LvTARG(ret) = SvREFCNT_inc_simple(sv); + PUSHs(ret); /* no SvSETMAGIC */ RETURN; } else { if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { const MAGIC * const mg = mg_find(sv, PERL_MAGIC_regex_global); if (mg && mg->mg_len >= 0) { + dTARGET; I32 i = mg->mg_len; if (DO_UTF8(sv)) sv_pos_b2u(sv, &i); @@ -3146,8 +3141,6 @@ PP(pp_substr) bool repl_need_utf8_upgrade = FALSE; bool repl_is_utf8 = FALSE; - SvTAINTED_off(TARG); /* decontaminate */ - SvUTF8_off(TARG); /* decontaminate */ if (num_args > 2) { if (num_args > 3) { repl_sv = POPs; @@ -3255,26 +3248,46 @@ PP(pp_substr) STRLEN byte_pos = utf8_curlen ? sv_pos_u2b_flags(sv, pos, &byte_len, SV_CONST_RETURN) : pos; - tmps += byte_pos; - /* we either return a PV or an LV. If the TARG hasn't been used - * before, or is of that type, reuse it; otherwise use a mortal - * instead. Note that LVs can have an extended lifetime, so also - * dont reuse if refcount > 1 (bug #20933) */ - if (SvTYPE(TARG) > SVt_NULL) { - if ( (SvTYPE(TARG) == SVt_PVLV) - ? (!lvalue || SvREFCNT(TARG) > 1) - : lvalue) - { - TARG = sv_newmortal(); + if (lvalue && !repl) { + SV * ret; + + if (!SvGMAGICAL(sv)) { + if (SvROK(sv)) { + SvPV_force_nolen(sv); + Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), + "Attempt to use reference as lvalue in substr"); + } + if (isGV_with_GP(sv)) + SvPV_force_nolen(sv); + else if (SvOK(sv)) /* is it defined ? */ + (void)SvPOK_only_UTF8(sv); + else + sv_setpvs(sv, ""); /* avoid lexical reincarnation */ } + + ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */ + sv_magic(ret, NULL, PERL_MAGIC_substr, NULL, 0); + LvTYPE(ret) = 'x'; + LvTARG(ret) = SvREFCNT_inc_simple(sv); + LvTARGOFF(ret) = pos; + LvTARGLEN(ret) = len; + + SPAGAIN; + PUSHs(ret); /* avoid SvSETMAGIC here */ + RETURN; } + SvTAINTED_off(TARG); /* decontaminate */ + SvUTF8_off(TARG); /* decontaminate */ + + tmps += byte_pos; sv_setpvn(TARG, tmps, byte_len); #ifdef USE_LOCALE_COLLATE sv_unmagic(TARG, PERL_MAGIC_collxfrm); #endif if (utf8_curlen) SvUTF8_on(TARG); + if (repl) { SV* repl_sv_copy = NULL; @@ -3291,34 +3304,6 @@ PP(pp_substr) SvUTF8_on(sv); SvREFCNT_dec(repl_sv_copy); } - else if (lvalue) { /* it's an lvalue! */ - if (!SvGMAGICAL(sv)) { - if (SvROK(sv)) { - SvPV_force_nolen(sv); - Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), - "Attempt to use reference as lvalue in substr"); - } - if (isGV_with_GP(sv)) - SvPV_force_nolen(sv); - else if (SvOK(sv)) /* is it defined ? */ - (void)SvPOK_only_UTF8(sv); - else - sv_setpvs(sv, ""); /* avoid lexical reincarnation */ - } - - if (SvTYPE(TARG) < SVt_PVLV) { - sv_upgrade(TARG, SVt_PVLV); - sv_magic(TARG, NULL, PERL_MAGIC_substr, NULL, 0); - } - - LvTYPE(TARG) = 'x'; - if (LvTARG(TARG) != sv) { - SvREFCNT_dec(LvTARG(TARG)); - LvTARG(TARG) = SvREFCNT_inc_simple(sv); - } - LvTARGOFF(TARG) = pos; - LvTARGLEN(TARG) = len; - } } SPAGAIN; PUSHs(TARG); /* avoid SvSETMAGIC here */ @@ -3333,31 +3318,29 @@ bound_fail: PP(pp_vec) { - dVAR; dSP; dTARGET; + dVAR; dSP; register const IV size = POPi; register const IV offset = POPi; register SV * const src = POPs; const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET; + SV * ret; - SvTAINTED_off(TARG); /* decontaminate */ if (lvalue) { /* it's an lvalue! */ - if (SvREFCNT(TARG) > 1) /* don't share the TARG (#20933) */ - TARG = sv_newmortal(); - if (SvTYPE(TARG) < SVt_PVLV) { - sv_upgrade(TARG, SVt_PVLV); - sv_magic(TARG, NULL, PERL_MAGIC_vec, NULL, 0); - } - LvTYPE(TARG) = 'v'; - if (LvTARG(TARG) != src) { - SvREFCNT_dec(LvTARG(TARG)); - LvTARG(TARG) = SvREFCNT_inc_simple(src); - } - LvTARGOFF(TARG) = offset; - LvTARGLEN(TARG) = size; + ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */ + sv_magic(ret, NULL, PERL_MAGIC_vec, NULL, 0); + LvTYPE(ret) = 'v'; + LvTARG(ret) = SvREFCNT_inc_simple(src); + LvTARGOFF(ret) = offset; + LvTARGLEN(ret) = size; + } + else { + dTARGET; + SvTAINTED_off(TARG); /* decontaminate */ + ret = TARG; } - sv_setuv(TARG, do_vecget(src, offset, size)); - PUSHs(TARG); + sv_setuv(ret, do_vecget(src, offset, size)); + PUSHs(ret); RETURN; } diff --git a/t/op/hash.t b/t/op/hash.t index 999ffc0..d75d059 100644 --- a/t/op/hash.t +++ b/t/op/hash.t @@ -129,7 +129,4 @@ $destroyed = 0; keys(%h) = 1; $h{key} = bless({}, 'Class'); } -{ - local our $TODO = "RT#67838"; - is($destroyed, 1, 'Timely hash destruction with lvalue keys'); -} +is($destroyed, 1, 'Timely hash destruction with lvalue keys'); diff --git a/t/op/pos.t b/t/op/pos.t index 2d60417..38fd034 100644 --- a/t/op/pos.t +++ b/t/op/pos.t @@ -46,7 +46,4 @@ $destroyed = 0; pos($x) = 0; $x = bless({}, 'Class'); } -{ - local $TODO = "RT#67838"; - is($destroyed, 1, 'Timely scalar destruction with lvalue pos'); -} +is($destroyed, 1, 'Timely scalar destruction with lvalue pos'); diff --git a/t/op/vec.t b/t/op/vec.t index 7fb3019..9e69c22 100644 --- a/t/op/vec.t +++ b/t/op/vec.t @@ -106,7 +106,4 @@ $destroyed = 0; vec($x,0,1) = 0; $x = bless({}, 'Class'); } -{ - local $TODO = "RT#67838"; - is($destroyed, 1, 'Timely scalar destruction with lvalue vec'); -} +is($destroyed, 1, 'Timely scalar destruction with lvalue vec'); diff --git a/t/re/substr.t b/t/re/substr.t index b136502..4f34b26 100644 --- a/t/re/substr.t +++ b/t/re/substr.t @@ -734,7 +734,4 @@ $destroyed = 0; substr($x,0,1) = ""; $x = bless({}, 'Class'); } -{ - local $TODO = "RT#67838"; - is($destroyed, 1, 'Timely scalar destruction with lvalue substr'); -} +is($destroyed, 1, 'Timely scalar destruction with lvalue substr'); -- 1.7.1.1 ```
p5pRT commented 14 years ago

From @rgarcia

On 31 July 2010 21​:27\, Eric Brine \ikegami@&#8203;adaelis\.com wrote​:

Attached are updated versions of patches submitted during the 5.12 prerelease freeze. They are rebased\, have more tests and remove a bit more dead code.

Thanks\, applied to bleadperl.

p5pRT commented 14 years ago

@rgs - Status changed from 'open' to 'resolved'