regcomp.c: Add #undef

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index d1cac93..4a55e02 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -84,6 +84,7 @@ PP(pp_padav)
     }
     gimme = GIMME_V;
     if (gimme == G_ARRAY) {
+        /* XXX see also S_pushav in pp_hot.c */
        const I32 maxarg = AvFILL(MUTABLE_AV(TARG)) + 1;
        EXTEND(SP, maxarg);
        if (SvMAGICAL(TARG)) {
@@ -173,7 +174,7 @@ PP(pp_clonecv)
        /* If this changes to use SAVECLEARSV, we can move the SAVECLEARSV
           to introcv and remove the SvPADSTALE_off. */
        SAVEPADSVANDMORTALIZE(ARGTARG);
-       PAD_SVl(ARGTARG) = mg->mg_obj;
+       PAD_SVl(ARGTARG) = SvREFCNT_inc_simple_NN(mg->mg_obj);
     }
     else {
        if (CvROOT(mg->mg_obj)) {
@@ -230,7 +231,7 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict,
                if (vivify_sv && sv != &PL_sv_undef) {
                    GV *gv;
                    if (SvREADONLY(sv))
-                       Perl_croak_no_modify(aTHX);
+                       Perl_croak_no_modify();
                    if (cUNOP->op_targ) {
                        SV * const namesv = PAD_SV(cUNOP->op_targ);
                        gv = MUTABLE_GV(newSV(0));
@@ -487,7 +488,8 @@ PP(pp_prototype)
            if (!code || code == -KEY_CORE)
                DIE(aTHX_ "Can't find an opnumber for \"%"SVf"\"",
                    SVfARG(newSVpvn_flags(
-                       s+6, SvCUR(TOPs)-6, SvFLAGS(TOPs) & SVf_UTF8
+                       s+6, SvCUR(TOPs)-6,
+                       (SvFLAGS(TOPs) & SVf_UTF8)|SVs_TEMP
                    )));
            {
                SV * const sv = core_prototype(NULL, s + 6, code, NULL);
@@ -637,7 +639,12 @@ PP(pp_gelem)
        switch (*elem) {
        case 'A':
            if (len == 5 && strEQ(second_letter, "RRAY"))
+           {
                tmpRef = MUTABLE_SV(GvAV(gv));
+               if (tmpRef && !AvREAL((const AV *)tmpRef)
+                && AvREIFY((const AV *)tmpRef))
+                   av_reify(MUTABLE_AV(tmpRef));
+           }
            break;
        case 'C':
            if (len == 4 && strEQ(second_letter, "ODE"))
@@ -771,12 +778,10 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
        return;
     }
     else if (SvREADONLY(sv)) {
-        if (SvFAKE(sv)) {
-            /* SV is copy-on-write */
-           sv_force_normal_flags(sv, 0);
-        }
-        else
-            Perl_croak_no_modify(aTHX);
+            Perl_croak_no_modify();
+    }
+    else if (SvIsCOW(sv)) {
+       sv_force_normal_flags(sv, 0);
     }
 
     if (PL_encoding) {
@@ -1039,7 +1044,7 @@ PP(pp_postinc)
     const bool inc =
        PL_op->op_type == OP_POSTINC || PL_op->op_type == OP_I_POSTINC;
     if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
-       Perl_croak_no_modify(aTHX);
+       Perl_croak_no_modify();
     if (SvROK(TOPs))
        TARG = sv_newmortal();
     sv_setsv(TARG, TOPs);
@@ -1641,7 +1646,7 @@ PP(pp_repeat)
 
     if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
        dMARK;
-       static const char oom_list_extend[] = "Out of memory during list extend";
+       static const char* const oom_list_extend = "Out of memory during list extend";
        const I32 items = SP - MARK;
        const I32 max = items * count;
 
@@ -1693,7 +1698,7 @@ PP(pp_repeat)
        SV * const tmpstr = POPs;
        STRLEN len;
        bool isutf;
-       static const char oom_string_extend[] =
+       static const char* const oom_string_extend =
          "Out of memory during string extend";
 
        if (TARG != tmpstr)
@@ -2696,24 +2701,37 @@ extern double drand48 (void);
 
 PP(pp_rand)
 {
-    dVAR; dSP; dTARGET;
-    NV value;
-    if (MAXARG < 1)
-       value = 1.0;
-    else if (!TOPs) {
-       value = 1.0; (void)POPs;
-    }
-    else
-       value = POPn;
-    if (value == 0.0)
-       value = 1.0;
+    dVAR;
     if (!PL_srand_called) {
        (void)seedDrand01((Rand_seed_t)seed());
        PL_srand_called = TRUE;
     }
-    value *= Drand01();
-    XPUSHn(value);
-    RETURN;
+    {
+       dSP;
+       NV value;
+       EXTEND(SP, 1);
+    
+       if (MAXARG < 1)
+           value = 1.0;
+       else {
+           SV * const sv = POPs;
+           if(!sv)
+               value = 1.0;
+           else
+               value = SvNV(sv);
+       }
+    /* 1 of 2 things can be carried through SvNV, SP or TARG, SP was carried */
+       if (value == 0.0)
+           value = 1.0;
+       {
+           dTARGET;
+           PUSHs(TARG);
+           PUTBACK;
+           value *= Drand01();
+           sv_setnv_mg(TARG, value);
+       }
+    }
+    return NORMAL;
 }
 
 PP(pp_srand)
@@ -3739,7 +3757,7 @@ PP(pp_uc)
            STRLEN u;
            STRLEN ulen;
            UV uv;
-           if (in_iota_subscript && ! is_utf8_mark(s)) {
+           if (in_iota_subscript && ! _is_utf8_mark(s)) {
 
                /* A non-mark.  Time to output the iota subscript */
 #define GREEK_CAPITAL_LETTER_IOTA 0x0399
@@ -5080,6 +5098,7 @@ PP(pp_push)
        SPAGAIN;
     }
     else {
+       if (SvREADONLY(ary) && MARK < SP) Perl_croak_no_modify();
        PL_delaymagic = DM_DELAY;
        for (++MARK; MARK <= SP; MARK++) {
            SV *sv;
@@ -5334,7 +5353,7 @@ PP(pp_split)
 #endif
     else
        ary = NULL;
-    if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
+    if (ary) {
        realarray = 1;
        PUTBACK;
        av_extend(ary,0);
@@ -5361,7 +5380,7 @@ PP(pp_split)
     orig = s;
     if (skipwhite) {
        if (do_utf8) {
-           while (*s == ' ' || is_utf8_space((U8*)s))
+           while (isSPACE_utf8(s))
                s += UTF8SKIP(s);
        }
        else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
@@ -5386,9 +5405,9 @@ PP(pp_split)
            m = s;
            /* this one uses 'm' and is a negative test */
            if (do_utf8) {
-               while (m < strend && !( *m == ' ' || is_utf8_space((U8*)m) )) {
+               while (m < strend && ! isSPACE_utf8(m) ) {
                    const int t = UTF8SKIP(m);
-                   /* is_utf8_space returns FALSE for malform utf8 */
+                   /* isSPACE_utf8 returns FALSE for malform utf8 */
                    if (strend - m < t)
                        m = strend;
                    else
@@ -5425,7 +5444,7 @@ PP(pp_split)
 
            /* this one uses 's' and is a positive test */
            if (do_utf8) {
-               while (s < strend && ( *s == ' ' || is_utf8_space((U8*)s) ))
+               while (s < strend && isSPACE_utf8(s) )
                    s +=  UTF8SKIP(s);
            }
            else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {