This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add option to omit Changes file, from Abigail <abigail@delanet.com>;
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 3d07000..755c34e 100644 (file)
--- a/op.c
+++ b/op.c
@@ -142,7 +142,7 @@ Perl_pad_allocmy(pTHX_ char *name)
        (PL_hints & HINT_UTF8 && (name[1] & 0xc0) == 0xc0) ||
        name[1] == '_' && (int)strlen(name) > 2))
     {
-       if (!isPRINT(name[1])) {
+       if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
            /* 1999-02-27 mjd@plover.com */
            char *p;
            p = strchr(name, '\0');
@@ -192,7 +192,7 @@ Perl_pad_allocmy(pTHX_ char *name)
        PL_sv_objcount++;
     }
     av_store(PL_comppad_name, off, sv);
-    SvNVX(sv) = (double)PAD_MAX;
+    SvNVX(sv) = (NV)PAD_MAX;
     SvIVX(sv) = 0;                     /* Not yet introduced--see newSTATEOP */
     if (!PL_min_intro_pending)
        PL_min_intro_pending = off;
@@ -255,7 +255,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
                    sv_upgrade(namesv, SVt_PVNV);
                    sv_setpv(namesv, name);
                    av_store(PL_comppad_name, newoff, namesv);
-                   SvNVX(namesv) = (double)PL_curcop->cop_seq;
+                   SvNVX(namesv) = (NV)PL_curcop->cop_seq;
                    SvIVX(namesv) = PAD_MAX;    /* A ref, intro immediately */
                    SvFAKE_on(namesv);          /* A ref, not a real var */
                    if (SvOBJECT(sv)) {         /* A typed var */
@@ -414,13 +414,14 @@ Perl_pad_findmy(pTHX_ char *name)
 void
 Perl_pad_leavemy(pTHX_ I32 fill)
 {
+    dTHR;
     I32 off;
     SV **svp = AvARRAY(PL_comppad_name);
     SV *sv;
     if (PL_min_intro_pending && fill < PL_min_intro_pending) {
        for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
-           if ((sv = svp[off]) && sv != &PL_sv_undef)
-               Perl_warn(aTHX_ "%s never introduced", SvPVX(sv));
+           if ((sv = svp[off]) && sv != &PL_sv_undef && ckWARN_d(WARN_INTERNAL))
+               Perl_warner(aTHX_ WARN_INTERNAL, "%s never introduced", SvPVX(sv));
        }
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
@@ -647,6 +648,7 @@ void
 Perl_op_free(pTHX_ OP *o)
 {
     register OP *kid, *nextkid;
+    OPCODE type;
 
     if (!o || o->op_seq == (U16)-1)
        return;
@@ -657,42 +659,57 @@ Perl_op_free(pTHX_ OP *o)
            op_free(kid);
        }
     }
+    type = o->op_type;
+    if (type == OP_NULL)
+       type = o->op_targ;
+
+    /* COP* is not cleared by op_clear() so that we may track line
+     * numbers etc even after null() */
+    if (type == OP_NEXTSTATE || type == OP_SETSTATE || type == OP_DBSTATE)
+       cop_free((COP*)o);
+
+    op_clear(o);
+
+#ifdef PL_OP_SLAB_ALLOC
+    if ((char *) o == PL_OpPtr)
+     {
+     }
+#else
+    Safefree(o);
+#endif
+}
 
+STATIC void
+S_op_clear(pTHX_ OP *o)
+{
     switch (o->op_type) {
-    case OP_NULL:
-       o->op_targ = 0; /* Was holding old type, if any. */
-       break;
-    case OP_ENTEREVAL:
-       o->op_targ = 0; /* Was holding hints. */
+    case OP_NULL:      /* Was holding old type, if any. */
+    case OP_ENTEREVAL: /* Was holding hints. */
+#ifdef USE_THREADS
+    case OP_THREADSV:  /* Was holding index into thr->threadsv AV. */
+#endif
+       o->op_targ = 0;
        break;
 #ifdef USE_THREADS
     case OP_ENTERITER:
        if (!(o->op_flags & OPf_SPECIAL))
            break;
        /* FALL THROUGH */
-    case OP_THREADSV:
-       o->op_targ = 0; /* Was holding index into thr->threadsv AV. */
-       break;
 #endif /* USE_THREADS */
     default:
        if (!(o->op_flags & OPf_REF)
-           || (PL_check[o->op_type] != FUNC_NAME_TO_PTR(Perl_ck_ftst)))
+           || (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)))
            break;
        /* FALL THROUGH */
     case OP_GVSV:
     case OP_GV:
     case OP_AELEMFAST:
        SvREFCNT_dec(cGVOPo->op_gv);
-       break;
-    case OP_NEXTSTATE:
-    case OP_DBSTATE:
-       Safefree(cCOPo->cop_label);
-       SvREFCNT_dec(cCOPo->cop_filegv);
-       if (cCOPo->cop_warnings != WARN_NONE && cCOPo->cop_warnings != WARN_ALL)
-           SvREFCNT_dec(cCOPo->cop_warnings);
+       cGVOPo->op_gv = Nullgv;
        break;
     case OP_CONST:
        SvREFCNT_dec(cSVOPo->op_sv);
+       cSVOPo->op_sv = Nullsv;
        break;
     case OP_GOTO:
     case OP_NEXT:
@@ -702,38 +719,46 @@ Perl_op_free(pTHX_ OP *o)
            break;
        /* FALL THROUGH */
     case OP_TRANS:
-       if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
+       if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
            SvREFCNT_dec(cSVOPo->op_sv);
-       else
+           cSVOPo->op_sv = Nullsv;
+       }
+       else {
            Safefree(cPVOPo->op_pv);
+           cPVOPo->op_pv = Nullch;
+       }
        break;
     case OP_SUBST:
        op_free(cPMOPo->op_pmreplroot);
