This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
doc tweaks suggested by Abigail, M.J.T. Guy, and Larry Wall
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 4db69c2..ab7a056 100644 (file)
--- a/op.c
+++ b/op.c
@@ -782,6 +782,10 @@ scalarvoid(OP *o)
     case OP_REPEAT:
        if (o->op_flags & OPf_STACKED)
            break;
+       goto func_ops;
+    case OP_SUBSTR:
+       if (o->op_private == 4)
+           break;
        /* FALL THROUGH */
     case OP_GVSV:
     case OP_WANTARRAY:
@@ -798,7 +802,6 @@ scalarvoid(OP *o)
     case OP_HEX:
     case OP_OCT:
     case OP_LENGTH:
-    case OP_SUBSTR:
     case OP_VEC:
     case OP_INDEX:
     case OP_RINDEX:
@@ -851,6 +854,7 @@ scalarvoid(OP *o)
     case OP_GGRNAM:
     case OP_GGRGID:
     case OP_GETLOGIN:
+      func_ops:
        if (!(o->op_private & OPpLVAL_INTRO))
            useless = op_desc[o->op_type];
        break;
@@ -1206,10 +1210,14 @@ mod(OP *o, I32 type)
     case OP_KEYS:
        if (type != OP_SASSIGN)
            goto nomod;
+       goto lvalue_func;
+    case OP_SUBSTR:
+       if (o->op_private == 4) /* don't allow 4 arg substr as lvalue */
+           goto nomod;
        /* FALL THROUGH */
     case OP_POS:
     case OP_VEC:
-    case OP_SUBSTR:
+      lvalue_func:
        pad_free(o->op_targ);
        o->op_targ = pad_alloc(o->op_type, SVs_PADMY);
        assert(SvTYPE(PAD_SV(o->op_targ)) == SVt_NULL);
@@ -1296,6 +1304,9 @@ scalar_mod_type(OP *o, I32 type)
     case OP_CONCAT:
     case OP_SUBST:
     case OP_TRANS:
+    case OP_READ:
+    case OP_SYSREAD:
+    case OP_RECV:
     case OP_ANDASSIGN: /* may work later */
     case OP_ORASSIGN:  /* may work later */
        return TRUE;
@@ -1510,11 +1521,21 @@ scope(OP *o)
     return o;
 }
 
