This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
For character case changing, create macros and use
[perl5.git] / pp.c
diff --git a/pp.c b/pp.c
index ea49b01..26b1cb3 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -492,7 +492,7 @@ PP(pp_prototype)
        if (strnEQ(s, "CORE::", 6)) {
            const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
            if (!code)
-               DIE(aTHX_ "Can't find an opnumber for \"%"UTF8f"\"",
+               DIE(aTHX_ "Can't find an opnumber for \"%" UTF8f "\"",
                   UTF8fARG(SvFLAGS(TOPs) & SVf_UTF8, SvCUR(TOPs)-6, s+6));
            {
                SV * const sv = core_prototype(NULL, s + 6, code, NULL);
@@ -658,10 +658,9 @@ PP(pp_gelem)
     sv = NULL;
     if (elem) {
        /* elem will always be NUL terminated.  */
-       const char * const second_letter = elem + 1;
        switch (*elem) {
        case 'A':
-           if (len == 5 && strEQ(second_letter, "RRAY"))
+           if (memEQs(elem, len, "ARRAY"))
            {
                tmpRef = MUTABLE_SV(GvAV(gv));
                if (tmpRef && !AvREAL((const AV *)tmpRef)
@@ -670,42 +669,42 @@ PP(pp_gelem)
            }
            break;
        case 'C':
-           if (len == 4 && strEQ(second_letter, "ODE"))
+           if (memEQs(elem, len, "CODE"))
                tmpRef = MUTABLE_SV(GvCVu(gv));
            break;
        case 'F':
-           if (len == 10 && strEQ(second_letter, "ILEHANDLE")) {
+           if (memEQs(elem, len, "FILEHANDLE")) {
                tmpRef = MUTABLE_SV(GvIOp(gv));
            }
            else
-               if (len == 6 && strEQ(second_letter, "ORMAT"))
+               if (memEQs(elem, len, "FORMAT"))
                    tmpRef = MUTABLE_SV(GvFORM(gv));
            break;
        case 'G':
-           if (len == 4 && strEQ(second_letter, "LOB"))
+           if (memEQs(elem, len, "GLOB"))
                tmpRef = MUTABLE_SV(gv);
            break;
        case 'H':
-           if (len == 4 && strEQ(second_letter, "ASH"))
+           if (memEQs(elem, len, "HASH"))
                tmpRef = MUTABLE_SV(GvHV(gv));
            break;
        case 'I':
-           if (*second_letter == 'O' && !elem[2] && len == 2)
+           if (memEQs(elem, len, "IO"))
                tmpRef = MUTABLE_SV(GvIOp(gv));
            break;
        case 'N':
-           if (len == 4 && strEQ(second_letter, "AME"))
+           if (memEQs(elem, len, "NAME"))
                sv = newSVhek(GvNAME_HEK(gv));
            break;
        case 'P':
-           if (len == 7 && strEQ(second_letter, "ACKAGE")) {
+           if (memEQs(elem, len, "PACKAGE")) {
                const HV * const stash = GvSTASH(gv);
                const HEK * const hek = stash ? HvNAME_HEK(stash) : NULL;
                sv = hek ? newSVhek(hek) : newSVpvs("__ANON__");
            }
            break;
        case 'S':
-           if (len == 6 && strEQ(second_letter, "CALAR"))
+           if (memEQs(elem, len, "SCALAR"))
                tmpRef = GvSVn(gv);
            break;
        }
@@ -902,7 +901,7 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
                }
            }
            else
-               sv_setpvs(retval, "");
+                SvPVCLEAR(retval);
        }
        else if (s && len) {
            s += --len;
@@ -913,7 +912,7 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
            SvNIOK_off(sv);
        }
        else
-           sv_setpvs(retval, "");
+            SvPVCLEAR(retval);
        SvSETMAGIC(sv);
     }
     return count;
@@ -984,7 +983,7 @@ PP(pp_undef)
     case SVt_PVCV:
        if (cv_const_sv((const CV *)sv))
            Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
-                          "Constant subroutine %"SVf" undefined",
+                          "Constant subroutine %" SVf " undefined",
                           SVfARG(CvANON((const CV *)sv)
                              ? newSVpvs_flags("(anonymous)", SVs_TEMP)
                              : sv_2mortal(newSVhek(
@@ -2965,7 +2964,11 @@ PP(pp_sin)
     {
       SV * const arg = TOPs;
       const NV value = SvNV_nomg(arg);
+#ifdef NV_NAN
       NV result = NV_NAN;
+#else
+      NV result = 0.0;
+#endif
       if (neg_report) { /* log or sqrt */
          if (
 #if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
@@ -2974,7 +2977,7 @@ PP(pp_sin)
              (op_type == OP_LOG ? (value <= 0.0) : (value < 0.0))) {
              SET_NUMERIC_STANDARD();
              /* diag_listed_as: Can't take log of %g */
-             DIE(aTHX_ "Can't take %s of %"NVgf, neg_report, value);
+             DIE(aTHX_ "Can't take %s of %" NVgf, neg_report, value);
          }
       }
       switch (op_type) {
@@ -3246,7 +3249,7 @@ PP(pp_length)
        }
     } else {
        if (!SvPADTMP(TARG)) {
-           sv_setsv_nomg(TARG, &PL_sv_undef);
+            sv_set_undef(TARG);
        } else { /* TARG is on stack at this point and is overwriten by SETs.
                    This branch is the odd one out, so put TARG by default on
                    stack earlier to let local SP go out of liveness sooner */
@@ -3444,7 +3447,7 @@ PP(pp_substr)
                repl = SvPV_const(repl_sv_copy, repl_len);
            }
            if (!SvOK(sv))
-               sv_setpvs(sv, "");
+                SvPVCLEAR(sv);
            sv_insert_flags(sv, byte_pos, byte_len, repl, repl_len, 0);
            SvREFCNT_dec(repl_sv_copy);
        }
@@ -3640,7 +3643,7 @@ PP(pp_chr)
     if (UNLIKELY(SvAMAGIC(top)))
        top = sv_2num(top);
     if (UNLIKELY(isinfnansv(top)))
-        Perl_croak(aTHX_ "Cannot chr %"NVgf, SvNV(top));
+        Perl_croak(aTHX_ "Cannot chr %" NVgf, SvNV(top));
     else {
         if (!IN_BYTES /* under bytes, chr(-1) eq chr(0xff), etc. */
             && ((SvIOKp(top) && !SvIsUV(top) && SvIV_nomg(top) < 0)
@@ -3655,7 +3658,7 @@ PP(pp_chr)
                    top = top2;
                }
                 Perl_warner(aTHX_ packWARN(WARN_UTF8),
-                            "Invalid negative number (%"SVf") in chr", SVfARG(top));
+                            "Invalid negative number (%" SVf ") in chr", SVfARG(top));
             }
             value = UNICODE_REPLACEMENT;
         } else {
@@ -3787,16 +3790,16 @@ PP(pp_ucfirst)
         ulen = UTF8SKIP(s);
         if (op_type == OP_UCFIRST) {
 #ifdef USE_LOCALE_CTYPE
-           _to_utf8_title_flags(s, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
+           _toTITLE_utf8_flags(s, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
 #else
-           _to_utf8_title_flags(s, tmpbuf, &tculen, 0);
+           _toTITLE_utf8_flags(s, tmpbuf, &tculen, 0);
 #endif
        }
         else {
 #ifdef USE_LOCALE_CTYPE
-           _to_utf8_lower_flags(s, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
+           _toLOWER_utf8_flags(s, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
 #else
-           _to_utf8_lower_flags(s, tmpbuf, &tculen, 0);
+           _toLOWER_utf8_flags(s, tmpbuf, &tculen, 0);
 #endif
        }
 
@@ -4087,9 +4090,9 @@ PP(pp_uc)
 
             u = UTF8SKIP(s);
 #ifdef USE_LOCALE_CTYPE
-            uv = _to_utf8_upper_flags(s, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
+            uv = _toUPPER_utf8_flags(s, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
 #else
-            uv = _to_utf8_upper_flags(s, tmpbuf, &ulen, 0);
+            uv = _toUPPER_utf8_flags(s, tmpbuf, &ulen, 0);
 #endif
 #define GREEK_CAPITAL_LETTER_IOTA 0x0399
 #define COMBINING_GREEK_YPOGEGRAMMENI 0x0345
@@ -4303,9 +4306,9 @@ PP(pp_lc)
            STRLEN ulen;
 
 #ifdef USE_LOCALE_CTYPE
-           _to_utf8_lower_flags(s, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
+           _toLOWER_utf8_flags(s, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
 #else
-           _to_utf8_lower_flags(s, tmpbuf, &ulen, 0);
+           _toLOWER_utf8_flags(s, tmpbuf, &ulen, 0);
 #endif
 
            /* Here is where we would do context-sensitive actions.  See the
@@ -4513,7 +4516,7 @@ PP(pp_fc)
             const STRLEN u = UTF8SKIP(s);
             STRLEN ulen;
 
-            _to_utf8_fold_flags(s, tmpbuf, &ulen, flags);
+            _toFOLD_utf8_flags(s, tmpbuf, &ulen, flags);
 
             if (ulen > u && (SvLEN(dest) < (min += ulen - u))) {
                 const UV o = d - (U8*)SvPVX_const(dest);
@@ -5704,14 +5707,16 @@ PP(pp_reverse)
 PP(pp_split)
 {
     dSP; dTARG;
-    AV *ary = PL_op->op_flags & OPf_STACKED ? (AV *)POPs : NULL;
+    AV *ary = (   (PL_op->op_private & OPpSPLIT_ASSIGN) /* @a = split */
+               && (PL_op->op_flags & OPf_STACKED))      /* @{expr} = split */
+               ? (AV *)POPs : NULL;
     IV limit = POPi;                   /* note, negative is forever */
     SV * const sv = POPs;
     STRLEN len;
     const char *s = SvPV_const(sv, len);
     const bool do_utf8 = DO_UTF8(sv);
     const char *strend = s + len;
-    PMOP *pm;
+    PMOP *pm = cPMOPx(PL_op);
     REGEXP *rx;
     SV *dstr;
     const char *m;
@@ -5727,38 +5732,40 @@ PP(pp_split)
     I32 base;
     const U8 gimme = GIMME_V;
     bool gimme_scalar;
-    const I32 oldsave = PL_savestack_ix;
+    I32 oldsave = PL_savestack_ix;
     U32 make_mortal = SVs_TEMP;
     bool multiline = 0;
     MAGIC *mg = NULL;
 
-#ifdef DEBUGGING
-    Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*);
-#else
-    pm = (PMOP*)POPs;
-#endif
-    if (!pm)
-       DIE(aTHX_ "panic: pp_split, pm=%p, s=%p", pm, s);
     rx = PM_GETRE(pm);
 
     TAINT_IF(get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET &&
              (RX_EXTFLAGS(rx) & (RXf_WHITE | RXf_SKIPWHITE)));
 
+    /* handle @ary = split(...) optimisation */
+    if (PL_op->op_private & OPpSPLIT_ASSIGN) {
+        if (!(PL_op->op_flags & OPf_STACKED)) {
+            if (PL_op->op_private & OPpSPLIT_LEX) {
+                if (PL_op->op_private & OPpLVAL_INTRO)
+                    SAVECLEARSV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff));
+                ary = (AV *)PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff);
+            }
+            else {
+                GV *gv =
 #ifdef USE_ITHREADS
-    if (pm->op_pmreplrootu.op_pmtargetoff) {
-       ary = GvAVn(MUTABLE_GV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff)));
-       goto have_av;
-    }
+                        MUTABLE_GV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff));
 #else
-    if (pm->op_pmreplrootu.op_pmtargetgv) {
-       ary = GvAVn(pm->op_pmreplrootu.op_pmtargetgv);
-       goto have_av;
-    }
+                        pm->op_pmreplrootu.op_pmtargetgv;
 #endif
-    else if (pm->op_targ)
-       ary = (AV *)PAD_SVl(pm->op_targ);
-    if (ary) {
-       have_av:
+                if (PL_op->op_private & OPpLVAL_INTRO)
+                    ary = save_ary(gv);
+                else
+                    ary = GvAVn(gv);
+            }
+            /* skip anything pushed by OPpLVAL_INTRO above */
+            oldsave = PL_savestack_ix;
+        }
+
        realarray = 1;
        PUTBACK;
        av_extend(ary,0);
@@ -5782,11 +5789,12 @@ PP(pp_split)
            make_mortal = 0;
        }
     }
+
     base = SP - PL_stack_base;
     orig = s;
     if (RX_EXTFLAGS(rx) & RXf_SKIPWHITE) {
        if (do_utf8) {
-           while (isSPACE_utf8(s))
+           while (isSPACE_utf8_safe(s, strend))
                s += UTF8SKIP(s);
        }
        else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
@@ -5811,9 +5819,9 @@ PP(pp_split)
            m = s;
            /* this one uses 'm' and is a negative test */
            if (do_utf8) {
-               while (m < strend && ! isSPACE_utf8(m) ) {
+               while (m < strend && ! isSPACE_utf8_safe(m, strend) ) {
                    const int t = UTF8SKIP(m);
-                   /* isSPACE_utf8 returns FALSE for malform utf8 */
+                   /* isSPACE_utf8_safe returns FALSE for malform utf8 */
                    if (strend - m < t)
                        m = strend;
                    else
@@ -5851,7 +5859,7 @@ PP(pp_split)
 
            /* this one uses 's' and is a positive test */
            if (do_utf8) {
-               while (s < strend && isSPACE_utf8(s) )
+               while (s < strend && isSPACE_utf8_safe(s, strend) )
                    s +=  UTF8SKIP(s);
            }
            else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET)
@@ -6087,7 +6095,7 @@ PP(pp_split)
            while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) {
                if (TOPs && !make_mortal)
                    sv_2mortal(TOPs);
-               *SP-- = &PL_sv_undef;
+               *SP-- = NULL;
                iters--;
            }
        }
@@ -6367,7 +6375,7 @@ PP(pp_avhvswitch)
     dVAR; dSP;
     return PL_ppaddr[
                (SvTYPE(TOPs) == SVt_PVAV ? OP_AEACH : OP_EACH)
-                   + (PL_op->op_private & 3)
+                   + (PL_op->op_private & OPpAVHVSWITCH_MASK)
           ](aTHX);
 }