additional tests for utf8.t

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

diff --git a/pp_ctl.c b/pp_ctl.c
index acbcc7e..2308d35 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -883,15 +883,18 @@ PP(pp_sort)
 
            CATCH_SET(TRUE);
            PUSHSTACKi(PERLSI_SORT);
-           if (PL_sortstash != stash) {
-               PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV);
-               PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
-               PL_sortstash = stash;
+           if (!hasargs && !is_xsub) {
+               if (PL_sortstash != stash || !PL_firstgv || !PL_secondgv) {
+                   SAVESPTR(PL_firstgv);
+                   SAVESPTR(PL_secondgv);
+                   PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV);
+                   PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
+                   PL_sortstash = stash;
+               }
+               SAVESPTR(GvSV(PL_firstgv));
+               SAVESPTR(GvSV(PL_secondgv));
            }
 
-           SAVESPTR(GvSV(PL_firstgv));
-           SAVESPTR(GvSV(PL_secondgv));
-
            PUSHBLOCK(cx, CXt_NULL, PL_stack_base);
            if (!(PL_op->op_flags & OPf_SPECIAL)) {
                cx->cx_type = CXt_SUB;
@@ -1521,15 +1524,21 @@ PP(pp_caller)
     else
        PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY)));
     if (CxTYPE(cx) == CXt_EVAL) {
+       /* eval STRING */
        if (cx->blk_eval.old_op_type == OP_ENTEREVAL) {
            PUSHs(cx->blk_eval.cur_text);
            PUSHs(&PL_sv_no);
        }
-       /* try blocks have old_namesv == 0 */
+       /* require */
        else if (cx->blk_eval.old_namesv) {
            PUSHs(sv_2mortal(newSVsv(cx->blk_eval.old_namesv)));
            PUSHs(&PL_sv_yes);
        }
+       /* eval BLOCK (try blocks have old_namesv == 0) */
+       else {
+           PUSHs(&PL_sv_undef);
+           PUSHs(&PL_sv_undef);
+       }
     }
     else {
        PUSHs(&PL_sv_undef);
@@ -1979,7 +1988,7 @@ PP(pp_next)
 {
     I32 cxix;
     register PERL_CONTEXT *cx;
-    I32 oldsave;
+    I32 inner;
 
     if (PL_op->op_flags & OPf_SPECIAL) {
        cxix = dopoptoloop(cxstack_ix);
@@ -1994,13 +2003,12 @@ PP(pp_next)
     if (cxix < cxstack_ix)
        dounwind(cxix);
 
+    /* clear off anything above the scope we're re-entering, but
+     * save the rest until after a possible continue block */
+    inner = PL_scopestack_ix;
     TOPBLOCK(cx);
-
-    /* clean scope, but only if there's no continue block */
-    if (!(cx->blk_loop.last_op->op_private & OPpLOOP_CONTINUE)) {
-       oldsave = PL_scopestack[PL_scopestack_ix - 1];
-       LEAVE_SCOPE(oldsave);
-    }
+    if (PL_scopestack_ix < inner)
+       leave_scope(PL_scopestack[PL_scopestack_ix]);
     return cx->blk_loop.next_op;
 }
 
@@ -2757,6 +2765,7 @@ S_doeval(pTHX_ int gimme, OP** startop)
     SAVESPTR(PL_beginav);
     PL_beginav = newAV();
     SAVEFREESV(PL_beginav);
+    SAVEI32(PL_error_count);
 
     /* try to compile it */
 
@@ -2910,8 +2919,8 @@ PP(pp_require)
 
     sv = POPs;
     if (SvNIOKp(sv)) {
-       UV rev, ver, sver;
-       if (SvPOKp(sv)) {               /* require v5.6.1 */
+       if (SvPOK(sv) && SvNOK(sv)) {           /* require v5.6.1 */
+           UV rev = 0, ver = 0, sver = 0;
            I32 len;
            U8 *s = (U8*)SvPVX(sv);
            U8 *end = (U8*)SvPVX(sv) + SvCUR(sv);
@@ -2923,14 +2932,8 @@ PP(pp_require)
                    s += len;
                    if (s < end)
                        sver = utf8_to_uv(s, &len);
-                   else
-                       sver = 0;
                }
-               else
-                   ver = 0;
            }
-           else
-               rev = 0;
            if (PERL_REVISION < rev
                || (PERL_REVISION == rev
                    && (PERL_VERSION < ver
@@ -2941,6 +2944,7 @@ PP(pp_require)
                    "v%d.%d.%d, stopped", rev, ver, sver, PERL_REVISION,
                    PERL_VERSION, PERL_SUBVERSION);
            }
+           RETPUSHYES;
        }
        else if (!SvPOKp(sv)) {                 /* require 5.005_03 */
            if ((NV)PERL_REVISION + ((NV)PERL_VERSION/(NV)1000)
@@ -2969,8 +2973,8 @@ PP(pp_require)
                        PERL_SUBVERSION);
                }
            }
+           RETPUSHYES;
        }
-       RETPUSHYES;
     }
     name = SvPV(sv, len);
     if (!(name && len > 0 && *name))
@@ -3261,9 +3265,11 @@ PP(pp_entereval)
     SAVEHINTS();
     PL_hints = PL_op->op_targ;
     SAVESPTR(PL_compiling.cop_warnings);
-    if (!specialWARN(PL_compiling.cop_warnings)) {
-        PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
-        SAVEFREESV(PL_compiling.cop_warnings) ;
+    if (specialWARN(PL_curcop->cop_warnings))
+        PL_compiling.cop_warnings = PL_curcop->cop_warnings;
+    else {
+        PL_compiling.cop_warnings = newSVsv(PL_curcop->cop_warnings);
+        SAVEFREESV(PL_compiling.cop_warnings);
     }
 
     push_return(PL_op->op_next);