diff options
author | Father Chrysostomos <sprout@cpan.org> | 2014-11-03 18:12:02 -0800 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2014-11-03 20:16:53 -0800 |
commit | 1d5686ec7b423f88ee27ac6dfd9a6de27e442e2e (patch) | |
tree | d3cba6d4b2a989450f15dd01a7865fe85101c5aa | |
parent | 7191ba826010be5f9fb9fcf3b1127d150479a588 (diff) | |
download | perl-1d5686ec7b423f88ee27ac6dfd9a6de27e442e2e.tar.gz |
[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.
-rw-r--r-- | ext/XS-APItest/APItest.xs | 5 | ||||
-rw-r--r-- | ext/XS-APItest/t/magic.t | 4 | ||||
-rw-r--r-- | mg_raw.h | 2 | ||||
-rw-r--r-- | regen/mg_vtable.pl | 3 |
4 files changed, 12 insertions, 2 deletions
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index c5ae2becf1..8d3d23a90b 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 8451f0196a..8f1c2c409d 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; @@ -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 247423c305..7eda5e135a 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', |