+       cPMOPo->op_pmreplroot = Nullop;
        /* FALL THROUGH */
     case OP_PUSHRE:
     case OP_MATCH:
     case OP_QR:
        ReREFCNT_dec(cPMOPo->op_pmregexp);
+       cPMOPo->op_pmregexp = (REGEXP*)NULL;
        break;
     }
 
     if (o->op_targ > 0)
        pad_free(o->op_targ);
+}
 
-#ifdef PL_OP_SLAB_ALLOC
-    if ((char *) o == PL_OpPtr)
-     {
-     }
-#else
-    Safefree(o);
-#endif
+STATIC void
+S_cop_free(pTHX_ COP* cop)
+{
+    Safefree(cop->cop_label);
+    SvREFCNT_dec(cop->cop_filegv);
+    if (! specialWARN(cop->cop_warnings))
+       SvREFCNT_dec(cop->cop_warnings);
 }
 
 STATIC void
 S_null(pTHX_ OP *o)
 {
-    if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
-       pad_free(o->op_targ);
+    if (o->op_type == OP_NULL)
+       return;
+    op_clear(o);
     o->op_targ = o->op_type;
     o->op_type = OP_NULL;
     o->op_ppaddr = PL_ppaddr[OP_NULL];
@@ -805,6 +830,10 @@ Perl_scalar(pTHX_ OP *o)
         || o->op_type == OP_RETURN)
        return o;
 
