When sorting, promote to PVNV only for built-in comparison

[p5sagit/p5-mst-13.2.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 999b2cc..58ab34c 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -109,6 +109,8 @@ PP(pp_substcont)
        if (cx->sb_iters > cx->sb_maxiters)
            DIE("Substitution loop");
 
+       if (!cx->sb_rxtainted)
+           cx->sb_rxtainted = SvTAINTED(TOPs);
        sv_catsv(dstr, POPs);
        if (rx->subbase)
            Safefree(rx->subbase);
@@ -131,6 +133,8 @@ PP(pp_substcont)
 
            (void)SvPOK_only(targ);
            SvSETMAGIC(targ);
+           if (cx->sb_rxtainted)
+               SvTAINTED_on(targ);
            PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
            LEAVE_SCOPE(cx->sb_oldsave);
            POPSUBST(cx);
@@ -148,6 +152,7 @@ PP(pp_substcont)
     sv_catpvn(dstr, s, m-s);
     cx->sb_s = rx->endp[0];
     cx->sb_subbase = rx->subbase;
+    cx->sb_rxtainted |= rx->exec_tainted;
 
     rx->subbase = Nullch;      /* so recursion works */
     RETURNOP(pm->op_pmreplstart);
@@ -378,7 +383,7 @@ PP(pp_formline)
            gotsome = TRUE;
            value = SvNV(sv);
            /* Formats aren't yet marked for locales, so assume "yes". */
-           NUMERIC_LOCAL();
+           SET_NUMERIC_LOCAL();
            if (arg & 256) {
                sprintf(t, "%#*.*f", (int) fieldsize, (int) arg & 255, value);
            } else {
@@ -607,10 +612,9 @@ PP(pp_sort)
     while (MARK < SP) {        /* This may or may not shift down one here. */
        /*SUPPRESS 560*/
        if (*up = *++MARK) {                    /* Weed out nulls. */
-           if (!SvPOK(*up))
+           SvTEMP_off(*up);
+           if (!sortcop && !SvPOK(*up))
                (void)sv_2pv(*up, &na);
-           else
-               SvTEMP_off(*up);
            up++;
        }
     }
@@ -859,7 +863,7 @@ I32 startingblock;
        switch (cx->cx_type) {
        case CXt_SUBST:
            if (dowarn)
-               warn("Exiting substitition via %s", op_name[op->op_type]);
+               warn("Exiting substitution via %s", op_name[op->op_type]);
            break;
        case CXt_SUB:
            if (dowarn)
@@ -906,55 +910,6 @@ I32 cxix;
     }
 }
 
-#ifdef I_STDARG
-OP *
-die(char* pat, ...)
-#else
-/*VARARGS0*/
-OP *
-die(pat, va_alist)
-    char *pat;
-    va_dcl
-#endif
-{
-    va_list args;
-    char *message;
-    int oldrunlevel = runlevel;
-    int was_in_eval = in_eval;
-    HV *stash;
-    GV *gv;
-    CV *cv;
-
-    /* We have to switch back to mainstack or die_where may try to pop
-     * the eval block from the wrong stack if die is being called from a
-     * signal handler.  - dkindred@cs.cmu.edu */
-    if (curstack != mainstack) {
-        dSP;
-        SWITCHSTACK(curstack, mainstack);
-    }
-#ifdef I_STDARG
-    va_start(args, pat);
-#else
-    va_start(args);
-#endif
-    message = mess(pat, &args);
-    va_end(args);
-    if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
-       dSP;
-
-       PUSHMARK(sp);
-       EXTEND(sp, 1);
-       PUSHs(sv_2mortal(newSVpv(message,0)));
-       PUTBACK;
-       perl_call_sv((SV*)cv, G_DISCARD);
-       message = mess(pat, &args);     /* Static buffer could be reused. */
-    }
-    restartop = die_where(message);
-    if ((!restartop && was_in_eval) || oldrunlevel > 1)
-       Siglongjmp(top_env, 3);
-    return restartop;
-}
-
 OP *
 die_where(message)
 char *message;
@@ -1298,11 +1253,8 @@ PP(pp_enteriter)
 
     PUSHBLOCK(cx, CXt_LOOP, SP);
     PUSHLOOP(cx, svp, MARK);
