Re: [perl #60360] [PATCH] local $SIG{FOO} = sub {...}; sets signal

Message-ID: <20081111000040.GB19329@tytlal.topaz.cx>

p4raw-id: //depot/perl@34819

diff --git a/embed.fnc b/embed.fnc
index c3835b3..67fd70f 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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/pp.c b/pp.c
index 7fe6c8a..304e42d 100644 (file)
--- 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 6450e25..4624fbb 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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