+    if ((o->op_private & OPpTARGET_MY)
+       && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+       return scalar(o);                       /* As if inside SASSIGN */
+    
     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
 
     switch (o->op_type) {
@@ -870,9 +899,12 @@ Perl_scalarvoid(pTHX_ OP *o)
     SV* sv;
     U8 want;
 
-    if (o->op_type == OP_NEXTSTATE || o->op_type == OP_DBSTATE ||
-       (o->op_type == OP_NULL &&
-        (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)))
+    if (o->op_type == OP_NEXTSTATE
+       || o->op_type == OP_SETSTATE
+       || o->op_type == OP_DBSTATE
+       || (o->op_type == OP_NULL && (o->op_targ == OP_NEXTSTATE
+                                     || o->op_targ == OP_SETSTATE
+                                     || o->op_targ == OP_DBSTATE)))
     {
        dTHR;
        PL_curcop = (COP*)o;            /* for warning below */
@@ -884,6 +916,10 @@ Perl_scalarvoid(pTHX_ OP *o)
         || o->op_type == OP_RETURN)
        return o;
 
+    if ((o->op_private & OPpTARGET_MY)
+       && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+       return scalar(o);                       /* As if inside SASSIGN */
+    
     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
 
     switch (o->op_type) {
@@ -998,8 +1034,7 @@ Perl_scalarvoid(pTHX_ OP *o)
                }
            }
        }
-       null(o);                /* don't execute a constant */
-       SvREFCNT_dec(sv);       /* don't even remember it */
+       null(o);                /* don't execute or even remember it */
        break;
 
     case OP_POSTINC:
@@ -1083,6 +1118,10 @@ Perl_list(pTHX_ OP *o)
         || o->op_type == OP_RETURN)
        return o;
 
