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.

diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm
index 64a25f1..473d4a3 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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++) {