+void
+save_hints(void)
+{
+    SAVEI32(hints);
+    SAVESPTR(GvHV(hintgv));
+    GvHV(hintgv) = newHVhv(GvHV(hintgv));
+    SAVEFREESV(GvHV(hintgv));
+}
+
 int
 block_start(int full)
 {
     dTHR;
     int retval = savestack_ix;
+
     SAVEI32(comppad_name_floor);
     if (full) {
        if ((comppad_name_fill = AvFILLp(comppad_name)) > 0)
@@ -1529,7 +1550,7 @@ block_start(int full)
     SAVEI32(padix_floor);
     padix_floor = padix;
     pad_reset_pending = FALSE;
-    SAVEI32(hints);
+    SAVEHINTS();
     hints &= ~HINT_BLOCK_SCOPE;
     return retval;
 }
@@ -2082,8 +2103,11 @@ newPMOP(I32 type, I32 flags)
     pmop->op_flags = flags;
     pmop->op_private = 0 | (flags >> 8);
 
+    if (hints & HINT_RE_TAINT)
+       pmop->op_pmpermflags |= PMf_RETAINT;
     if (hints & HINT_LOCALE)
-       pmop->op_pmpermflags = (pmop->op_pmflags |= PMf_LOCALE);
+       pmop->op_pmpermflags |= PMf_LOCALE;
+    pmop->op_pmflags = pmop->op_pmpermflags;
 
     /* link into pm list */
     if (type != OP_TRANS && curstash) {
@@ -2099,6 +2123,7 @@ pmruntime(OP *o, OP *expr, OP *repl)
 {
     PMOP *pm;
     LOGOP *rcop;
+    I32 repl_has_vars = 0;
 
     if (o->op_type == OP_TRANS)
        return pmtrans(o, expr, repl);
@@ -2165,13 +2190,15 @@ pmruntime(OP *o, OP *expr, OP *repl)
            for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
                if (opargs[curop->op_type] & OA_DANGEROUS) {
 #ifdef USE_THREADS
-                   if (curop->op_type == OP_THREADSV
-                       && strchr("&`'123456789+", curop->op_private)) {
-                       break;
+                   if (curop->op_type == OP_THREADSV) {
+                       repl_has_vars = 1;
+                       if (strchr("&`'123456789+", curop->op_private))
+                           break;
                    }
 #else
                    if (curop->op_type == OP_GV) {
                        GV *gv = ((GVOP*)curop)->op_gv;
+                       repl_has_vars = 1;
                        if (strchr("&`'123456789+", *GvENAME(gv)))
                            break;
                    }
@@ -2189,7 +2216,7 @@ pmruntime(OP *o, OP *expr, OP *repl)
                             curop->op_type == OP_PADAV ||
                             curop->op_type == OP_PADHV ||
                             curop->op_type == OP_PADANY) {
-                            /* is okay */
+                       repl_has_vars = 1;
                    }
                    else
                        break;
@@ -2197,12 +2224,19 @@ pmruntime(OP *o, OP *expr, OP *repl)
                lastop = curop;
            }
        }
-       if (curop == repl) {
+       if (curop == repl
+           && !(repl_has_vars 
+                && (!pm->op_pmregexp 
+                    || pm->op_pmregexp->reganch & ROPT_EVAL_SEEN))) {
            pm->op_pmflags |= PMf_CONST;        /* const for long enough */
            pm->op_pmpermflags |= PMf_CONST;    /* const for long enough */
            prepend_elem(o->op_type, scalar(repl), o);
        }
        else {
+           if (curop == repl && !pm->op_pmregexp) { /* Has variables. */
+               pm->op_pmflags |= PMf_MAYBE_CONST;
+               pm->op_pmpermflags |= PMf_MAYBE_CONST;
+           }
            Newz(1101, rcop, 1, LOGOP);
            rcop->op_type = OP_SUBSTCONT;
            rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
@@ -3014,12 +3048,44 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont
 #endif
     }
     if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
-       expr = scalar(ref(expr, OP_ITER));
+       expr = mod(force_list(scalar(ref(expr, OP_ITER))), OP_GREPSTART);
        iterflags |= OPf_STACKED;
     }
+    else if (expr->op_type == OP_NULL &&
+             (expr->op_flags & OPf_KIDS) &&
+             ((BINOP*)expr)->op_first->op_type == OP_FLOP)
+    {
+       /* Basically turn for($x..$y) into the same as for($x,$y), but we
+        * set the STACKED flag to indicate that these values are to be
+        * treated as min/max values by 'pp_iterinit'.
+        */
+       UNOP* flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
+       CONDOP* range = (CONDOP*) flip->op_first;
+       OP* left  = range->op_first;
+       OP* right = left->op_sibling;
+       LISTOP* listop;
+
+       range->op_flags &= ~OPf_KIDS;
+       range->op_first = Nullop;
+
+       listop = (LISTOP*)newLISTOP(OP_LIST, 0, left, right);
+       listop->op_first->op_next = range->op_true;
+       left->op_next = range->op_false;
+       right->op_next = (OP*)listop;
+       listop->op_next = listop->op_first;
+
+       op_free(expr);
+       expr = (OP*)(listop);
+        null(expr);
+       iterflags |= OPf_STACKED;
+    }
+    else {
+        expr = mod(force_list(expr), OP_GREPSTART);
+    }
+
+
     loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
-       append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
-                   scalar(sv))));
+                              append_elem(OP_LIST, expr, scalar(sv))));
     assert(!loop->op_next);
     Renew(loop, 1, LOOP);
     loop->op_targ = padoff;
@@ -3373,7 +3439,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
     GV *gv = gv_fetchpv(name ? name : "__ANON__",
                        GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV);
     char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch;
-    register CV *cv;
+    register CV *cv=0;
     I32 ix;
 
     if (o)
@@ -3412,7 +3478,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
                goto done;
            }
            /* ahem, death to those who redefine active sort subs */
-           if (curstackinfo->si_type == SI_SORT && sortcop == CvSTART(cv))
+           if (curstackinfo->si_type == PERLSI_SORT && sortcop == CvSTART(cv))
                croak("Can't redefine active sort subroutine %s", name);
            if(const_sv = cv_const_sv(cv))
                const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
@@ -4121,7 +4187,7 @@ ck_ftst(OP *o)
     if (o->op_flags & OPf_REF)
        return o;
 
-    if (o->op_flags & OPf_KIDS) {
+    if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
        SVOP *kid = (SVOP*)cUNOPo->op_first;
 
        if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
@@ -4911,7 +4977,7 @@ peep(register OP *o)
 
        case OP_PADAV:
            if (o->op_next->op_type == OP_RV2AV
-               && (o->op_next->op_flags && OPf_REF))
+               && (o->op_next->op_flags & OPf_REF))
            {
                null(o->op_next);
                o->op_next = o->op_next->op_next;
@@ -4920,7 +4986,7 @@ peep(register OP *o)
        
        case OP_PADHV:
            if (o->op_next->op_type == OP_RV2HV
-               && (o->op_next->op_flags && OPf_REF))
+               && (o->op_next->op_flags & OPf_REF))
            {
                null(o->op_next);
                o->op_next = o->op_next->op_next;