In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/80c1439ffbd799a82c109d650c32e9ecc7a3eb26?hp=8e21c40378fa83db73acbf74b1cb99ac60432ee8>
- Log ----------------------------------------------------------------- commit 80c1439ffbd799a82c109d650c32e9ecc7a3eb26 Author: David Mitchell <[email protected]> Date: Fri Nov 4 15:42:37 2016 +0000 call AV set magic in list assign RT #129996 Perl used to do this, but I broke it with my recent commit v5.25.6-78-g8b0c337. Normally if @a has set magic, then that magic gets called for each av_store() call; e.g. in @a = (1,2,3), the magic should get called 3 times. I broke that because I was checking for SVs_RMG rather than SVs_SMG, and it so happens that no core code sets SVs_SMG on an AV without setting SVs_RMG too. However, code such as Tk (which use PERL_MAGIC_ext magic), does. This commit re-instates the AV behaviour. Oddly enough, hv_store_ent() etc *don't* call HV set magic. I've added some tests for that, but marked them TODO because I'm not sure what the correct behaviour should be. ----------------------------------------------------------------------- Summary of changes: ext/XS-APItest/APItest.pm | 2 +- ext/XS-APItest/APItest.xs | 24 ++++++++++++++++++++++++ ext/XS-APItest/t/magic.t | 29 +++++++++++++++++++++++++++++ pp_hot.c | 2 +- 4 files changed, 55 insertions(+), 2 deletions(-) diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index 64a25f1..473d4a3 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Carp; -our $VERSION = '0.86'; +our $VERSION = '0.87'; require XSLoader; diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 6dbb297..bb7d865 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -93,7 +93,19 @@ typedef struct { START_MY_CXT +int +S_myset_set(pTHX_ SV* sv, MAGIC* mg) +{ + SV *isv = (SV*)mg->mg_ptr; + + PERL_UNUSED_ARG(sv); + SvIVX(isv)++; + return 0; +} + MGVTBL vtbl_foo, vtbl_bar; +MGVTBL vtbl_myset = { 0, S_myset_set, 0, 0, 0, 0, 0, 0 }; + /* indirect functions to test the [pa]MY_CXT macros */ @@ -4339,6 +4351,18 @@ test_get_vtbl() OUTPUT: RETVAL + + # attach ext magic to the SV pointed to by rsv that only has set magic, + # where that magic's job is to increment thingy + +void +sv_magic_myset(SV *rsv, SV *thingy) +CODE: + sv_magicext(SvRV(rsv), NULL, PERL_MAGIC_ext, &vtbl_myset, + (const char *)thingy, 0); + + + bool test_isBLANK_uni(UV ord) CODE: diff --git a/ext/XS-APItest/t/magic.t b/ext/XS-APItest/t/magic.t index 8f1c2c4..e47cd88 100644 --- a/ext/XS-APItest/t/magic.t +++ b/ext/XS-APItest/t/magic.t @@ -33,4 +33,33 @@ use Scalar::Util 'weaken'; eval { sv_magic(\!0, $foo) }; is $@, "", 'PERL_MAGIC_ext is permitted on read-only things'; +# assigning to an array/hash with only set magic should call that magic + +{ + my (@a, %h, $i); + + sv_magic_myset(\@a, $i); + sv_magic_myset(\%h, $i); + + $i = 0; + @a = (1,2); + is($i, 2, "array with set magic"); + + $i = 0; + @a = (); + is($i, 0, "array () with set magic"); + + { + local $TODO = "HVs don't call set magic - not sure if should"; + + $i = 0; + %h = qw(a 1 b 2); + is($i, 4, "hash with set magic"); + } + + $i = 0; + %h = qw(); + is($i, 0, "hash () with set magic"); +} + done_testing; diff --git a/pp_hot.c b/pp_hot.c index 3db6f5d..2731796 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1456,7 +1456,7 @@ PP(pp_aassign) tmps_base -= nelems; - if (SvRMAGICAL(ary) || SvREADONLY(ary) || !AvREAL(ary)) { + if (SvMAGICAL(ary) || SvREADONLY(ary) || !AvREAL(ary)) { /* for arrays we can't cheat with, use the official API */ av_extend(ary, nelems - 1); for (i = 0; i < nelems; i++) { -- Perl5 Master Repository