+    if ((o->op_private & OPpTARGET_MY)
+       && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+       return o;                               /* As if inside SASSIGN */
+    
     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
 
     switch (o->op_type) {
@@ -1190,6 +1229,10 @@ Perl_mod(pTHX_ OP *o, I32 type)
     if (!o || PL_error_count)
        return o;
 
+    if ((o->op_private & OPpTARGET_MY)
+       && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+       return o;
+    
     switch (o->op_type) {
     case OP_UNDEF:
        PL_modcount++;
@@ -1662,8 +1705,8 @@ Perl_scope(pTHX_ OP *o)
                o->op_ppaddr = PL_ppaddr[OP_SCOPE];
                kid = ((LISTOP*)o)->op_first;
                if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
-                   SvREFCNT_dec(((COP*)kid)->cop_filegv);
-                   null(kid);
+                   kid->op_type = OP_SETSTATE;
+                   kid->op_ppaddr = PL_ppaddr[OP_SETSTATE];
                }
            }
            else
@@ -1705,8 +1748,7 @@ Perl_block_start(pTHX_ int full)
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
     SAVEPPTR(PL_compiling.cop_warnings); 
-    if (PL_compiling.cop_warnings != WARN_ALL && 
-       PL_compiling.cop_warnings != WARN_NONE) {
+    if (! specialWARN(PL_compiling.cop_warnings)) {
         PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
         SAVEFREESV(PL_compiling.cop_warnings) ;
     }
@@ -1830,11 +1872,17 @@ Perl_fold_constants(pTHX_ register OP *o)
 
     if (PL_opargs[type] & OA_RETSCALAR)
        scalar(o);
-    if (PL_opargs[type] & OA_TARGET)
+    if (PL_opargs[type] & OA_TARGET && !o->op_targ)
        o->op_targ = pad_alloc(type, SVs_PADTMP);
 
-    if ((PL_opargs[type] & OA_OTHERINT) && (PL_hints & HINT_INTEGER))
+    /* integerize op, unless it happens to be C<-foo>.
+     * XXX should pp_i_negate() do magic string negation instead? */
+    if ((PL_opargs[type] & OA_OTHERINT) && (PL_hints & HINT_INTEGER)
+       && !(type == OP_NEGATE && cUNOPo->op_first->op_type == OP_CONST
+            && (cUNOPo->op_first->op_private & OPpCONST_BARE)))
+    {
        o->op_ppaddr = PL_ppaddr[type = ++(o->op_type)];
+    }
 
     if (!(PL_opargs[type] & OA_FOLDCONST))
        goto nope;
@@ -1893,7 +1941,7 @@ Perl_fold_constants(pTHX_ register OP *o)
            type != OP_NEGATE)
        {
            IV iv = SvIV(sv);
-           if ((double)iv == SvNV(sv)) {
+           if ((NV)iv == SvNV(sv)) {
                SvREFCNT_dec(sv);
                sv = newSViv(iv);
            }
@@ -2185,7 +2233,7 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
     }
 
     binop = (BINOP*)CHECKOP(type, binop);
-    if (binop->op_next)
+    if (binop->op_next || binop->op_type != type)
        return (OP*)binop;
 
     binop->op_last = binop->op_first->op_sibling;
@@ -2843,8 +2891,8 @@ S_list_assignment(pTHX_ register OP *o)
        o = cUNOPo->op_first;
 
     if (o->op_type == OP_COND_EXPR) {
-       I32 t = list_assignment(cCONDOPo->op_first->op_sibling);
-       I32 f = list_assignment(cCONDOPo->op_first->op_sibling->op_sibling);
+       I32 t = list_assignment(cLOGOPo->op_first->op_sibling);
+       I32 f = list_assignment(cLOGOPo->op_first->op_sibling->op_sibling);
 
        if (t && f)
            return TRUE;
@@ -3034,8 +3082,7 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
     }
     cop->cop_seq = seq;
     cop->cop_arybase = PL_curcop->cop_arybase;
-    if (PL_curcop->cop_warnings == WARN_NONE 
-       || PL_curcop->cop_warnings == WARN_ALL)
+    if (specialWARN(PL_curcop->cop_warnings))
         cop->cop_warnings = PL_curcop->cop_warnings ;
     else 
         cop->cop_warnings = newSVsv(PL_curcop->cop_warnings) ;
@@ -3077,7 +3124,7 @@ Perl_intro_my(pTHX)
     for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
        if ((sv = svp[i]) && sv != &PL_sv_undef && !SvIVX(sv)) {
            SvIVX(sv) = PAD_MAX;        /* Don't know scope end yet. */
-           SvNVX(sv) = (double)PL_cop_seqmax;
+           SvNVX(sv) = (NV)PL_cop_seqmax;
        }
     }
     PL_min_intro_pending = 0;
@@ -3202,7 +3249,8 @@ OP *
 Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
 {
     dTHR;
-    CONDOP *condop;
+    LOGOP *logop;
+    OP *start;
     OP *o;
 
     if (!falseop)
@@ -3227,27 +3275,27 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
        list(trueop);
        scalar(falseop);
     }
-    NewOp(1101, condop, 1, CONDOP);
+    NewOp(1101, logop, 1, LOGOP);
+    logop->op_type = OP_COND_EXPR;
+    logop->op_ppaddr = PL_ppaddr[OP_COND_EXPR];
+    logop->op_first = first;
+    logop->op_flags = flags | OPf_KIDS;
+    logop->op_private = 1 | (flags >> 8);
+    logop->op_other = LINKLIST(trueop);
+    logop->op_next = LINKLIST(falseop);
 
-    condop->op_type = OP_COND_EXPR;
-    condop->op_ppaddr = PL_ppaddr[OP_COND_EXPR];
-    condop->op_first = first;
-    condop->op_flags = flags | OPf_KIDS;
-    condop->op_true = LINKLIST(trueop);
-    condop->op_false = LINKLIST(falseop);
-    condop->op_private = 1 | (flags >> 8);
 
     /* establish postfix order */
-    condop->op_next = LINKLIST(first);
-    first->op_next = (OP*)condop;
+    start = LINKLIST(first);
+    first->op_next = (OP*)logop;
 
     first->op_sibling = trueop;
     trueop->op_sibling = falseop;
-    o = newUNOP(OP_NULL, 0, (OP*)condop);
+    o = newUNOP(OP_NULL, 0, (OP*)logop);
 
-    trueop->op_next = o;
-    falseop->op_next = o;
+    trueop->op_next = falseop->op_next = o;
 
+    o->op_next = start;
     return o;
 }
 
@@ -3255,34 +3303,36 @@ OP *
 Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right)
 {
     dTHR;
-    CONDOP *condop;
+    LOGOP *range;
     OP *flip;
     OP *flop;
+    OP *leftstart;
     OP *o;
 
-    NewOp(1101, condop, 1, CONDOP);
+    NewOp(1101, range, 1, LOGOP);
 
-    condop->op_type = OP_RANGE;
-    condop->op_ppaddr = PL_ppaddr[OP_RANGE];
-    condop->op_first = left;
-    condop->op_flags = OPf_KIDS;
-    condop->op_true = LINKLIST(left);
-    condop->op_false = LINKLIST(right);
-    condop->op_private = 1 | (flags >> 8);
+    range->op_type = OP_RANGE;
+    range->op_ppaddr = PL_ppaddr[OP_RANGE];
+    range->op_first = left;
+    range->op_flags = OPf_KIDS;
+    leftstart = LINKLIST(left);
+    range->op_other = LINKLIST(right);
+    range->op_private = 1 | (flags >> 8);
 
     left->op_sibling = right;
 
-    condop->op_next = (OP*)condop;
-    flip = newUNOP(OP_FLIP, flags, (OP*)condop);
+    range->op_next = (OP*)range;
+    flip = newUNOP(OP_FLIP, flags, (OP*)range);
     flop = newUNOP(OP_FLOP, 0, flip);
     o = newUNOP(OP_NULL, 0, flop);
     linklist(flop);
+    range->op_next = leftstart;
 
     left->op_next = flip;
     right->op_next = flop;
 
-    condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
-    sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
+    range->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
+    sv_upgrade(PAD_SV(range->op_targ), SVt_PVNV);
     flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
     sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
 
@@ -3492,7 +3542,7 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
         * treated as min/max values by 'pp_iterinit'.
         */
        UNOP* flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
-       CONDOP* range = (CONDOP*) flip->op_first;
+       LOGOP* range = (LOGOP*) flip->op_first;
        OP* left  = range->op_first;
        OP* right = left->op_sibling;
        LISTOP* listop;
@@ -3501,8 +3551,8 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
        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;
+       listop->op_first->op_next = range->op_next;
+       left->op_next = range->op_other;
        right->op_next = (OP*)listop;
        listop->op_next = listop->op_first;
 
@@ -3808,7 +3858,9 @@ Perl_cv_clone(pTHX_ CV *proto)
 void
 Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
 {
-    if ((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) {
+    dTHR;
+
+    if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) && ckWARN_d(WARN_UNSAFE)) {
        SV* msg = sv_newmortal();
        SV* name = Nullsv;
 
@@ -3824,7 +3876,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
            Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
        else
            sv_catpv(msg, "none");
-       Perl_warn(aTHX_ "%_", msg);
+       Perl_warner(aTHX_ WARN_UNSAFE, "%_", msg);
     }
 }
 
@@ -3850,7 +3902,7 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv)
     for (; o; o = o->op_next) {
        OPCODE type = o->op_type;
 
-       if(sv && o->op_next == o) 
+       if (sv && o->op_next == o) 
            return sv;
        if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
            continue;
@@ -3894,8 +3946,11 @@ Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block)
     if (SvTYPE(gv) != SVt_PVGV) {      /* Prototype now, and had
                                           maximum a prototype before. */
        if (SvTYPE(gv) > SVt_NULL) {
-           if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1))
-               Perl_warn(aTHX_ "Runaway prototype");
+           if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1)
+               && ckWARN_d(WARN_UNSAFE))
+           {
+               Perl_warner(aTHX_ WARN_UNSAFE, "Runaway prototype");
+           }
            cv_ckproto((CV*)gv, NULL, ps);
        }
        if (ps)
