Give PerlIO::via its own Maintainers.pl entry

[perl5.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index 740cfb0..f8a61cb 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -665,7 +665,7 @@ PP(pp_aelemfast)
 {
     dVAR; dSP;
     AV * const av = PL_op->op_flags & OPf_SPECIAL
-       ? MUTABLE_AV(PAD_SV(PL_op->op_targ)) : GvAV(cGVOP_gv);
+       ? MUTABLE_AV(PAD_SV(PL_op->op_targ)) : GvAVn(cGVOP_gv);
     const U32 lval = PL_op->op_flags & OPf_MOD;
     SV** const svp = av_fetch(av, PL_op->op_private, lval);
     SV *sv = (svp ? *svp : &PL_sv_undef);
@@ -989,8 +989,19 @@ PP(pp_aassign)
     /* If there's a common identifier on both sides we have to take
      * special care that assigning the identifier on the left doesn't
      * clobber a value on the right that's used later in the list.
+     * Don't bother if LHS is just an empty hash or array.
      */
-    if (PL_op->op_private & (OPpASSIGN_COMMON)) {
+
+    if (    (PL_op->op_private & OPpASSIGN_COMMON)
+       &&  (
+              firstlelem != lastlelem
+           || ! ((sv = *firstlelem))
+           || SvMAGICAL(sv)
+           || ! (SvTYPE(sv) == SVt_PVAV || SvTYPE(sv) == SVt_PVHV)
+           || (SvTYPE(sv) == SVt_PVAV && AvFILL((AV*)sv) != -1)
+           || (SvTYPE(sv) == SVt_PVHV && HvKEYS((HV*)sv) != 0)
+           )
+    ) {
        EXTEND_MORTAL(lastrelem - firstrelem + 1);
        for (relem = firstrelem; relem <= lastrelem; relem++) {
            if ((sv = *relem)) {
@@ -1235,8 +1246,10 @@ PP(pp_qr)
        (void)sv_bless(rv, stash);
     }
 
-    if (RX_EXTFLAGS(rx) & RXf_TAINTED)
+    if (RX_EXTFLAGS(rx) & RXf_TAINTED) {
         SvTAINTED_on(rv);
+        SvTAINTED_on(SvRV(rv));
+    }
     XPUSHs(rv);
     RETURN;
 }
@@ -2059,18 +2072,19 @@ PP(pp_iter)
 /*
 A description of how taint works in pattern matching and substitution.
 
-While the pattern is being assembled and them compiled, PL_tainted will
-get set if any part of the pattern is tainted, e.g. qr/.*$tainted/.
-At the end of pattern compilation, the RXf_TAINTED flag is set on the
-pattern if PL_tainted is set.
+While the pattern is being assembled/concatenated and them compiled,
+PL_tainted will get set if any component of the pattern is tainted, e.g.
+/.*$tainted/.  At the end of pattern compilation, the RXf_TAINTED flag
+is set on the pattern if PL_tainted is set.
 
-When the pattern is copied, e.g. $r = qr/..../, the SV holding the ref the
-pattern is marked as tainted. This means that subsequent usage, such as
-/x$r/, will set PL_tainted and thus RXf_TAINTED on the new pattern too.
+When the pattern is copied, e.g. $r = qr/..../, the SV holding the ref to
+the pattern is marked as tainted. This means that subsequent usage, such
+as /x$r/, will set PL_tainted, and thus RXf_TAINTED, on the new pattern too.
 
 During execution of a pattern, locale-variant ops such as ALNUML set the
 local flag RF_tainted. At the end of execution, the engine sets the
-RXf_TAINTED_SEEN on the pattern if RF_tainted got set.
+RXf_TAINTED_SEEN on the pattern if RF_tainted got set, or clears it
+otherwise.
 
 In addition, RXf_TAINTED_SEEN is used post-execution by the get magic code
 of $1 et al to indicate whether the returned value should be tainted.
@@ -2115,8 +2129,8 @@ The overall action of pp_subst is:
     * Whenever control is being returned to perl code (either by falling
        off the "end" of pp_subst/pp_substcont, or by entering a /e block),
        use the flag bits in rxtainted to make all the appropriate types of
-       destination taint visible; e.g. set RXf_TAINTED_SEEN so that $1 et
-       al will appear tainted.
+       destination taint visible; e.g. set RXf_TAINTED_SEEN so that $1
+       et al will appear tainted.
 
 pp_match is just a simpler version of the above.
 
@@ -2147,7 +2161,6 @@ PP(pp_subst)
     const I32 oldsave = PL_savestack_ix;
     STRLEN slen;
     bool doutf8 = FALSE;
-    I32 matched;
 #ifdef PERL_OLD_COPY_ON_WRITE
     bool is_cow;
 #endif
@@ -2249,8 +2262,16 @@ PP(pp_subst)
 */
     }
 
-    matched = CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
-                        r_flags | REXEC_CHECKED);
+    if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
+                        r_flags | REXEC_CHECKED))
+    {
+      ret_no:
+       SPAGAIN;
+       PUSHs(rpm->op_pmflags & PMf_NONDESTRUCT ? TARG : &PL_sv_no);
+       LEAVE_SCOPE(oldsave);
+       RETURN;
+    }
+
     /* known replacement string? */
     if (dstr) {
        if (SvTAINTED(dstr))
@@ -2260,7 +2281,7 @@ PP(pp_subst)
         * but only if it matched; see
         * http://www.nntp.perl.org/group/perl.perl5.porters/2010/04/msg158809.html
         */
-       if (matched && DO_UTF8(dstr) && ! DO_UTF8(TARG)) {
+       if (DO_UTF8(dstr) && ! DO_UTF8(TARG)) {
            char * const orig_pvx =  SvPVX(TARG);
            const STRLEN new_len = sv_utf8_upgrade_nomg(TARG);
 
@@ -2293,14 +2314,6 @@ PP(pp_subst)
        doutf8 = FALSE;
     }
     
-    if (!matched) {
-      ret_no:
-       SPAGAIN;
-       PUSHs(rpm->op_pmflags & PMf_NONDESTRUCT ? TARG : &PL_sv_no);
-       LEAVE_SCOPE(oldsave);
-       RETURN;
-    }
-
     /* can do inplace substitution? */
     if (c
 #ifdef PERL_OLD_COPY_ON_WRITE