local $SIG{FOO} = sub {...}; sets signal handler to SIG_DFL #9556
Comments
From @ig3Please see attached report from perlbug. |
From @ig3To: perlbug@perl.org This is a bug report for perl from Ian.Goodacre@xtra.co.nz, ----------------------------------------------------------------- The following test program demonstrates the problem: #!/opt/perl/bin/perl print "set handler 1\n"; And the following output from strace shows SIG_DFL being set briefly write(1, "set handler 1\n", 14set handler 1 ----------------------------------------------------------------- Site configuration information for perl v5.8.8: Configured by Red Hat, Inc. at Thu Nov 8 06:48:20 EST 2007. Summary of my perl5 (revision 5 version 8 subversion 8) configuration: Locally applied patches: --- --- |
From @chipdudepatch sent to p5p |
From @chipdudeOn Wed, Nov 05, 2008 at 02:46:58PM -0800, ian.goodacre@xtra.co.nz (via RT) wrote:
The below patch fixes this bug. In the process it also partially fixes a When localizing a magical scalar for assignment, Perl has until now done an { package Foo; tie %x, 'Foo'; Released perls and blead do this: $ perl foo Whereas blead with the below patch does this: $ ./perl foo The below patch fixes this problem for hash elements and slices. However, PS: Hi, guys. Been a while. How you been? embed.fnc | 6 +++--- Inline Patchdiff --git a/embed.fnc b/embed.fnc
index c3835b3..67fd70f 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -518,7 +518,7 @@ Apd |void |sortsv_flags |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t cmp|U3
Apd |int |mg_clear |NN SV* sv
Apd |int |mg_copy |NN SV *sv|NN SV *nsv|NULLOK const char *key \
|I32 klen
-pd |void |mg_localize |NN SV* sv|NN SV* nsv
+pd |void |mg_localize |NN SV* sv|NN SV* nsv|I32 empty
ApdR |MAGIC* |mg_find |NULLOK const SV* sv|int type
Apd |int |mg_free |NN SV* sv
Apd |int |mg_get |NN SV* sv
@@ -790,7 +790,7 @@ Ap |void |save_generic_pvref|NN char** str
Ap |void |save_shared_pvref|NN char** str
Ap |void |save_gp |NN GV* gv|I32 empty
Ap |HV* |save_hash |NN GV* gv
-Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr
+Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr|I32 empty
Ap |void |save_hptr |NN HV** hptr
Ap |void |save_I16 |NN I16* intp
Ap |void |save_I32 |NN I32* intp
@@ -1550,7 +1550,7 @@ s |SV* |pm_description |NN const PMOP *pm
#endif
#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
-s |SV* |save_scalar_at |NN SV **sptr
+s |SV* |save_scalar_at |NN SV **sptr|I32 empty
#endif
#if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
diff --git a/embed.h b/embed.h
index ace2037..b7b3dbd 100644
--- a/embed.h
+++ b/embed.h
@@ -2795,7 +2795,7 @@
#define mg_clear(a) Perl_mg_clear(aTHX_ a)
#define mg_copy(a,b,c,d) Perl_mg_copy(aTHX_ a,b,c,d)
#ifdef PERL_CORE
-#define mg_localize(a,b) Perl_mg_localize(aTHX_ a,b)
+#define mg_localize(a,b,c) Perl_mg_localize(aTHX_ a,b,c)
#endif
#define mg_find(a,b) Perl_mg_find(aTHX_ a,b)
#define mg_free(a) Perl_mg_free(aTHX_ a)
@@ -3086,7 +3086,7 @@
#define save_shared_pvref(a) Perl_save_shared_pvref(aTHX_ a)
#define save_gp(a,b) Perl_save_gp(aTHX_ a,b)
#define save_hash(a) Perl_save_hash(aTHX_ a)
-#define save_helem(a,b,c) Perl_save_helem(aTHX_ a,b,c)
+#define save_helem(a,b,c,d) Perl_save_helem(aTHX_ a,b,c,d)
#define save_hptr(a) Perl_save_hptr(aTHX_ a)
#define save_I16(a) Perl_save_I16(aTHX_ a)
#define save_I32(a) Perl_save_I32(aTHX_ a)
@@ -3790,7 +3790,7 @@
#endif
#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
-#define save_scalar_at(a) S_save_scalar_at(aTHX_ a)
+#define save_scalar_at(a,b) S_save_scalar_at(aTHX_ a,b)
#endif
#endif
#if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
diff --git a/mg.c b/mg.c
index 28eb9d2..22f8c99 100644
--- a/mg.c
+++ b/mg.c
@@ -463,15 +463,19 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen)
/*
=for apidoc mg_localize
-Copy some of the magic from an existing SV to new localized version of
-that SV. Container magic (eg %ENV, $1, tie) gets copied, value magic
-doesn't (eg taint, pos).
+Copy some of the magic from an existing SV to new localized version of that
+SV. Container magic (eg %ENV, $1, tie) gets copied, value magic doesn't (eg
+taint, pos).
+
+If empty is false then no set magic will be called on the new (empty) SV.
+This typically means that assignment will soon follow (e.g. 'local $x = $y'),
+and that will handle the magic.
=cut
*/
void
-Perl_mg_localize(pTHX_ SV *sv, SV *nsv)
+Perl_mg_localize(pTHX_ SV *sv, SV *nsv, I32 empty)
{
dVAR;
MAGIC *mg;
@@ -495,9 +499,11 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv)
if (SvTYPE(nsv) >= SVt_PVMG && SvMAGIC(nsv)) {
SvFLAGS(nsv) |= SvMAGICAL(sv);
- PL_localizing = 1;
- SvSETMAGIC(nsv);
- PL_localizing = 0;
+ if (empty) {
+ PL_localizing = 1;
+ SvSETMAGIC(nsv);
+ PL_localizing = 0;
+ }
}
}
diff --git a/op.h b/op.h
index c1120f7..6729f6e 100644
--- a/op.h
+++ b/op.h
@@ -137,6 +137,9 @@ Deprecated. Use C<GIMME_V> instead.
/* On OP_SMARTMATCH, an implicit smartmatch */
/* On OP_ANONHASH and OP_ANONLIST, create a
reference to the new anon hash or array */
+ /* On OP_HELEM and OP_HSLICE, localization will be followed
+ by assignment, so do not wipe the target if it is special
+ (e.g. a glob or a magic SV) */
/* old names; don't use in new code, but don't break them, either */
#define OPf_LIST OPf_WANT_LIST
diff --git a/perlapi.c b/perlapi.c
index d15afec..19b1b3e 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -18,7 +18,9 @@
*
* Up to the threshold of the door there mounted a flight of twenty-seven
* broad stairs, hewn by some unknown art of the same black stone. This
- * was the only entrance to the tower.
+ * was the only entrance to the tower; ...
+ *
+ * [p.577 of _The Lord of the Rings_, III/x: "The Voice of Saruman"]
*
*/
diff --git a/pp.c b/pp.c
index 7fe6c8a..304e42d 100644
--- a/pp.c
+++ b/pp.c
@@ -4185,7 +4185,7 @@ PP(pp_hslice)
save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL));
else {
if (preeminent)
- save_helem(hv, keysv, svp);
+ save_helem(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL));
else {
STRLEN keylen;
const char * const key = SvPV_const(keysv, keylen);
diff --git a/pp_hot.c b/pp_hot.c
index eeedc5b..0f6243f 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1828,7 +1828,7 @@ PP(pp_helem)
SAVEDELETE(hv, savepvn(key,keylen),
SvUTF8(keysv) ? -(I32)keylen : (I32)keylen);
} else
- save_helem(hv, keysv, svp);
+ save_helem(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL));
}
}
else if (PL_op->op_private & OPpDEREF)
diff --git a/proto.h b/proto.h
index c466fba..f1f8dce 100644
--- a/proto.h
+++ b/proto.h
@@ -1848,7 +1848,7 @@ PERL_CALLCONV int Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen)
#define PERL_ARGS_ASSERT_MG_COPY \
assert(sv); assert(nsv)
-PERL_CALLCONV void Perl_mg_localize(pTHX_ SV* sv, SV* nsv)
+PERL_CALLCONV void Perl_mg_localize(pTHX_ SV* sv, SV* nsv, I32 empty)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2);
#define PERL_ARGS_ASSERT_MG_LOCALIZE \
@@ -2830,7 +2830,7 @@ PERL_CALLCONV HV* Perl_save_hash(pTHX_ GV* gv)
#define PERL_ARGS_ASSERT_SAVE_HASH \
assert(gv)
-PERL_CALLCONV void Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr)
+PERL_CALLCONV void Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr, I32 empty)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2)
__attribute__nonnull__(pTHX_3);
@@ -5498,7 +5498,7 @@ STATIC SV* S_pm_description(pTHX_ const PMOP *pm)
#endif
#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
-STATIC SV* S_save_scalar_at(pTHX_ SV **sptr)
+STATIC SV* S_save_scalar_at(pTHX_ SV **sptr, I32 empty)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_SAVE_SCALAR_AT \
assert(sptr)
diff --git a/scope.c b/scope.c
index d9dcd4a..83e8a7b 100644
--- a/scope.c
+++ b/scope.c
@@ -164,7 +164,7 @@ Perl_free_tmps(pTHX)
}
STATIC SV *
-S_save_scalar_at(pTHX_ SV **sptr)
+S_save_scalar_at(pTHX_ SV **sptr, I32 empty)
{
dVAR;
SV * const osv = *sptr;
@@ -179,7 +179,7 @@ S_save_scalar_at(pTHX_ SV **sptr)
(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
PL_tainted = oldtainted;
}
- mg_localize(osv, sv);
+ mg_localize(osv, sv, empty);
}
return sv;
}
@@ -199,7 +199,7 @@ Perl_save_scalar(pTHX_ GV *gv)
SSPUSHPTR(SvREFCNT_inc_simple(gv));
SSPUSHPTR(SvREFCNT_inc(*sptr));
SSPUSHINT(SAVEt_SV);
- return save_scalar_at(sptr);
+ return save_scalar_at(sptr, TRUE); /* XXX - FIXME - see #60360 */
}
/* Like save_sptr(), but also SvREFCNT_dec()s the new value. Can be used to
@@ -321,7 +321,7 @@ Perl_save_ary(pTHX_ GV *gv)
GvAV(gv) = NULL;
av = GvAVn(gv);
if (SvMAGIC(oav))
- mg_localize(MUTABLE_SV(oav), MUTABLE_SV(av));
+ mg_localize(MUTABLE_SV(oav), MUTABLE_SV(av), TRUE);
return av;
}
@@ -341,7 +341,7 @@ Perl_save_hash(pTHX_ GV *gv)
GvHV(gv) = NULL;
hv = GvHVn(gv);
if (SvMAGIC(ohv))
- mg_localize(MUTABLE_SV(ohv), MUTABLE_SV(hv));
+ mg_localize(MUTABLE_SV(ohv), MUTABLE_SV(hv), TRUE);
return hv;
}
@@ -611,7 +611,7 @@ Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr)
/* if it gets reified later, the restore will have the wrong refcnt */
if (!AvREAL(av) && AvREIFY(av))
SvREFCNT_inc_void(*sptr);
- save_scalar_at(sptr);
+ save_scalar_at(sptr, TRUE); /* XXX - FIXME - see #60360 */
sv = *sptr;
/* If we're localizing a tied array element, this new sv
* won't actually be stored in the array - so it won't get
@@ -622,7 +622,7 @@ Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr)
}
void
-Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr)
+Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr, I32 empty)
{
dVAR;
SV *sv;
@@ -635,7 +635,7 @@ Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr)
SSPUSHPTR(newSVsv(key));
SSPUSHPTR(SvREFCNT_inc(*sptr));
SSPUSHINT(SAVEt_HELEM);
- save_scalar_at(sptr);
+ save_scalar_at(sptr, empty);
sv = *sptr;
/* If we're localizing a tied hash element, this new sv
* won't actually be stored in the hash - so it won't get
@@ -657,7 +657,7 @@ Perl_save_svref(pTHX_ SV **sptr)
SSPUSHPTR(sptr);
SSPUSHPTR(SvREFCNT_inc(*sptr));
SSPUSHINT(SAVEt_SVREF);
- return save_scalar_at(sptr);
+ return save_scalar_at(sptr, TRUE); /* XXX - FIXME - see #60360 */
}
void
-- Chip Salzenberg <chip@pobox.com> |
|
The RT System itself - Status changed from 'new' to 'open' |
From @rgs2008/11/11 Chip Salzenberg <chip@pobox.com>:
Great fix! Thanks, applied as #34819, except the perlapi.c part, which
Hi! busy. |
|
@rgs - Status changed from 'open' to 'resolved' |
From @nwc10On Mon, Nov 10, 2008 at 04:00:40PM -0800, Chip Salzenberg wrote:
You've been doing this longer than me, so I suspect that there is a good Nicholas Clark |
From @doughera88On Mon, 10 Nov 2008, Chip Salzenberg wrote:
[. . . magic patch . . . ] Hey -- great to hear from you again! . . . and diving right into the -- |
From @mhxOn 2008-11-10, at 16:00:40 -0800, Chip Salzenberg wrote:
Nice patch, indeed. My only concern is that it changes the signature of a Marcus
-- |
From @chipdudeOn Wed, Nov 12, 2008 at 11:02:00AM +0000, Nicholas Clark wrote:
I have been doing this longer, but some of the newer remodeling is strange At first, I was >< _this_ close to using 'bool'. But then I noticed that On the other hand, that was silly. If bincompat were an issue, I would not But then, on the gripping hand: I see supposedly-internal functions like |
From @chipdudeOn Wed, Nov 12, 2008 at 07:51:39AM -0500, Andy Dougherty wrote:
It's lovely to be back. Perl is, apparently, my calling. I just wish it |
From @chipdudeOn Wed, Nov 12, 2008 at 06:00:52PM +0100, Marcus Holland-Moritz wrote:
That's a very reasonable idea for maintaining compatibility of public API |
From @obraOn Wed, Nov 12, 2008 at 11:52:47AM -0800, Chip Salzenberg wrote:
Shhh. Perl's not legal for another 5 weeks or so. (1.000 was 12-18-1987) |
From @mhxHello Chip, On 2008-11-12, at 11:55:24 -0800, Chip Salzenberg wrote:
See embed.fnc: : flags are single letters with following meanings:
It's not *binary* compat I'm concerned about, it's *source* Marcus -- |
From @chipdudeOn Wed, Nov 12, 2008 at 09:28:53PM +0100, Marcus Holland-Moritz wrote:
Ah, there it is indeed.
Indeed. But I also am trying to understand the bincompat status. |
From @nwc10On Wed, Nov 12, 2008 at 01:21:19PM -0800, Chip Salzenberg wrote:
Jarkko gave up trying to bincompat between major versions some point before I've not noticed any complaints about it not being possible, and not having The only thing I do remember is a comment by someone senior at the BBC about 1: I don't think that you're going to manage this [specifically on point 3, they seem to realise that they can budget staff time Note, I'm not suggesting that "due to the unique way it is funded" the BBC http://mail.python.org/pipermail/python-dev/2008-October/083190.html ] Nicholas Clark |
From @mhxOn 2008-11-12, at 13:21:19 -0800, Chip Salzenberg wrote:
Ok, no problem! :) Binary compat is only important within a release series, Marcus -- |
From @chipdudeOn Wed, Nov 12, 2008 at 09:44:41PM +0000, Nicholas Clark wrote:
I think that works for me. Good to know the policy in any case. I think there's a PPPort bug, though: I tried to change save_helem() from a As for the BBC asking for 5.6->5.8 bincompat:
Linux (the obvious example of big $$ in free software) has no real If people with money perceive that Perl development is a good investment,
That's comforting. >:) [1] A non-GPL'd free kernel could be coopted by Microsoft, so IBM et al are |
From @chipdudeOn Wed, Nov 12, 2008 at 02:57:43PM -0500, Jesse wrote:
Sounds like an excuse for a party. |
From @chipdudeOn Wed, Nov 12, 2008 at 02:31:35PM -0800, Chip Salzenberg wrote:
Here is an update to my previous patch, taking into account Marcus's 1. Source compatibility of the public API is restored. 2. The new boolean parameter to mg_localize() is now, in fact, a 'bool'. 3. A flags argument is passed through several save-ish functions; the only Share & Enjoy! Inline Patchdiff --git a/embed.fnc b/embed.fnc
index 67fd70f..7d0f681 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -518,7 +518,7 @@ Apd |void |sortsv_flags |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t cmp|U3
Apd |int |mg_clear |NN SV* sv
Apd |int |mg_copy |NN SV *sv|NN SV *nsv|NULLOK const char *key \
|I32 klen
-pd |void |mg_localize |NN SV* sv|NN SV* nsv|I32 empty
+pd |void |mg_localize |NN SV* sv|NN SV* nsv|bool setmagic
ApdR |MAGIC* |mg_find |NULLOK const SV* sv|int type
Apd |int |mg_free |NN SV* sv
Apd |int |mg_get |NN SV* sv
@@ -790,7 +790,8 @@ Ap |void |save_generic_pvref|NN char** str
Ap |void |save_shared_pvref|NN char** str
Ap |void |save_gp |NN GV* gv|I32 empty
Ap |HV* |save_hash |NN GV* gv
-Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr|I32 empty
+Amp |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr
+Ap |void |save_helem_flags|NN HV *hv|NN SV *key|NN SV **sptr|const U32 flags
Ap |void |save_hptr |NN HV** hptr
Ap |void |save_I16 |NN I16* intp
Ap |void |save_I32 |NN I32* intp
@@ -1550,7 +1551,7 @@ s |SV* |pm_description |NN const PMOP *pm
#endif
#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
-s |SV* |save_scalar_at |NN SV **sptr|I32 empty
+s |SV* |save_scalar_at |NN SV **sptr|const U32 flags
#endif
#if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
diff --git a/embed.h b/embed.h
index b7b3dbd..d246290 100644
--- a/embed.h
+++ b/embed.h
@@ -770,7 +770,7 @@
#define save_shared_pvref Perl_save_shared_pvref
#define save_gp Perl_save_gp
#define save_hash Perl_save_hash
-#define save_helem Perl_save_helem
+#define save_helem_flags Perl_save_helem_flags
#define save_hptr Perl_save_hptr
#define save_I16 Perl_save_I16
#define save_I32 Perl_save_I32
@@ -3086,7 +3086,7 @@
#define save_shared_pvref(a) Perl_save_shared_pvref(aTHX_ a)
#define save_gp(a,b) Perl_save_gp(aTHX_ a,b)
#define save_hash(a) Perl_save_hash(aTHX_ a)
-#define save_helem(a,b,c,d) Perl_save_helem(aTHX_ a,b,c,d)
+#define save_helem_flags(a,b,c,d) Perl_save_helem_flags(aTHX_ a,b,c,d)
#define save_hptr(a) Perl_save_hptr(aTHX_ a)
#define save_I16(a) Perl_save_I16(aTHX_ a)
#define save_I32(a) Perl_save_I32(aTHX_ a)
diff --git a/global.sym b/global.sym
index 5e18194..90f9102 100644
--- a/global.sym
+++ b/global.sym
@@ -450,7 +450,7 @@ Perl_save_generic_pvref
Perl_save_shared_pvref
Perl_save_gp
Perl_save_hash
-Perl_save_helem
+Perl_save_helem_flags
Perl_save_hptr
Perl_save_I16
Perl_save_I32
diff --git a/mg.c b/mg.c
index 22f8c99..a9cffbf 100644
--- a/mg.c
+++ b/mg.c
@@ -467,7 +467,7 @@ Copy some of the magic from an existing SV to new localized version of that
SV. Container magic (eg %ENV, $1, tie) gets copied, value magic doesn't (eg
taint, pos).
-If empty is false then no set magic will be called on the new (empty) SV.
+If setmagic is false then no set magic will be called on the new (empty) SV.
This typically means that assignment will soon follow (e.g. 'local $x = $y'),
and that will handle the magic.
@@ -475,7 +475,7 @@ and that will handle the magic.
*/
void
-Perl_mg_localize(pTHX_ SV *sv, SV *nsv, I32 empty)
+Perl_mg_localize(pTHX_ SV *sv, SV *nsv, bool setmagic)
{
dVAR;
MAGIC *mg;
@@ -499,7 +499,7 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv, I32 empty)
if (SvTYPE(nsv) >= SVt_PVMG && SvMAGIC(nsv)) {
SvFLAGS(nsv) |= SvMAGICAL(sv);
- if (empty) {
+ if (setmagic) {
PL_localizing = 1;
SvSETMAGIC(nsv);
PL_localizing = 0;
diff --git a/pp.c b/pp.c
index 304e42d..739a457 100644
--- a/pp.c
+++ b/pp.c
@@ -4185,7 +4185,8 @@ PP(pp_hslice)
save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL));
else {
if (preeminent)
- save_helem(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL));
+ save_helem_flags(hv, keysv, svp,
+ (PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC);
else {
STRLEN keylen;
const char * const key = SvPV_const(keysv, keylen);
diff --git a/pp_hot.c b/pp_hot.c
index 0f6243f..9615c46 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1828,7 +1828,8 @@ PP(pp_helem)
SAVEDELETE(hv, savepvn(key,keylen),
SvUTF8(keysv) ? -(I32)keylen : (I32)keylen);
} else
- save_helem(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL));
+ save_helem_flags(hv, keysv, svp,
+ (PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC);
}
}
else if (PL_op->op_private & OPpDEREF)
diff --git a/proto.h b/proto.h
index f1f8dce..c8e7f6f 100644
--- a/proto.h
+++ b/proto.h
@@ -1848,7 +1848,7 @@ PERL_CALLCONV int Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen)
#define PERL_ARGS_ASSERT_MG_COPY \
assert(sv); assert(nsv)
-PERL_CALLCONV void Perl_mg_localize(pTHX_ SV* sv, SV* nsv, I32 empty)
+PERL_CALLCONV void Perl_mg_localize(pTHX_ SV* sv, SV* nsv, bool setmagic)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2);
#define PERL_ARGS_ASSERT_MG_LOCALIZE \
@@ -2830,13 +2830,20 @@ PERL_CALLCONV HV* Perl_save_hash(pTHX_ GV* gv)
#define PERL_ARGS_ASSERT_SAVE_HASH \
assert(gv)
-PERL_CALLCONV void Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr, I32 empty)
+/* PERL_CALLCONV void Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2)
- __attribute__nonnull__(pTHX_3);
+ __attribute__nonnull__(pTHX_3); */
#define PERL_ARGS_ASSERT_SAVE_HELEM \
assert(hv); assert(key); assert(sptr)
+PERL_CALLCONV void Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags)
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2)
+ __attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS \
+ assert(hv); assert(key); assert(sptr)
+
PERL_CALLCONV void Perl_save_hptr(pTHX_ HV** hptr)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_SAVE_HPTR \
@@ -5498,7 +5505,7 @@ STATIC SV* S_pm_description(pTHX_ const PMOP *pm)
#endif
#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
-STATIC SV* S_save_scalar_at(pTHX_ SV **sptr, I32 empty)
+STATIC SV* S_save_scalar_at(pTHX_ SV **sptr, const U32 flags)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_SAVE_SCALAR_AT \
assert(sptr)
diff --git a/scope.c b/scope.c
index 83e8a7b..20cf6fc 100644
--- a/scope.c
+++ b/scope.c
@@ -164,7 +164,7 @@ Perl_free_tmps(pTHX)
}
STATIC SV *
-S_save_scalar_at(pTHX_ SV **sptr, I32 empty)
+S_save_scalar_at(pTHX_ SV **sptr, const U32 flags)
{
dVAR;
SV * const osv = *sptr;
@@ -179,7 +179,7 @@ S_save_scalar_at(pTHX_ SV **sptr, I32 empty)
(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
PL_tainted = oldtainted;
}
- mg_localize(osv, sv, empty);
+ mg_localize(osv, sv, (flags & SAVEf_SETMAGIC) != 0);
}
return sv;
}
@@ -199,7 +199,7 @@ Perl_save_scalar(pTHX_ GV *gv)
SSPUSHPTR(SvREFCNT_inc_simple(gv));
SSPUSHPTR(SvREFCNT_inc(*sptr));
SSPUSHINT(SAVEt_SV);
- return save_scalar_at(sptr, TRUE); /* XXX - FIXME - see #60360 */
+ return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
}
/* Like save_sptr(), but also SvREFCNT_dec()s the new value. Can be used to
@@ -611,7 +611,7 @@ Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr)
/* if it gets reified later, the restore will have the wrong refcnt */
if (!AvREAL(av) && AvREIFY(av))
SvREFCNT_inc_void(*sptr);
- save_scalar_at(sptr, TRUE); /* XXX - FIXME - see #60360 */
+ save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
sv = *sptr;
/* If we're localizing a tied array element, this new sv
* won't actually be stored in the array - so it won't get
@@ -622,7 +622,7 @@ Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr)
}
void
-Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr, I32 empty)
+Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags)
{
dVAR;
SV *sv;
@@ -635,7 +635,7 @@ Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr, I32 empty)
SSPUSHPTR(newSVsv(key));
SSPUSHPTR(SvREFCNT_inc(*sptr));
SSPUSHINT(SAVEt_HELEM);
- save_scalar_at(sptr, empty);
+ save_scalar_at(sptr, flags);
sv = *sptr;
/* If we're localizing a tied hash element, this new sv
* won't actually be stored in the hash - so it won't get
@@ -657,7 +657,7 @@ Perl_save_svref(pTHX_ SV **sptr)
SSPUSHPTR(sptr);
SSPUSHPTR(SvREFCNT_inc(*sptr));
SSPUSHINT(SAVEt_SVREF);
- return save_scalar_at(sptr, TRUE); /* XXX - FIXME - see #60360 */
+ return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
}
void
diff --git a/scope.h b/scope.h
index 25ccbf6..c1fa4f9 100644
--- a/scope.h
+++ b/scope.h
@@ -55,6 +55,10 @@
#define SAVEt_STACK_CXPOS 44
#define SAVEt_PARSER 45
+#define SAVEf_SETMAGIC 1
+
+#define save_helem(hv,key,sptr) save_helem_flags(hv,key,sptr,SAVEf_SETMAGIC)
+
#ifndef SCOPE_SAVES_SIGNAL_MASK
#define SCOPE_SAVES_SIGNAL_MASK 0
#endif
--
Chip Salzenberg <chip@pobox.com> |
From @mhxOn 2008-11-12, at 14:31:35 -0800, Chip Salzenberg wrote:
Mmmh. Precise description of the problem... ;) Do you have a patch with the changes you made that caused I see no reason for this not to work (in any case), so if it However: 1) I can't think of a way to make D::PPP fail by such a change 2) It works fine for me with the changes below and of course a 3) I don't think "Amp" is a valid combination of flags, as
No need to! I think using a macro wrapper is just fine. Marcus Inline Patchdiff -ruN perl-current-orig/embed.fnc perl-current/embed.fnc
--- perl-current-orig/embed.fnc 2008-11-12 11:38:53.000000000 +0100
+++ perl-current/embed.fnc 2008-11-13 05:58:36.000000000 +0100
@@ -790,7 +790,8 @@
Ap |void |save_shared_pvref|NN char** str
Ap |void |save_gp |NN GV* gv|I32 empty
Ap |HV* |save_hash |NN GV* gv
-Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr|I32 empty
+Ap |void |save_helem_flags |NN HV *hv|NN SV *key|NN SV **sptr|I32 empty
+Amp |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr
Ap |void |save_hptr |NN HV** hptr
Ap |void |save_I16 |NN I16* intp
Ap |void |save_I32 |NN I32* intp
--- perl-current-orig/pp.c 2008-11-12 11:38:53.000000000 +0100
+++ perl-current/pp.c 2008-11-13 05:59:49.000000000 +0100
@@ -4185,7 +4185,7 @@
save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL));
else {
if (preeminent)
- save_helem(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL));
+ save_helem_flags(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL));
else {
STRLEN keylen;
const char * const key = SvPV_const(keysv, keylen);
diff -ruN perl-current-orig/pp_hot.c perl-current/pp_hot.c
--- perl-current-orig/pp_hot.c 2008-11-12 11:38:53.000000000 +0100
+++ perl-current/pp_hot.c 2008-11-13 05:59:42.000000000 +0100
@@ -1828,7 +1828,7 @@
SAVEDELETE(hv, savepvn(key,keylen),
SvUTF8(keysv) ? -(I32)keylen : (I32)keylen);
} else
- save_helem(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL));
+ save_helem_flags(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL));
}
}
else if (PL_op->op_private & OPpDEREF)
--- perl-current-orig/scope.c 2008-11-12 11:38:53.000000000 +0100
+++ perl-current/scope.c 2008-11-13 05:59:03.000000000 +0100
@@ -622,12 +622,12 @@
}
void
-Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr, I32 empty)
+Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, I32 empty)
{
dVAR;
SV *sv;
- PERL_ARGS_ASSERT_SAVE_HELEM;
+ PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS;
SvGETMAGIC(*sptr);
SSCHECK(4);
diff -ruN perl-current-orig/scope.h perl-current/scope.h
--- perl-current-orig/scope.h 2008-10-28 19:35:27.000000000 +0100
+++ perl-current/scope.h 2008-11-13 06:00:38.000000000 +0100
@@ -256,6 +256,8 @@
#define SSPTR(off,type) ((type) ((char*)PL_savestack + off))
#define SSPTRt(off,type) ((type*) ((char*)PL_savestack + off))
+#define save_helem(a, b, c) Perl_save_helem_flags(aTHX_ a, b, c, FALSE)
+
/*
* Local variables:
* c-indentation-style: bsd |
From @mhxOn 2008-11-12, at 15:45:04 -0800, Chip Salzenberg wrote:
When do I learn to read *all* email first before starting to
Great, thanks! Applied as #34829 with a minor tweak (fixing Marcus -- |
Migrated from rt.perl.org#60360 (status was 'resolved')
Searchable as RT60360$
The text was updated successfully, but these errors were encountered: