Change 34819 by [EMAIL PROTECTED] on 2008/11/12 10:37:46
Subject: Re: [perl #60360] [PATCH] local $SIG{FOO} = sub {...}; sets
signal
From: Chip Salzenberg <[EMAIL PROTECTED]>
Date: Mon, 10 Nov 2008 16:00:40 -0800
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/embed.fnc#629 edit
... //depot/perl/embed.h#766 edit
... //depot/perl/mg.c#541 edit
... //depot/perl/op.h#214 edit
... //depot/perl/pp.c#642 edit
... //depot/perl/pp_hot.c#589 edit
... //depot/perl/proto.h#964 edit
... //depot/perl/scope.c#233 edit
Differences ...
==== //depot/perl/embed.fnc#629 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#628~34673~ 2008-10-30 15:27:16.000000000 -0700
+++ perl/embed.fnc 2008-11-12 02:37:46.000000000 -0800
@@ -518,7 +518,7 @@
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_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 @@
#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)
==== //depot/perl/embed.h#766 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#765~34586~ 2008-10-25 05:47:01.000000000 -0700
+++ perl/embed.h 2008-11-12 02:37:46.000000000 -0800
@@ -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)
==== //depot/perl/mg.c#541 (text) ====
Index: perl/mg.c
--- perl/mg.c#540~34698~ 2008-11-02 13:12:59.000000000 -0800
+++ perl/mg.c 2008-11-12 02:37:46.000000000 -0800
@@ -463,15 +463,19 @@
/*
=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 @@
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;
+ }
}
}
==== //depot/perl/op.h#214 (text) ====
Index: perl/op.h
--- perl/op.h#213~34605~ 2008-10-27 13:25:46.000000000 -0700
+++ perl/op.h 2008-11-12 02:37:46.000000000 -0800
@@ -137,6 +137,9 @@
/* 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
==== //depot/perl/pp.c#642 (text) ====
Index: perl/pp.c
--- perl/pp.c#641~34698~ 2008-11-02 13:12:59.000000000 -0800
+++ perl/pp.c 2008-11-12 02:37:46.000000000 -0800
@@ -4185,7 +4185,7 @@
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);
==== //depot/perl/pp_hot.c#589 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#588~34776~ 2008-11-08 04:38:36.000000000 -0800
+++ perl/pp_hot.c 2008-11-12 02:37:46.000000000 -0800
@@ -1828,7 +1828,7 @@
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)
==== //depot/perl/proto.h#964 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#963~34673~ 2008-10-30 15:27:16.000000000 -0700
+++ perl/proto.h 2008-11-12 02:37:46.000000000 -0800
@@ -1848,7 +1848,7 @@
#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 @@
#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 @@
#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)
==== //depot/perl/scope.c#233 (text) ====
Index: perl/scope.c
--- perl/scope.c#232~34698~ 2008-11-02 13:12:59.000000000 -0800
+++ perl/scope.c 2008-11-12 02:37:46.000000000 -0800
@@ -164,7 +164,7 @@
}
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 @@
(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 @@
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 @@
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 @@
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 @@
/* 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 @@
}
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 @@
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 @@
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
End of Patch.
