[win32] remove C<#define index strchr> from win32.h (unused, and the
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index 2dd64f8..1fbafc7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -532,6 +532,11 @@ find_threadsv(char *name)
            sawampersand = TRUE;
            SvREADONLY_on(sv);
            /* FALL THROUGH */
+
+       /* XXX %! tied to Errno.pm needs to be added here.
+        * See gv_fetchpv(). */
+       /* case '!': */
+
        default:
            sv_magic(sv, 0, 0, name, 1); 
        }
@@ -1045,8 +1050,6 @@ modkids(OP *o, I32 type)
     return o;
 }
 
-static I32 modcount;
-
 OP *
 mod(OP *o, I32 type)
 {
@@ -1241,6 +1244,7 @@ mod(OP *o, I32 type)
     else if (!type) {
        o->op_private |= OPpLVAL_INTRO;
        o->op_flags &= ~OPf_SPECIAL;
+       hints |= HINT_BLOCK_SCOPE;
     }
     else if (type != OP_GREPSTART && type != OP_ENTERSUB)
        o->op_flags |= OPf_REF;
@@ -1682,9 +1686,12 @@ fold_constants(register OP *o)
     if (type == OP_RV2GV)
        return newGVOP(OP_GV, 0, (GV*)sv);
     else {
-       if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) {
+       /* try to smush double to int, but don't smush -2.0 to -2 */
+       if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK &&
+           type != OP_NEGATE)
+       {
            IV iv = SvIV(sv);
-           if ((double)iv == SvNV(sv)) {       /* can we smush double to int */
+           if ((double)iv == SvNV(sv)) {
                SvREFCNT_dec(sv);
                sv = newSViv(iv);
            }
@@ -2421,6 +2428,7 @@ newASSIGNOP(I32 flags, OP *left, I32 optype, OP *right)
     }
 
     if (list_assignment(left)) {
+       dTHR;
        modcount = 0;
        eval_start = right;     /* Grandfathering $[ assignment here.  Bletch.*/
        left = mod(left, OP_AASSIGN);
@@ -2850,7 +2858,7 @@ newLOOPOP(I32 flags, I32 debuggable, OP *expr, OP *block)
                break;
            }
        }
-    }           
+    }
 
     listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
     o = new_logop(OP_AND, 0, &expr, &listop);
@@ -2891,7 +2899,7 @@ newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *b
          case OP_NULL: 
            if (k2 && k2->op_type == OP_READLINE
                  && (k2->op_flags & OPf_STACKED)
-                 && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) 
+                 && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) 
                expr = newUNOP(OP_DEFINED, 0, expr);
            break;                                
 
@@ -2904,7 +2912,6 @@ newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *b
        }
     }
 
-
     if (!block)
        block = newOP(OP_NULL, 0);
 
@@ -3307,16 +3314,27 @@ cv_ckproto(CV *cv, GV *gv, char *p)
 SV *
 cv_const_sv(CV *cv)
 {
-    OP *o;
-    SV *sv;
-
     if (!cv || !SvPOK(cv) || SvCUR(cv))
        return Nullsv;
+    return op_const_sv(CvSTART(cv), cv);
+}
 
-    sv = Nullsv;
-    for (o = CvSTART(cv); o; o = o->op_next) {
+SV *
+op_const_sv(OP *o, CV *cv)
+{
+    SV *sv = Nullsv;
+
+    if(!o)
+       return Nullsv;
+    if(o->op_type == OP_LINESEQ && cLISTOPo->op_first) 
+       o = cLISTOPo->op_first->op_sibling;
+
+    for (; o; o = o->op_next) {
        OPCODE type = o->op_type;
-       
+
+       if(sv && o->op_next == o) 
+           return sv;
        if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
            continue;
        if (type == OP_LEAVESUB || type == OP_RETURN)
@@ -3325,7 +3343,7 @@ cv_const_sv(CV *cv)
            return Nullsv;
        if (type == OP_CONST)
            sv = cSVOPo->op_sv;
-       else if (type == OP_PADSV) {
+       else if (type == OP_PADSV && cv) {
            AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
            sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
            if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
@@ -3344,7 +3362,8 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
 {
     dTHR;
     char *name = o ? SvPVx(cSVOPo->op_sv, na) : Nullch;
-    GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
+    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;
     I32 ix;
@@ -3354,6 +3373,23 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
     if (proto)
        SAVEFREEOP(proto);
 
+    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))
+               warn("Runaway prototype");
+           cv_ckproto((CV*)gv, NULL, ps);
+       }
+       if (ps)
+           sv_setpv((SV*)gv, ps);
+       else
+           sv_setiv((SV*)gv, -1);
+       SvREFCNT_dec(compcv);
+       cv = compcv = NULL;
+       sub_generation++;
+       goto noblock;
+    }
+
     if (!name || GvCVGEN(gv))
        cv = Nullcv;
     else if (cv = GvCV(gv)) {
@@ -3361,6 +3397,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
        /* already defined (or promised)? */
        if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
            SV* const_sv;
+           bool const_changed = TRUE;
            if (!block) {
                /* just a "sub foo;" when &foo is already defined */
                SAVEFREESV(compcv);
@@ -3369,8 +3406,9 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
            /* ahem, death to those who redefine active sort subs */
            if (curstackinfo->si_type == SI_SORT && sortcop == CvSTART(cv))
                croak("Can't redefine active sort subroutine %s", name);
-           const_sv = cv_const_sv(cv);
-           if (const_sv || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
+           if(const_sv = cv_const_sv(cv))
+               const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
+           if ((const_sv && const_changed) || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
                                        && HvNAME(GvSTASH(CvGV(cv)))
                                        && strEQ(HvNAME(GvSTASH(CvGV(cv))),
                                                 "autouse"))) {
@@ -3435,6 +3473,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
        }
     }
     if (!block) {
+      noblock:
        copline = NOLINE;
        LEAVE_SCOPE(floor);
        return cv;
@@ -3519,7 +3558,6 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
            ENTER;
            SAVESPTR(compiling.cop_filegv);
            SAVEI16(compiling.cop_line);
-           SAVEI32(perldb);
            save_svref(&rs);
            sv_setsv(rs, nrs);
 
@@ -4914,6 +4952,8 @@ peep(register OP *o)
            o->op_seq = op_seqmax++;
            if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
                if (o->op_next->op_sibling &&
+                       o->op_next->op_sibling->op_type != OP_EXIT &&
+                       o->op_next->op_sibling->op_type != OP_WARN &&
                        o->op_next->op_sibling->op_type != OP_DIE) {
                    line_t oldline = curcop->cop_line;