@@ -4306,7 +4361,8 @@ Perl_oopsAV(pTHX_ OP *o)
        break;
 
     default:
-       Perl_warn(aTHX_ "oops: oopsAV");
+       if (ckWARN_d(WARN_INTERNAL))
+           Perl_warner(aTHX_ WARN_INTERNAL, "oops: oopsAV");
        break;
     }
     return o;
@@ -4315,6 +4371,8 @@ Perl_oopsAV(pTHX_ OP *o)
 OP *
 Perl_oopsHV(pTHX_ OP *o)
 {
+    dTHR;
+    
     switch (o->op_type) {
     case OP_PADSV:
     case OP_PADAV:
@@ -4330,7 +4388,8 @@ Perl_oopsHV(pTHX_ OP *o)
        break;
 
     default:
-       Perl_warn(aTHX_ "oops: oopsHV");
+       if (ckWARN_d(WARN_INTERNAL))
+           Perl_warner(aTHX_ WARN_INTERNAL, "oops: oopsHV");
        break;
     }
     return o;
@@ -4668,6 +4727,7 @@ Perl_ck_rvconst(pTHX_ register OP *o)
            kid->op_type = OP_GV;
            SvREFCNT_dec(kid->op_sv);
            kid->op_sv = SvREFCNT_inc(gv);
+           kid->op_ppaddr = PL_ppaddr[OP_GV];
        }
     }
     return o;