-    if (op->op_flags & OPf_STACKED) {
-       AV* av = (AV*)POPs;
-       cx->blk_loop.iterary = av;
-       cx->blk_loop.iterix = -1;
-    }
+    if (op->op_flags & OPf_STACKED)
+       cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
     else {
        cx->blk_loop.iterary = curstack;
        AvFILL(curstack) = sp - stack_base;
@@ -1634,6 +1586,7 @@ PP(pp_goto)
                EXTEND(stack_sp, items); /* @_ could have been extended. */
                Copy(AvARRAY(av), stack_sp, items, SV*);
                stack_sp += items;
+               SvREFCNT_dec(GvAV(defgv));
                GvAV(defgv) = cx->blk_sub.savearray;
                AvREAL_off(av);
                av_clear(av);
@@ -1675,8 +1628,7 @@ PP(pp_goto)
                    (void)SvREFCNT_inc(cv);
                else {  /* save temporaries on recursion? */
                    if (CvDEPTH(cv) == 100 && dowarn)
-                       warn("Deep recursion on subroutine \"%s\"",
-                           GvENAME(CvGV(cv)));
+                       sub_crush_depth(cv);
                    if (CvDEPTH(cv) > AvFILL(padlist)) {
                        AV *newpad = newAV();
                        SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
@@ -1685,8 +1637,10 @@ PP(pp_goto)
                        for ( ;ix > 0; ix--) {
                            if (svp[ix] != &sv_undef) {
                                char *name = SvPVX(svp[ix]);
-                               if (SvFLAGS(svp[ix]) & SVf_FAKE) {
-                                   /* outer lexical? */
+                               if ((SvFLAGS(svp[ix]) & SVf_FAKE)
+                                   || *name == '&')
+                               {
+                                   /* outer lexical or anon code */
                                    av_store(newpad, ix,
                                        SvREFCNT_inc(oldpad[ix]) );
                                }
@@ -1724,7 +1678,7 @@ PP(pp_goto)
 
                    cx->blk_sub.savearray = GvAV(defgv);
                    cx->blk_sub.argarray = av;
-                   GvAV(defgv) = cx->blk_sub.argarray;
+                   GvAV(defgv) = (AV*)SvREFCNT_inc(av);
                    ++mark;
 
                    if (items >= AvMAX(av) + 1) {
@@ -1750,12 +1704,13 @@ PP(pp_goto)
                    }
                }
                if (perldb && curstash != debstash) {
-                   /* &xsub is not copying @_ */
+                   /*
+                    * We do not care about using sv to call CV;
+                    * it's for informational purposes only.
+                    */
                    SV *sv = GvSV(DBsub);
                    save_item(sv);
                    gv_efullname3(sv, CvGV(cv), Nullch);
-                   /* We do not care about using sv to call CV,
-                    * just for info. */
                }
                RETURNOP(CvSTART(cv));
            }
@@ -1947,6 +1902,7 @@ int gimme;
     dSP;
     OP *saveop = op;
     HV *newstash;
+    CV *caller;
     AV* comppadlist;
 
     in_eval = 1;
@@ -1963,9 +1919,11 @@ int gimme;
     SAVEI32(min_intro_pending);
     SAVEI32(max_intro_pending);
 
+    caller = compcv;
     SAVESPTR(compcv);
     compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)compcv, SVt_PVCV);
+    CvUNIQUE_on(compcv);
 
     comppad = newAV();
     comppad_name = newAV();
@@ -1980,6 +1938,10 @@ int gimme;
     av_store(comppadlist, 0, (SV*)comppad_name);
     av_store(comppadlist, 1, (SV*)comppad);
     CvPADLIST(compcv) = comppadlist;
+
+    if (saveop->op_type != OP_REQUIRE)
+       CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(caller);
+
     SAVEFREESV(compcv);
 
     /* make sure we compile in the right package */
@@ -2072,7 +2034,7 @@ PP(pp_require)
 
     sv = POPs;
     if (SvNIOKp(sv) && !SvPOKp(sv)) {
-       NUMERIC_STANDARD();
+       SET_NUMERIC_STANDARD();
        if (atof(patchlevel) + 0.00000999 < SvNV(sv))
            DIE("Perl %s required--this is only version %s, stopped",
                SvPV(sv,na),patchlevel);
@@ -2411,13 +2373,12 @@ SV *sv;
            skipspaces++;
            arg -= skipspaces;
            if (arg) {
-               if (postspace) {
+               if (postspace)
                    *fpc++ = FF_SPACE;
-                   postspace = FALSE;
-               }
                *fpc++ = FF_LITERAL;
                *fpc++ = arg;
            }
+           postspace = FALSE;
            if (s <= send)
                skipspaces--;
            if (skipspaces) {