This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Note the Log::Message upgrade in perldelta
[perl5.git] / pp.c
diff --git a/pp.c b/pp.c
index df28740..751a0bf 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -248,7 +248,10 @@ Perl_softref2xv(pTHX_ SV *const sv, const char *const what,
            Perl_die(aTHX_ PL_no_usym, what);
     }
     if (!SvOK(sv)) {
-       if (PL_op->op_flags & OPf_REF)
+       if (
+         PL_op->op_flags & OPf_REF &&
+         PL_op->op_next->op_type != OP_BOOLKEYS
+       )
            Perl_die(aTHX_ PL_no_usym, what);
        if (ckWARN(WARN_UNINITIALIZED))
            report_uninit(sv);
@@ -1045,7 +1048,7 @@ PP(pp_undef)
 
            gp_free(MUTABLE_GV(sv));
            Newxz(gp, 1, GP);
-           GvGP(sv) = gp_ref(gp);
+           GvGP_set(sv, gp_ref(gp));
            GvSV(sv) = newSV(0);
            GvLINE(sv) = CopLINE(PL_curcop);
            GvEGV(sv) = MUTABLE_GV(sv);
@@ -3327,8 +3330,11 @@ PP(pp_length)
                           SV_UNDEF_RETURNS_NULL|SV_CONST_RETURN|SV_GMAGIC);
 
        if (!p) {
-           sv_setsv(TARG, &PL_sv_undef);
-           SETTARG;
+           if (!SvPADTMP(TARG)) {
+               sv_setsv(TARG, &PL_sv_undef);
+               SETTARG;
+           }
+           SETs(&PL_sv_undef);
        }
        else if (DO_UTF8(sv)) {
            SETi(utf8_length((U8*)p, (U8*)p + len));
@@ -3342,8 +3348,11 @@ PP(pp_length)
        else
            SETi(sv_len(sv));
     } else {
-       sv_setsv_nomg(TARG, &PL_sv_undef);
-       SETTARG;
+       if (!SvPADTMP(TARG)) {
+           sv_setsv_nomg(TARG, &PL_sv_undef);
+           SETTARG;
+       }
+       SETs(&PL_sv_undef);
     }
     RETURN;
 }
@@ -3537,7 +3546,8 @@ PP(pp_substr)
        }
     }
     SPAGAIN;
-    PUSHs(TARG);               /* avoid SvSETMAGIC here */
+    SvSETMAGIC(TARG);
+    PUSHs(TARG);
     RETURN;
 
 bound_fail:
@@ -3698,8 +3708,6 @@ PP(pp_index)
 PP(pp_sprintf)
 {
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
-    if (SvTAINTED(MARK[1]))
-       TAINT_PROPER("sprintf");
     SvTAINTED_off(TARG);
     do_sprintf(TARG, SP-MARK, MARK+1);
     TAINT_IF(SvTAINTED(TARG));
@@ -3838,12 +3846,6 @@ PP(pp_crypt)
 /* Generally UTF-8 and UTF-EBCDIC are indistinguishable at this level.  So 
  * most comments below say UTF-8, when in fact they mean UTF-EBCDIC as well */
 
-/* Both the characters below can be stored in two UTF-8 bytes.  In UTF-8 the max
- * character that 2 bytes can hold is U+07FF, and in UTF-EBCDIC it is U+03FF.
- * See http://www.unicode.org/unicode/reports/tr16 */
-#define LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS 0x0178   /* Also is title case */
-#define GREEK_CAPITAL_LETTER_MU 0x039C /* Upper and title case of MICRON */
-
 /* Below are several macros that generate code */
 /* Generates code to store a unicode codepoint c that is known to occupy
  * exactly two UTF-8 and UTF-EBCDIC bytes; it is stored into p and p+1. */
@@ -5870,7 +5872,7 @@ PP(pp_split)
        DIE(aTHX_ "panic: pp_split");
     rx = PM_GETRE(pm);
 
-    TAINT_IF((RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) &&
+    TAINT_IF(get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET &&
             (RX_EXTFLAGS(rx) & (RXf_WHITE | RXf_SKIPWHITE)));
 
     RX_MATCH_UTF8_set(rx, do_utf8);
@@ -5916,7 +5918,7 @@ PP(pp_split)
            while (*s == ' ' || is_utf8_space((U8*)s))
                s += UTF8SKIP(s);
        }
-       else if (RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) {
+       else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
            while (isSPACE_LC(*s))
                s++;
        }
@@ -5925,7 +5927,7 @@ PP(pp_split)
                s++;
        }
     }
-    if (RX_EXTFLAGS(rx) & PMf_MULTILINE) {
+    if (RX_EXTFLAGS(rx) & RXf_PMf_MULTILINE) {
        multiline = 1;
     }
 
@@ -5946,7 +5948,8 @@ PP(pp_split)
                    else
                        m += t;
                }
-            } else if (RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) {
+           }
+           else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
                while (m < strend && !isSPACE_LC(*m))
                    ++m;
             } else {
@@ -5978,7 +5981,8 @@ PP(pp_split)
            if (do_utf8) {
                while (s < strend && ( *s == ' ' || is_utf8_space((U8*)s) ))
                    s +=  UTF8SKIP(s);
-            } else if (RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) {
+           }
+           else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
                while (s < strend && isSPACE_LC(*s))
                    ++s;
             } else {
@@ -6317,6 +6321,8 @@ PP(pp_boolkeys)
     dSP;
     HV * const hv = (HV*)POPs;
     
+    if (SvTYPE(hv) != SVt_PVHV) { XPUSHs(&PL_sv_no); RETURN; }
+
     if (SvRMAGICAL(hv)) {
        MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
        if (mg) {