In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/654c723fd377eb0d22b2bff31f08cbc7db15dcaa?hp=a9a249629c8a321606e6b817e73a8f8a2c0ae36f>
- Log ----------------------------------------------------------------- commit 654c723fd377eb0d22b2bff31f08cbc7db15dcaa Author: Father Chrysostomos <[email protected]> Date: Sun Jan 22 22:58:58 2012 -0800 sv.c:sv_utf8_encode: simplify code sv_force_normal already croaks for read-only variables M sv.c commit 18984c14b373cb9ef631091f5c5e151e9b0971f0 Author: Father Chrysostomos <[email protected]> Date: Sun Jan 22 22:56:50 2012 -0800 universal.c:XS_utf8_decode: rmv redundant code SvPV_force_nolen already calls sv_force_normal for us. M universal.c commit 6dd7c1f1e9477c302194505f6e1aaa57121f68bd Author: Father Chrysostomos <[email protected]> Date: Sun Jan 22 22:48:42 2012 -0800 Donât allow read-only regexps to be tied Since the test triggered another bug in freeing read-only regexps, this commit fixes that too. M sv.c M t/op/tie.t ----------------------------------------------------------------------- Summary of changes: sv.c | 9 +++------ t/op/tie.t | 10 ++++++++++ universal.c | 1 - 3 files changed, 13 insertions(+), 7 deletions(-) diff --git a/sv.c b/sv.c index 3736e27..c1ece77 100644 --- a/sv.c +++ b/sv.c @@ -3521,11 +3521,8 @@ Perl_sv_utf8_encode(pTHX_ register SV *const sv) { PERL_ARGS_ASSERT_SV_UTF8_ENCODE; - if (SvIsCOW(sv)) { - sv_force_normal_flags(sv, 0); - } if (SvREADONLY(sv)) { - Perl_croak_no_modify(aTHX); + sv_force_normal_flags(sv, 0); } (void) sv_utf8_upgrade(sv); SvUTF8_off(sv); @@ -5310,7 +5307,7 @@ Perl_sv_magic(pTHX_ register SV *const sv, SV *const obj, const int how, if (SvREADONLY(sv)) { if ( /* its okay to attach magic to shared strings */ - (!SvFAKE(sv) || isGV_with_GP(sv)) + !SvIsCOW(sv) && IN_PERL_RUNTIME && !PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(how) @@ -6191,7 +6188,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv) && !(SvTYPE(sv) == SVt_PVIO && !(IoFLAGS(sv) & IOf_FAKE_DIRP))) Safefree(SvPVX_mutable(sv)); - else if (SvPVX_const(sv) && SvREADONLY(sv) && SvFAKE(sv)) { + else if (SvPVX_const(sv) && SvIsCOW(sv)) { unshare_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv))); SvFAKE_off(sv); } diff --git a/t/op/tie.t b/t/op/tie.t index b333129..9301bb3 100644 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -1030,6 +1030,16 @@ ok Modification of a read-only value attempted at - line 16. ######## +# Similarly, read-only regexps cannot be tied. +sub TIESCALAR { bless [] } +$y = ${qr//}; +Internals::SvREADONLY($y,1); +tie $y, ""; + +EXPECT +Modification of a read-only value attempted at - line 6. +######## + # tied() should still work on tied scalars after glob assignment sub TIESCALAR {bless[]} sub FETCH {*foo} diff --git a/universal.c b/universal.c index f6da76d..463651b 100644 --- a/universal.c +++ b/universal.c @@ -812,7 +812,6 @@ XS(XS_utf8_decode) else { SV * const sv = ST(0); bool RETVAL; - if (SvREADONLY(sv)) sv_force_normal(sv); SvPV_force_nolen(sv); RETVAL = sv_utf8_decode(sv); ST(0) = boolSV(RETVAL); -- Perl5 Master Repository