@@ -4999,14 +5059,14 @@ Perl_ck_defined(pTHX_ OP *o)            /* 19990527 MJD */
        case OP_PADAV:
        case OP_AASSIGN:                /* Is this a good idea? */
            Perl_warner(aTHX_ WARN_DEPRECATED,
-                       "defined(@array) is deprecated (and not really meaningful)");
+                       "defined(@array) is deprecated");
            Perl_warner(aTHX_ WARN_DEPRECATED,
                        "(Maybe you should just omit the defined()?)\n");
        break;
        case OP_RV2HV:
        case OP_PADHV:
            Perl_warner(aTHX_ WARN_DEPRECATED,
-                       "defined(%hash) is deprecated (and not really meaningful)");
+                       "defined(%hash) is deprecated");
            Perl_warner(aTHX_ WARN_DEPRECATED,
                        "(Maybe you should just omit the defined()?)\n");
            break;
@@ -5078,6 +5138,38 @@ Perl_ck_fun_locale(pTHX_ OP *o)
 }
 
 OP *
+Perl_ck_sassign(pTHX_ OP *o)
+{
+    OP *kid = cLISTOPo->op_first;
+    /* has a disposable target? */
+    if ((PL_opargs[kid->op_type] & OA_TARGLEX)
+       && !(kid->op_flags & OPf_STACKED))
+    {
+       OP *kkid = kid->op_sibling;
+
+       /* Can just relocate the target. */
+       if (kkid && kkid->op_type == OP_PADSV) {
+           /* Concat has problems if target is equal to right arg. */
+           if (kid->op_type == OP_CONCAT
+               && kLISTOP->op_first->op_sibling->op_type == OP_PADSV
+               && kLISTOP->op_first->op_sibling->op_targ == kkid->op_targ)
+           {
+               return o;
+           }
+           kid->op_targ = kkid->op_targ;
+           /* Now we do not need PADSV and SASSIGN. */
+           kid->op_sibling = o->op_sibling;    /* NULL */
+           cLISTOPo->op_first = NULL;
+           op_free(o);
+           op_free(kkid);
+           kid->op_private |= OPpTARGET_MY;    /* Used for context settings */
+           return kid;
+       }
+    }
+    return o;
+}
+
+OP *
 Perl_ck_scmp(pTHX_ OP *o)
 {
     o->op_private = 0;
@@ -5380,9 +5472,11 @@ Perl_ck_subr(pTHX_ OP *o)
        o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
        null(cvop);             /* disable rv2cv */
        tmpop = (SVOP*)((UNOP*)cvop)->op_first;
-       if (tmpop->op_type == OP_GV) {
+       if (tmpop->op_type == OP_GV && !(o->op_private & OPpENTERSUB_AMPER)) {
            cv = GvCVu(tmpop->op_sv);
-           if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) {
+           if (!cv)
+               tmpop->op_private |= OPpEARLY_CV;
+           else if (SvPOK(cv)) {
                namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
                proto = SvPV((SV*)cv, n_a);
            }
@@ -5477,6 +5571,8 @@ Perl_ck_subr(pTHX_ OP *o)
                case '$':
                    if (o2->op_type != OP_RV2SV
                        && o2->op_type != OP_PADSV
+                       && o2->op_type != OP_HELEM
+                       && o2->op_type != OP_AELEM
                        && o2->op_type != OP_THREADSV)
                    {
                        bad_type(arg, "scalar", gv_ename(namegv), o2);
@@ -5569,6 +5665,7 @@ Perl_peep(pTHX_ register OP *o)
            PL_op_seqmax++;
        PL_op = o;
        switch (o->op_type) {
+       case OP_SETSTATE:
        case OP_NEXTSTATE:
        case OP_DBSTATE:
            PL_curcop = ((COP*)o);              /* for warnings */
@@ -5579,15 +5676,35 @@ Perl_peep(pTHX_ register OP *o)
            if (cSVOPo->op_private & OPpCONST_STRICT)
                no_bareword_allowed(o);
            /* FALL THROUGH */
-       case OP_CONCAT:
-       case OP_JOIN:
        case OP_UC:
        case OP_UCFIRST:
        case OP_LC:
        case OP_LCFIRST:
+           if ( o->op_next && o->op_next->op_type == OP_STRINGIFY
+                && !(o->op_next->op_private & OPpTARGET_MY) )
+               null(o->op_next);
+           o->op_seq = PL_op_seqmax++;
+           break;
+       case OP_CONCAT:
+       case OP_JOIN:
        case OP_QUOTEMETA:
-           if (o->op_next && o->op_next->op_type == OP_STRINGIFY)
+           if (o->op_next && o->op_next->op_type == OP_STRINGIFY) {
+               if (o->op_next->op_private & OPpTARGET_MY) {
+                   if ((o->op_flags & OPf_STACKED) /* chained concats */
+                       || (o->op_type == OP_CONCAT
+           /* Concat has problems if target is equal to right arg. */
+                           && (((LISTOP*)o)->op_first->op_sibling->op_type
+                               == OP_PADSV)
+                           && (((LISTOP*)o)->op_first->op_sibling->op_targ
+                               == o->op_next->op_targ))) {
+                       goto ignore_optimization;
+                   } else {
+                       o->op_targ = o->op_next->op_targ;
+                   }
+               }
                null(o->op_next);
+           }
+         ignore_optimization:
            o->op_seq = PL_op_seqmax++;
            break;
        case OP_STUB:
@@ -5597,8 +5714,12 @@ Perl_peep(pTHX_ register OP *o)
            }
            goto nothin;
        case OP_NULL:
-           if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
+           if (o->op_targ == OP_NEXTSTATE
+               || o->op_targ == OP_DBSTATE
+               || o->op_targ == OP_SETSTATE)
+           {
                PL_curcop = ((COP*)o);
+           }
            goto nothin;
        case OP_SCALAR:
        case OP_LINESEQ:
@@ -5633,7 +5754,6 @@ Perl_peep(pTHX_ register OP *o)
                                <= 255 &&
                    i >= 0)
                {
-                   SvREFCNT_dec(((SVOP*)pop)->op_sv);
                    null(o->op_next);
                    null(pop->op_next);
                    null(pop);
@@ -5645,6 +5765,18 @@ Perl_peep(pTHX_ register OP *o)
                    GvAVn(((GVOP*)o)->op_gv);
                }
            }
+           else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) {
+               GV *gv = cGVOPo->op_gv;
+               if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) {
+                   /* XXX could check prototype here instead of just carping */
+                   SV *sv = sv_newmortal();
+                   gv_efullname3(sv, gv, Nullch);
+                   Perl_warner(aTHX_ WARN_UNSAFE,
+                               "%s() called too early to check prototype",
+                               SvPV_nolen(sv));
+               }
+           }
+
            o->op_seq = PL_op_seqmax++;
            break;
 
@@ -5652,18 +5784,14 @@ Perl_peep(pTHX_ register OP *o)
        case OP_GREPWHILE:
        case OP_AND:
        case OP_OR:
+       case OP_COND_EXPR:
+       case OP_RANGE:
            o->op_seq = PL_op_seqmax++;
            while (cLOGOP->op_other->op_type == OP_NULL)
                cLOGOP->op_other = cLOGOP->op_other->op_next;
            peep(cLOGOP->op_other);
            break;
 
-       case OP_COND_EXPR:
-           o->op_seq = PL_op_seqmax++;
-           peep(cCONDOP->op_true);
-           peep(cCONDOP->op_false);
-           break;
-
        case OP_ENTERLOOP:
            o->op_seq = PL_op_seqmax++;
            peep(cLOOP->op_redoop);