Change 33458 by [EMAIL PROTECTED] on 2008/03/10 12:56:41
Subject: Re: [PATCH] mg_magical() sometimes turns SvRMAGICAL on when it
shouldn't
From: Vincent Pit <[EMAIL PROTECTED]>
Date: Fri, 08 Feb 2008 23:22:19 +0100
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/MANIFEST#1684 edit
... //depot/perl/ext/XS/APItest/APItest.pm#22 edit
... //depot/perl/ext/XS/APItest/APItest.xs#44 edit
... //depot/perl/ext/XS/APItest/t/rmagical.t#1 add
... //depot/perl/mg.c#522 edit
Differences ...
==== //depot/perl/MANIFEST#1684 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#1683~33416~ 2008-03-03 07:48:45.000000000 -0800
+++ perl/MANIFEST 2008-03-10 05:56:41.000000000 -0700
@@ -1259,6 +1259,7 @@
ext/XS/APItest/t/op.t XS::APItest: tests for OP related APIs
ext/XS/APItest/t/printf.t XS::APItest extension
ext/XS/APItest/t/push.t XS::APItest extension
+ext/XS/APItest/t/rmagical.t XS::APItest extension
ext/XS/APItest/t/svsetsv.t Test behaviour of sv_setsv with/without
PERL_CORE
ext/XS/APItest/t/xs_special_subs_require.t for require too
ext/XS/APItest/t/xs_special_subs.t Test that XS BEGIN/CHECK/INIT/END work
==== //depot/perl/ext/XS/APItest/APItest.pm#22 (text) ====
Index: perl/ext/XS/APItest/APItest.pm
--- perl/ext/XS/APItest/APItest.pm#21~33023~ 2008-01-21 03:48:22.000000000
-0800
+++ perl/ext/XS/APItest/APItest.pm 2008-03-10 05:56:41.000000000 -0700
@@ -22,9 +22,10 @@
apitest_exception mycroak strtab
my_cxt_getint my_cxt_getsv my_cxt_setint my_cxt_setsv
sv_setsv_cow_hashkey_core sv_setsv_cow_hashkey_notcore
+ rmagical_cast rmagical_flags
);
-our $VERSION = '0.13';
+our $VERSION = '0.14';
use vars '$WARNINGS_ON_BOOTSTRAP';
use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);
==== //depot/perl/ext/XS/APItest/APItest.xs#44 (text) ====
Index: perl/ext/XS/APItest/APItest.xs
--- perl/ext/XS/APItest/APItest.xs#43~32699~ 2007-12-22 03:28:02.000000000
-0800
+++ perl/ext/XS/APItest/APItest.xs 2008-03-10 05:56:41.000000000 -0700
@@ -233,6 +233,13 @@
return 0;
}
+STATIC I32
+rmagical_a_dummy(pTHX_ IV idx, SV *sv) {
+ return 0;
+}
+
+STATIC MGVTBL rmagical_b = { 0 };
+
#include "const-c.inc"
MODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash
@@ -813,6 +820,38 @@
sv_setsv_cow_hashkey_notcore()
void
+rmagical_cast(sv, type)
+ SV *sv;
+ SV *type;
+ PREINIT:
+ struct ufuncs uf;
+ PPCODE:
+ if (!SvOK(sv) || !SvROK(sv) || !SvOK(type)) { XSRETURN_UNDEF; }
+ sv = SvRV(sv);
+ if (SvTYPE(sv) != SVt_PVHV) { XSRETURN_UNDEF; }
+ uf.uf_val = rmagical_a_dummy;
+ uf.uf_set = NULL;
+ uf.uf_index = 0;
+ if (SvTRUE(type)) { /* b */
+ sv_magicext(sv, NULL, PERL_MAGIC_ext, &rmagical_b, NULL, 0);
+ } else { /* a */
+ sv_magic(sv, NULL, PERL_MAGIC_uvar, (char *) &uf, sizeof(uf));
+ }
+ XSRETURN_YES;
+
+void
+rmagical_flags(sv)
+ SV *sv;
+ PPCODE:
+ if (!SvOK(sv) || !SvROK(sv)) { XSRETURN_UNDEF; }
+ sv = SvRV(sv);
+ EXTEND(SP, 3);
+ mXPUSHu(SvFLAGS(sv) & SVs_GMG);
+ mXPUSHu(SvFLAGS(sv) & SVs_SMG);
+ mXPUSHu(SvFLAGS(sv) & SVs_RMG);
+ XSRETURN(3);
+
+void
BEGIN()
CODE:
sv_inc(get_sv("XS::APItest::BEGIN_called", GV_ADD|GV_ADDMULTI));
==== //depot/perl/ext/XS/APItest/t/rmagical.t#1 (text) ====
Index: perl/ext/XS/APItest/t/rmagical.t
--- /dev/null 2008-03-09 13:42:05.565441741 -0700
+++ perl/ext/XS/APItest/t/rmagical.t 2008-03-10 05:56:41.000000000 -0700
@@ -0,0 +1,29 @@
+#!perl
+
+# Consider two kinds of magic :
+# A : PERL_MAGIC_uvar, with get (but no set) magic
+# B : PERL_MAGIC_ext, with a zero vtbl
+# If those magic are attached on a sv in such a way that the MAGIC chain
+# looks like sv -> B -> A -> NULL (i.e. we first apply A and then B), then
+# mg_magical won't turn SvRMAGICAL on. However, if the chain is in the
+# opposite order (sv -> A -> B -> NULL), SvRMAGICAL used to be turned on.
+
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+use_ok('XS::APItest');
+
+my (%h1, %h2);
+my @f;
+
+rmagical_cast(\%h1, 0); # A
+rmagical_cast(\%h1, 1); # B
[EMAIL PROTECTED] = rmagical_flags(\%h1);
+ok(!$f[2], "For sv -> B -> A -> NULL, SvRMAGICAL(sv) is false");
+
+rmagical_cast(\%h2, 1); # B
+rmagical_cast(\%h2, 0); # A
[EMAIL PROTECTED] = rmagical_flags(\%h2);
+ok(!$f[2], "For sv -> A -> B -> NULL, SvRMAGICAL(sv) is false");
==== //depot/perl/mg.c#522 (text) ====
Index: perl/mg.c
--- perl/mg.c#521~33291~ 2008-02-12 05:15:20.000000000 -0800
+++ perl/mg.c 2008-03-10 05:56:41.000000000 -0700
@@ -123,16 +123,21 @@
const MAGIC* mg;
PERL_ARGS_ASSERT_MG_MAGICAL;
PERL_UNUSED_CONTEXT;
- for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
- const MGVTBL* const vtbl = mg->mg_virtual;
- if (vtbl) {
- if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
- SvGMAGICAL_on(sv);
- if (vtbl->svt_set)
- SvSMAGICAL_on(sv);
- if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
- SvRMAGICAL_on(sv);
- }
+ if ((mg = SvMAGIC(sv))) {
+ SvRMAGICAL_off(sv);
+ do {
+ const MGVTBL* const vtbl = mg->mg_virtual;
+ if (vtbl) {
+ if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
+ SvGMAGICAL_on(sv);
+ if (vtbl->svt_set)
+ SvSMAGICAL_on(sv);
+ if (vtbl->svt_clear)
+ SvRMAGICAL_on(sv);
+ }
+ } while ((mg = mg->mg_moremagic));
+ if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)))
+ SvRMAGICAL_on(sv);
}
}
End of Patch.
