In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/8c995aba0072b817ab8b2419eefed8447f6ea3aa?hp=7191ba826010be5f9fb9fcf3b1127d150479a588>
- Log ----------------------------------------------------------------- commit 8c995aba0072b817ab8b2419eefed8447f6ea3aa Author: Father Chrysostomos <[email protected]> Date: Mon Nov 3 20:12:29 2014 -0800 [perl #123103] Just set SVf_READONLY on magic vars a623f8939 was arguably a little too eager. Itâs purpose is to protect vars whose modification can causes hangs and crashes. I donât believe that is the case for any magic vars. M gv.c M t/lib/universal.t commit 1d5686ec7b423f88ee27ac6dfd9a6de27e442e2e Author: Father Chrysostomos <[email protected]> Date: Mon Nov 3 18:12:02 2014 -0800 [perl #123103] Allow ext magic on read-onlies Perl cannot know whether the magic will modify the SV, so it should give the benefit of the doubt. M ext/XS-APItest/APItest.xs M ext/XS-APItest/t/magic.t M mg_raw.h M regen/mg_vtable.pl ----------------------------------------------------------------------- Summary of changes: ext/XS-APItest/APItest.xs | 5 +++++ ext/XS-APItest/t/magic.t | 4 ++++ gv.c | 10 ++++++++++ mg_raw.h | 2 +- regen/mg_vtable.pl | 3 ++- t/lib/universal.t | 6 +++++- 6 files changed, 27 insertions(+), 3 deletions(-) diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index c5ae2be..8d3d23a 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -3779,6 +3779,11 @@ ALIAS: CODE: sv_unmagicext(SvRV(sv), PERL_MAGIC_ext, ix ? &vtbl_bar : &vtbl_foo); +void +sv_magic(SV *sv, SV *thingy) +CODE: + sv_magic(SvRV(sv), NULL, PERL_MAGIC_ext, (const char *)thingy, 0); + UV test_get_vtbl() PREINIT: diff --git a/ext/XS-APItest/t/magic.t b/ext/XS-APItest/t/magic.t index 8451f01..8f1c2c4 100644 --- a/ext/XS-APItest/t/magic.t +++ b/ext/XS-APItest/t/magic.t @@ -29,4 +29,8 @@ ok !mg_find_bar($sv), '... and bar magic is removed too'; is(test_get_vtbl(), 0, 'get_vtbl(-1) returns NULL'); +use Scalar::Util 'weaken'; +eval { sv_magic(\!0, $foo) }; +is $@, "", 'PERL_MAGIC_ext is permitted on read-only things'; + done_testing; diff --git a/gv.c b/gv.c index c8d4345..eaf9d21 100644 --- a/gv.c +++ b/gv.c @@ -1767,6 +1767,12 @@ S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len, return TRUE; } +/* gv_magicalize only turns on the SVf_READONLY flag, not SVf_PROTECT. So + redefine SvREADONLY_on for that purpose. We donât use it later on in + this file. */ +#undef SvREADONLY_on +#define SvREADONLY_on(sv) (SvFLAGS(sv) |= SVf_READONLY) + /* gv_magicalize() is called by gv_fetchpvn_flags when creating * a new GV. * Note that it does not insert the GV into the stash prior to @@ -2148,6 +2154,10 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, return addmg; } +/* If we do ever start using this later on in the file, we need to make + sure we donât accidentally use the wrong definition. */ +#undef SvREADONLY_on + /* This function is called when the stash already holds the GV of the magic * variable we're looking for, but we need to check that it has the correct * kind of magic. For example, if someone first uses $! and then %!, the diff --git a/mg_raw.h b/mg_raw.h index 3095d58..fd4a826 100644 --- a/mg_raw.h +++ b/mg_raw.h @@ -86,7 +86,7 @@ "/* lvref '\\' Lvalue reference constructor */" }, { ']', "want_vtbl_checkcall | PERL_MAGIC_VALUE_MAGIC", "/* checkcall ']' Inlining/mutation of call to this CV */" }, - { '~', "magic_vtable_max", + { '~', "magic_vtable_max | PERL_MAGIC_READONLY_ACCEPTABLE", "/* ext '~' Available for use by extensions */" }, /* ex: set ro: */ diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl index 247423c..7eda5e1 100644 --- a/regen/mg_vtable.pl +++ b/regen/mg_vtable.pl @@ -105,7 +105,8 @@ my %mg = desc => 'Extra data for restricted hashes' }, arylen_p => { char => '@', value_magic => 1, desc => 'To move arylen out of XPVAV' }, - ext => { char => '~', desc => 'Available for use by extensions' }, + ext => { char => '~', desc => 'Available for use by extensions', + readonly_acceptable => 1 }, checkcall => { char => ']', value_magic => 1, vtable => 'checkcall', desc => 'Inlining/mutation of call to this CV'}, debugvar => { char => '*', desc => '$DB::single, signal, trace vars', diff --git a/t/lib/universal.t b/t/lib/universal.t index d3510c4..3c72f32 100644 --- a/t/lib/universal.t +++ b/t/lib/universal.t @@ -6,7 +6,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl'; - plan( tests => 16 ); + plan( tests => 17 ); } for my $arg ('', 'q[]', qw( 1 undef )) { @@ -69,3 +69,7 @@ is ${\3} == 3, "1", 'attempt to modify failed'; eval { { my $x = ${qr//}; Internals::SvREADONLY $x, 1; () } }; is $@, "", 'read-only lexical regexps on scope exit [perl #115254]'; + +Internals::SvREADONLY($],0); +eval { $]=7 }; +is $], 7, 'SvREADONLY can make magic vars mutable' -- Perl5 Master Repository
