This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fixed some spelling errors
[perl5.git] / pp_ctl.c
index af08661..e9b4bfc 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1,7 +1,7 @@
 /*    pp_ctl.c
  *
- *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -9,12 +9,14 @@
  */
 
 /*
- * Now far ahead the Road has gone,
- * And I must follow, if I can,
- * Pursuing it with eager feet,
- * Until it joins some larger way
- * Where many paths and errands meet.
- * And whither then?  I cannot say.
+ *      Now far ahead the Road has gone,
+ *          And I must follow, if I can,
+ *      Pursuing it with eager feet,
+ *          Until it joins some larger way
+ *      Where many paths and errands meet.
+ *          And whither then?  I cannot say.
+ *
+ *     [Bilbo on p.35 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
  */
 
 /* This file contains control-oriented pp ("push/pop") functions that
@@ -95,7 +97,7 @@ PP(pp_regcomp)
        /* multiple args; concatentate them */
        dMARK; dORIGMARK;
        tmpstr = PAD_SV(ARGTARG);
-       sv_setpvn(tmpstr, "", 0);
+       sv_setpvs(tmpstr, "");
        while (++MARK <= SP) {
            if (PL_amagic_generation) {
                SV *sv;
@@ -231,7 +233,6 @@ PP(pp_substcont)
        if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs))
            cx->sb_rxtainted |= 2;
        sv_catsv(dstr, POPs);
-       FREETMPS; /* Prevent excess tmp stack */
 
        /* Are we done */
        if (CxONCE(cx) || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
@@ -298,7 +299,6 @@ PP(pp_substcont)
     { /* Update the pos() information. */
        SV * const sv = cx->sb_targ;
        MAGIC *mg;
-       I32 i;
        SvUPGRADE(sv, SVt_PVMG);
        if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
 #ifdef PERL_OLD_COPY_ON_WRITE
@@ -308,10 +308,7 @@ PP(pp_substcont)
            mg = sv_magicext(sv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
                             NULL, 0);
        }
-       i = m - orig;
-       if (DO_UTF8(sv))
-           sv_pos_b2u(sv, &i);
-       mg->mg_len = i;
+       mg->mg_len = m - orig;
     }
     if (old != rx)
        (void)ReREFCNT_inc(rx);
@@ -360,8 +357,8 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx)
     }
 }
 
-void
-Perl_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
+static void
+S_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
 {
     UV *p = (UV*)*rsp;
     U32 i;
@@ -390,8 +387,8 @@ Perl_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
     }
 }
 
-void
-Perl_rxres_free(pTHX_ void **rsp)
+static void
+S_rxres_free(pTHX_ void **rsp)
 {
     UV * const p = (UV*)*rsp;
 
@@ -443,7 +440,6 @@ PP(pp_formline)
     SV * nsv = NULL;
     OP * parseres = NULL;
     const char *fmt;
-    bool oneline;
 
     if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) {
        if (SvREADONLY(tmpForm)) {
@@ -509,6 +505,7 @@ PP(pp_formline)
                *t = '\0';
                sv_catpvn_utf8_upgrade(PL_formtarget, f, arg, nsv);
                t = SvEND(PL_formtarget);
+               f += arg;
                break;
            }
            if (!targ_is_utf8 && DO_UTF8(tmpForm)) {
@@ -769,51 +766,76 @@ PP(pp_formline)
 
        case FF_LINESNGL:
            chopspace = 0;
-           oneline = TRUE;
-           goto ff_line;
        case FF_LINEGLOB:
-           oneline = FALSE;
-       ff_line:
            {
+               const bool oneline = fpc[-1] == FF_LINESNGL;
                const char *s = item = SvPV_const(sv, len);
+               item_is_utf8 = DO_UTF8(sv);
                itemsize = len;
-               if ((item_is_utf8 = DO_UTF8(sv)))
-                   itemsize = sv_len_utf8(sv);
                if (itemsize) {
-                   bool chopped = FALSE;
+                   STRLEN to_copy = itemsize;
                    const char *const send = s + len;
+                   const U8 *source = (const U8 *) s;
+                   U8 *tmp = NULL;
+
                    gotsome = TRUE;
                    chophere = s + itemsize;
                    while (s < send) {
                        if (*s++ == '\n') {
                            if (oneline) {
-                               chopped = TRUE;
+                               to_copy = s - SvPVX_const(sv) - 1;
                                chophere = s;
                                break;
                            } else {
                                if (s == send) {
                                    itemsize--;
-                                   chopped = TRUE;
+                                   to_copy--;
                                } else
                                    lines++;
                            }
                        }
                    }
-                   SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
-                   if (targ_is_utf8)
-                       SvUTF8_on(PL_formtarget);
-                   if (oneline) {
-                       SvCUR_set(sv, chophere - item);
-                       sv_catsv(PL_formtarget, sv);
-                       SvCUR_set(sv, itemsize);
-                   } else
-                       sv_catsv(PL_formtarget, sv);
-                   if (chopped)
-                       SvCUR_set(PL_formtarget, SvCUR(PL_formtarget) - 1);
-                   SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1);
+                   if (targ_is_utf8 && !item_is_utf8) {
+                       source = tmp = bytes_to_utf8(source, &to_copy);
+                       SvCUR_set(PL_formtarget,
+                                 t - SvPVX_const(PL_formtarget));
+                   } else {
+                       if (item_is_utf8 && !targ_is_utf8) {
+                           /* Upgrade targ to UTF8, and then we reduce it to
+                              a problem we have a simple solution for.  */
+                           SvCUR_set(PL_formtarget,
+                                     t - SvPVX_const(PL_formtarget));
+                           targ_is_utf8 = TRUE;
+                           /* Don't need get magic.  */
+                           sv_utf8_upgrade_flags(PL_formtarget, 0);
+                       } else {
+                           SvCUR_set(PL_formtarget,
+                                     t - SvPVX_const(PL_formtarget));
+                       }
+
+                       /* Easy. They agree.  */
+                       assert (item_is_utf8 == targ_is_utf8);
+                   }
+                   SvGROW(PL_formtarget,
+                          SvCUR(PL_formtarget) + to_copy + fudge + 1);
                    t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget);
-                   if (item_is_utf8)
-                       targ_is_utf8 = TRUE;
+
+                   Copy(source, t, to_copy, char);
+                   t += to_copy;
+                   SvCUR_set(PL_formtarget, SvCUR(PL_formtarget) + to_copy);
+                   if (item_is_utf8) {
+                       if (SvGMAGICAL(sv)) {
+                           /* Mustn't call sv_pos_b2u() as it does a second
+                              mg_get(). Is this a bug? Do we need a _flags()
+                              variant? */
+                           itemsize = utf8_length(source, source + itemsize);
+                       } else {
+                           sv_pos_b2u(sv, &itemsize);
+                       }
+                       assert(!tmp);
+                   } else if (tmp) {
+                       Safefree(tmp);
+                   }
                }
                break;
            }
@@ -966,7 +988,7 @@ PP(pp_grepstart)
     if (PL_op->op_private & OPpGREP_LEX)
        PAD_SVl(PL_op->op_targ) = src;
     else
-       DEFSV = src;
+       DEFSV_set(src);
 
     PUTBACK;
     if (PL_op->op_type == OP_MAPSTART)
@@ -1077,7 +1099,7 @@ PP(pp_mapwhile)
        if (PL_op->op_private & OPpGREP_LEX)
            PAD_SVl(PL_op->op_targ) = src;
        else
-           DEFSV = src;
+           DEFSV_set(src);
 
        RETURNOP(cLOGOP->op_other);
     }
@@ -1134,7 +1156,7 @@ PP(pp_flip)
                RETURNOP(((LOGOP*)cUNOP->op_first)->op_other);
            }
        }
-       sv_setpvn(TARG, "", 0);
+       sv_setpvs(TARG, "");
        SETs(targ);
        RETURN;
     }
@@ -1517,7 +1539,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
                SV * const err = ERRSV;
                const char *e = NULL;
                if (!SvPOK(err))
-                   sv_setpvn(err,"",0);
+                   sv_setpvs(err,"");
                else if (SvCUR(err) >= sizeof(prefix)+msglen-1) {
                    STRLEN len;
                    e = SvPV_const(err, len);
@@ -1531,7 +1553,8 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
                    sv_catpvn(err, message, msglen);
                    if (ckWARN(WARN_MISC)) {
                        const STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
-                       Perl_warner(aTHX_ packWARN(WARN_MISC), SvPVX_const(err)+start);
+                       Perl_warner(aTHX_ packWARN(WARN_MISC), "%s",
+                               SvPVX_const(err)+start);
                    }
                }
            }
@@ -1771,8 +1794,8 @@ PP(pp_caller)
 
     PUSHs(cx->blk_oldcop->cop_hints_hash ?
          sv_2mortal(newRV_noinc(
-           (SV*)Perl_refcounted_he_chain_2hv(aTHX_
-                                             cx->blk_oldcop->cop_hints_hash)))
+                                MUTABLE_SV(Perl_refcounted_he_chain_2hv(aTHX_
+                                             cx->blk_oldcop->cop_hints_hash))))
          : &PL_sv_undef);
     RETURN;
 }
@@ -1874,7 +1897,7 @@ PP(pp_enteriter)
 #endif
     }
     else {
-       GV * const gv = (GV*)POPs;
+       GV * const gv = MUTABLE_GV(POPs);
        svp = &GvSV(gv);                        /* symbol table variable */
        SAVEGENERICSV(*svp);
        *svp = newSV(0);
@@ -1956,7 +1979,7 @@ PP(pp_enteriter)
            }
        }
        else /* SvTYPE(maybe_ary) == SVt_PVAV */ {
-           cx->blk_loop.state_u.ary.ary = (AV*)maybe_ary;
+           cx->blk_loop.state_u.ary.ary = MUTABLE_AV(maybe_ary);
            SvREFCNT_inc(maybe_ary);
            cx->blk_loop.state_u.ary.ix =
                (PL_op->op_private & OPpITER_REVERSED) ?
@@ -2153,8 +2176,9 @@ PP(pp_return)
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
     LEAVESUB(sv);
-    if (clear_errsv)
-       sv_setpvn(ERRSV,"",0);
+    if (clear_errsv) {
+       CLEAR_ERRSV();
+    }
     return retop;
 }
 
@@ -2349,7 +2373,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
        /* First try all the kids at this level, since that's likeliest. */
        for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
            if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
-                   kCOP->cop_label && strEQ(kCOP->cop_label, label))
+                   CopLABEL(kCOP) && strEQ(CopLABEL(kCOP), label))
                return kid;
        }
        for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
@@ -2391,7 +2415,7 @@ PP(pp_goto)
        if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
            I32 cxix;
            register PERL_CONTEXT *cx;
-           CV* cv = (CV*)SvRV(sv);
+           CV *cv = MUTABLE_CV(SvRV(sv));
            SV** mark;
            I32 items = 0;
            I32 oldsave;
@@ -2453,7 +2477,7 @@ PP(pp_goto)
                    av = newAV();
                    av_extend(av, items-1);
                    AvREIFY_only(av);
-                   PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av);
+                   PAD_SVl(0) = MUTABLE_SV(cx->blk_sub.argarray = av);
                }
            }
            else if (CvISXSUB(cv)) {    /* put GvAV(defgv) back onto stack */
@@ -2514,10 +2538,10 @@ PP(pp_goto)
                PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
                if (CxHASARGS(cx))
                {
-                   AV* const av = (AV*)PAD_SVl(0);
+                   AV *const av = MUTABLE_AV(PAD_SVl(0));
 
                    cx->blk_sub.savearray = GvAV(PL_defgv);
-                   GvAV(PL_defgv) = (AV*)SvREFCNT_inc_simple(av);
+                   GvAV(PL_defgv) = MUTABLE_AV(SvREFCNT_inc_simple(av));
                    CX_CURPAD_SAVE(cx->blk_sub);
                    cx->blk_sub.argarray = av;
 
@@ -2555,7 +2579,7 @@ PP(pp_goto)
                        CV * const gotocv = get_cv("DB::goto", FALSE);
                        if (gotocv) {
                            PUSHMARK( PL_stack_sp );
-                           call_sv((SV*)gotocv, G_SCALAR | G_NODEBUG);
+                           call_sv(MUTABLE_SV(gotocv), G_SCALAR | G_NODEBUG);
                            PL_stack_sp--;
                        }
                    }
@@ -2740,7 +2764,7 @@ S_save_lines(pTHX_ AV *array, SV *sv)
        const char *t;
        SV * const tmpstr = newSV_type(SVt_PVMG);
 
-       t = strchr(s, '\n');
+       t = (const char *)memchr(s, '\n', send - s);
        if (t)
            t++;
        else
@@ -2885,7 +2909,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     (*startop)->op_ppaddr = PL_ppaddr[OP_NULL];
     lex_end();
     /* XXX DAPM do this properly one year */
-    *padp = (AV*)SvREFCNT_inc_simple(PL_comppad);
+    *padp = MUTABLE_AV(SvREFCNT_inc_simple(PL_comppad));
     LEAVE;
     if (IN_PERL_COMPILETIME)
        CopHINTS_set(&PL_compiling, PL_hints);
@@ -2962,13 +2986,13 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     PUSHMARK(SP);
 
     SAVESPTR(PL_compcv);
-    PL_compcv = (CV*)newSV_type(SVt_PVCV);
+    PL_compcv = MUTABLE_CV(newSV_type(SVt_PVCV));
     CvEVAL_on(PL_compcv);
     assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
     cxstack[cxstack_ix].blk_eval.cv = PL_compcv;
 
     CvOUTSIDE_SEQ(PL_compcv) = seq;
-    CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc_simple(outside);
+    CvOUTSIDE(PL_compcv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
 
     /* set up a scratch pad */
 
@@ -3006,7 +3030,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     if (saveop && (saveop->op_type != OP_REQUIRE) && (saveop->op_flags & OPf_SPECIAL))
        PL_in_eval |= EVAL_KEEPERR;
     else
-       sv_setpvn(ERRSV,"",0);
+       CLEAR_ERRSV();
     if (yyparse() || PL_parser->error_count || !PL_eval_root) {
        SV **newsp;                     /* Used by POPBLOCK. */
        PERL_CONTEXT *cx = &cxstack[cxstack_ix];
@@ -3024,7 +3048,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
            POPEVAL(cx);
        }
        lex_end();
-       LEAVE;
+       LEAVE; /* pp_entereval knows about this LEAVE.  */
 
        msg = SvPVx_nolen_const(ERRSV);
        if (optype == OP_REQUIRE) {
@@ -3079,9 +3103,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
        if (cv) {
            dSP;
            PUSHMARK(SP);
-           XPUSHs((SV*)CopFILEGV(&PL_compiling));
+           XPUSHs(MUTABLE_SV(CopFILEGV(&PL_compiling)));
            PUTBACK;
-           call_sv((SV*)cv, G_DISCARD);
+           call_sv(MUTABLE_SV(cv), G_DISCARD);
        }
     }
 
@@ -3187,14 +3211,14 @@ PP(pp_require)
                I32 first = 0;
                AV *lav;
                SV * const req = SvRV(sv);
-               SV * const pv = *hv_fetchs((HV*)req, "original", FALSE);
+               SV * const pv = *hv_fetchs(MUTABLE_HV(req), "original", FALSE);
 
                /* get the left hand term */
-               lav = (AV *)SvRV(*hv_fetchs((HV*)req, "version", FALSE));
+               lav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(req), "version", FALSE)));
 
                first  = SvIV(*av_fetch(lav,0,0));
                if (   first > (int)PERL_REVISION    /* probably 'use 6.0' */
-                   || hv_exists((HV*)req, "qv", 2 ) /* qv style */
+                   || hv_exists(MUTABLE_HV(req), "qv", 2 ) /* qv style */
                    || av_len(lav) > 1               /* FP with > 3 digits */
                    || strstr(SvPVX(pv),".0")        /* FP with leading 0 */
                   ) {
@@ -3303,7 +3327,7 @@ PP(pp_require)
            for (i = 0; i <= AvFILL(ar); i++) {
                SV * const dirsv = *av_fetch(ar, i, TRUE);
 
-               if (SvTIED_mg((SV*)ar, PERL_MAGIC_tied))
+               if (SvTIED_mg((const SV *)ar, PERL_MAGIC_tied))
                    mg_get(dirsv);
                if (SvROK(dirsv)) {
                    int count;
@@ -3313,7 +3337,7 @@ PP(pp_require)
                    if (SvTYPE(SvRV(loader)) == SVt_PVAV
                        && !sv_isobject(loader))
                    {
-                       loader = *av_fetch((AV *)SvRV(loader), 0, TRUE);
+                       loader = *av_fetch(MUTABLE_AV(SvRV(loader)), 0, TRUE);
                    }
 
                    Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s",
@@ -3357,12 +3381,12 @@ PP(pp_require)
                            }
                        }
 
-                       if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVGV) {
+                       if (SvROK(arg) && isGV_with_GP(SvRV(arg))) {
                            arg = SvRV(arg);
                        }
 
-                       if (SvTYPE(arg) == SVt_PVGV) {
-                           IO * const io = GvIO((GV *)arg);
+                       if (isGV_with_GP(arg)) {
+                           IO * const io = GvIO((const GV *)arg);
 
                            ++filter_has_file;
 
@@ -3564,7 +3588,10 @@ PP(pp_require)
 
     SAVEHINTS();
     PL_hints = 0;
-    PL_compiling.cop_hints_hash = NULL;
+    if (PL_compiling.cop_hints_hash) {
+       Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash);
+       PL_compiling.cop_hints_hash = NULL;
+    }
 
     SAVECOMPILEWARNINGS();
     if (PL_dowarn & G_WARN_ALL_ON)
@@ -3577,9 +3604,9 @@ PP(pp_require)
     if (filter_sub || filter_cache) {
        SV * const datasv = filter_add(S_run_user_filter, NULL);
        IoLINES(datasv) = filter_has_file;
-       IoTOP_GV(datasv) = (GV *)filter_state;
-       IoBOTTOM_GV(datasv) = (GV *)filter_sub;
-       IoFMT_GV(datasv) = (GV *)filter_cache;
+       IoTOP_GV(datasv) = MUTABLE_GV(filter_state);
+       IoBOTTOM_GV(datasv) = MUTABLE_GV(filter_sub);
+       IoFMT_GV(datasv) = MUTABLE_GV(filter_cache);
     }
 
     /* switch to eval mode */
@@ -3607,26 +3634,35 @@ PP(pp_require)
     return op;
 }
 
+/* This is a op added to hold the hints hash for
+   pp_entereval. The hash can be modified by the code
+   being eval'ed, so we return a copy instead. */
+
+PP(pp_hintseval)
+{
+    dVAR;
+    dSP;
+    mXPUSHs(MUTABLE_SV(Perl_hv_copy_hints_hv(aTHX_ MUTABLE_HV(cSVOP_sv))));
+    RETURN;
+}
+
+
 PP(pp_entereval)
 {
     dVAR; dSP;
     register PERL_CONTEXT *cx;
     SV *sv;
     const I32 gimme = GIMME_V;
-    const I32 was = PL_sub_generation;
+    const U32 was = PL_breakable_sub_gen;
     char tbuf[TYPE_DIGITS(long) + 12];
     char *tmpbuf = tbuf;
-    char *safestr;
     STRLEN len;
-    bool ok;
     CV* runcv;
     U32 seq;
     HV *saved_hh = NULL;
-    const char * const fakestr = "_<(eval )";
-    const int fakelen = 9 + 1;
-    
+
     if (PL_op->op_private & OPpEVAL_HAS_HH) {
-       saved_hh = (HV*) SvREFCNT_inc(POPs);
+       saved_hh = MUTABLE_HV(SvREFCNT_inc(POPs));
     }
     sv = POPs;
 
@@ -3658,8 +3694,6 @@ PP(pp_entereval)
        (i.e. before run-time proper). To work around the coredump that
        ensues, we always turn GvMULTI_on for any globals that were
        introduced within evals. See force_ident(). GSAR 96-10-12 */
-    safestr = savepvn(tmpbuf, len);
-    SAVEDELETE(PL_defstash, safestr, len);
     SAVEHINTS();
     PL_hints = PL_op->op_targ;
     if (saved_hh)
@@ -3688,16 +3722,32 @@ PP(pp_entereval)
 
     /* prepare to compile string */
 
-    if (PERLDB_LINE && PL_curstash != PL_debstash)
+    if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
        save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
     PUTBACK;
-    ok = doeval(gimme, NULL, runcv, seq);
-    if (PERLDB_INTER && was != (I32)PL_sub_generation /* Some subs defined here. */
-       && ok) {
-       /* Copy in anything fake and short. */
-       my_strlcpy(safestr, fakestr, fakelen);
+
+    if (doeval(gimme, NULL, runcv, seq)) {
+       if (was != PL_breakable_sub_gen /* Some subs defined here. */
+           ? (PERLDB_LINE || PERLDB_SAVESRC)
+           :  PERLDB_SAVESRC_NOSUBS) {
+           /* Retain the filegv we created.  */
+       } else {
+           char *const safestr = savepvn(tmpbuf, len);
+           SAVEDELETE(PL_defstash, safestr, len);
+       }
+       return DOCATCH(PL_eval_start);
+    } else {
+       /* We have already left the scope set up earler thanks to the LEAVE
+          in doeval().  */
+       if (was != PL_breakable_sub_gen /* Some subs defined here. */
+           ? (PERLDB_LINE || PERLDB_SAVESRC)
+           :  PERLDB_SAVESRC_INVALID) {
+           /* Retain the filegv we created.  */
+       } else {
+           (void)hv_delete(PL_defstash, tmpbuf, len, G_DISCARD);
+       }
+       return PL_op->op_next;
     }
-    return ok ? DOCATCH(PL_eval_start) : PL_op->op_next;
 }
 
 PP(pp_leaveeval)
@@ -3761,8 +3811,9 @@ PP(pp_leaveeval)
     }
     else {
        LEAVE;
-       if (!(save_flags & OPf_SPECIAL))
-           sv_setpvn(ERRSV,"",0);
+       if (!(save_flags & OPf_SPECIAL)) {
+           CLEAR_ERRSV();
+       }
     }
 
     RETURNOP(retop);
@@ -3806,7 +3857,7 @@ Perl_create_eval_scope(pTHX_ U32 flags)
     if (flags & G_KEEPERR)
        PL_in_eval |= EVAL_KEEPERR;
     else
-       sv_setpvn(ERRSV,"",0);
+       CLEAR_ERRSV();
     if (flags & G_FAKINGEVAL) {
        PL_eval_root = PL_op; /* Only needed so that goto works right. */
     }
@@ -3865,7 +3916,7 @@ PP(pp_leavetry)
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
     LEAVE;
-    sv_setpvn(ERRSV,"",0);
+    CLEAR_ERRSV();
     RETURN;
 }
 
@@ -4001,6 +4052,11 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
        && (Other = d)) )
        
 
+#   define SM_OBJECT ( \
+          (sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP))          \
+    ||                                                                 \
+          (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)) )        \
+
 #   define SM_OTHER_REF(type) \
        (SvROK(Other) && SvTYPE(SvRV(Other)) == SVt_##type)
 
@@ -4032,6 +4088,9 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
     if (SvGMAGICAL(e))
        e = sv_mortalcopy(e);
 
+    if (SM_OBJECT)
+       Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
+
     if (SM_CV_NEP) {
        I32 c;
        
@@ -4062,7 +4121,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
        if (SM_OTHER_REF(PVHV)) {
            /* Check that the key-sets are identical */
            HE *he;
-           HV *other_hv = (HV *) SvRV(Other);
+           HV *other_hv = MUTABLE_HV(SvRV(Other));
            bool tied = FALSE;
            bool other_tied = FALSE;
            U32 this_key_count  = 0,
@@ -4072,29 +4131,29 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            if (SvTIED_mg(This, PERL_MAGIC_tied)) {
                tied = TRUE;
            }
-           else if (SvTIED_mg((SV *) other_hv, PERL_MAGIC_tied)) {
+           else if (SvTIED_mg((const SV *)other_hv, PERL_MAGIC_tied)) {
                HV * const temp = other_hv;
-               other_hv = (HV *) This;
-               This  = (SV *) temp;
+               other_hv = MUTABLE_HV(This);
+               This  = MUTABLE_SV(temp);
                tied = TRUE;
            }
-           if (SvTIED_mg((SV *) other_hv, PERL_MAGIC_tied))
+           if (SvTIED_mg((const SV *)other_hv, PERL_MAGIC_tied))
                other_tied = TRUE;
            
-           if (!tied && HvUSEDKEYS((HV *) This) != HvUSEDKEYS(other_hv))
+           if (!tied && HvUSEDKEYS((const HV *) This) != HvUSEDKEYS(other_hv))
                RETPUSHNO;
 
            /* The hashes have the same number of keys, so it suffices
               to check that one is a subset of the other. */
-           (void) hv_iterinit((HV *) This);
-           while ( (he = hv_iternext((HV *) This)) ) {
+           (void) hv_iterinit(MUTABLE_HV(This));
+           while ( (he = hv_iternext(MUTABLE_HV(This))) ) {
                I32 key_len;
                char * const key = hv_iterkey(he, &key_len);
                
                ++ this_key_count;
                
                if(!hv_exists(other_hv, key, key_len)) {
-                   (void) hv_iterinit((HV *) This);    /* reset iterator */
+                   (void) hv_iterinit(MUTABLE_HV(This));       /* reset iterator */
                    RETPUSHNO;
                }
            }
@@ -4113,7 +4172,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
                RETPUSHYES;
        }
        else if (SM_OTHER_REF(PVAV)) {
-           AV * const other_av = (AV *) SvRV(Other);
+           AV * const other_av = MUTABLE_AV(SvRV(Other));
            const I32 other_len = av_len(other_av) + 1;
            I32 i;
 
@@ -4124,7 +4183,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 
                if (svp) {      /* ??? When can this not happen? */
                    key = SvPV(*svp, key_len);
-                   if (hv_exists((HV *) This, key, key_len))
+                   if (hv_exists(MUTABLE_HV(This), key, key_len))
                        RETPUSHYES;
                }
            }
@@ -4134,10 +4193,10 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            PMOP * const matcher = make_matcher(other_regex);
            HE *he;
 
-           (void) hv_iterinit((HV *) This);
-           while ( (he = hv_iternext((HV *) This)) ) {
+           (void) hv_iterinit(MUTABLE_HV(This));
+           while ( (he = hv_iternext(MUTABLE_HV(This))) ) {
                if (matcher_matches_sv(matcher, hv_iterkeysv(he))) {
-                   (void) hv_iterinit((HV *) This);
+                   (void) hv_iterinit(MUTABLE_HV(This));
                    destroy_matcher(matcher);
                    RETPUSHYES;
                }
@@ -4146,7 +4205,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            RETPUSHNO;
        }
        else {
-           if (hv_exists_ent((HV *) This, Other, 0))
+           if (hv_exists_ent(MUTABLE_HV(This), Other, 0))
                RETPUSHYES;
            else
                RETPUSHNO;
@@ -4154,8 +4213,8 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
     }
     else if (SM_REF(PVAV)) {
        if (SM_OTHER_REF(PVAV)) {
-           AV *other_av = (AV *) SvRV(Other);
-           if (av_len((AV *) This) != av_len(other_av))
+           AV *other_av = MUTABLE_AV(SvRV(Other));
+           if (av_len(MUTABLE_AV(This)) != av_len(other_av))
                RETPUSHNO;
            else {
                I32 i;
@@ -4163,14 +4222,14 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 
                if (NULL == seen_this) {
                    seen_this = newHV();
-                   (void) sv_2mortal((SV *) seen_this);
+                   (void) sv_2mortal(MUTABLE_SV(seen_this));
                }
                if (NULL == seen_other) {
                    seen_this = newHV();
-                   (void) sv_2mortal((SV *) seen_other);
+                   (void) sv_2mortal(MUTABLE_SV(seen_other));
                }
                for(i = 0; i <= other_len; ++i) {
-                   SV * const * const this_elem = av_fetch((AV *)This, i, FALSE);
+                   SV * const * const this_elem = av_fetch(MUTABLE_AV(This), i, FALSE);
                    SV * const * const other_elem = av_fetch(other_av, i, FALSE);
 
                    if (!this_elem || !other_elem) {
@@ -4206,11 +4265,11 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
        }
        else if (SM_OTHER_REGEX) {
            PMOP * const matcher = make_matcher(other_regex);
-           const I32 this_len = av_len((AV *) This);
+           const I32 this_len = av_len(MUTABLE_AV(This));
            I32 i;
 
            for(i = 0; i <= this_len; ++i) {
-               SV * const * const svp = av_fetch((AV *)This, i, FALSE);
+               SV * const * const svp = av_fetch(MUTABLE_AV(This), i, FALSE);
                if (svp && matcher_matches_sv(matcher, *svp)) {
                    destroy_matcher(matcher);
                    RETPUSHYES;
@@ -4222,8 +4281,8 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
        else if (SvIOK(Other) || SvNOK(Other)) {
            I32 i;
 
-           for(i = 0; i <= AvFILL((AV *) This); ++i) {
-               SV * const * const svp = av_fetch((AV *)This, i, FALSE);
+           for(i = 0; i <= AvFILL(MUTABLE_AV(This)); ++i) {
+               SV * const * const svp = av_fetch(MUTABLE_AV(This), i, FALSE);
                if (!svp)
                    continue;
                
@@ -4241,11 +4300,11 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            RETPUSHNO;
        }
        else if (SvPOK(Other)) {
-           const I32 this_len = av_len((AV *) This);
+           const I32 this_len = av_len(MUTABLE_AV(This));
            I32 i;
 
            for(i = 0; i <= this_len; ++i) {
-               SV * const * const svp = av_fetch((AV *)This, i, FALSE);
+               SV * const * const svp = av_fetch(MUTABLE_AV(This), i, FALSE);
                if (!svp)
                    continue;
                
@@ -4692,8 +4751,8 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     dVAR;
     SV * const datasv = FILTER_DATA(idx);
     const int filter_has_file = IoLINES(datasv);
-    SV * const filter_state = (SV *)IoTOP_GV(datasv);
-    SV * const filter_sub = (SV *)IoBOTTOM_GV(datasv);
+    SV * const filter_state = MUTABLE_SV(IoTOP_GV(datasv));
+    SV * const filter_sub = MUTABLE_SV(IoBOTTOM_GV(datasv));
     int status = 0;
     SV *upstream;
     STRLEN got_len;
@@ -4713,7 +4772,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
        not sure where the trouble is yet.  XXX */
 
     if (IoFMT_GV(datasv)) {
-       SV *const cache = (SV *)IoFMT_GV(datasv);
+       SV *const cache = MUTABLE_SV(IoFMT_GV(datasv));
        if (SvOK(cache)) {
            STRLEN cache_len;
            const char *cache_p = SvPV(cache, cache_len);
@@ -4772,7 +4831,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
        SAVETMPS;
        EXTEND(SP, 2);
 
-       DEFSV = upstream;
+       DEFSV_set(upstream);
        PUSHMARK(SP);
        mPUSHi(0);
        if (filter_state) {
@@ -4812,10 +4871,10 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     if (prune_from) {
        /* Oh. Too long. Stuff some in our cache.  */
        STRLEN cached_len = got_p + got_len - prune_from;
-       SV *cache = (SV *)IoFMT_GV(datasv);
+       SV *cache = MUTABLE_SV(IoFMT_GV(datasv));
 
        if (!cache) {
-           IoFMT_GV(datasv) = (GV*) (cache = newSV(got_len - umaxlen));
+           IoFMT_GV(datasv) = MUTABLE_GV((cache = newSV(got_len - umaxlen)));
        } else if (SvOK(cache)) {
            /* Cache should be empty.  */
            assert(!SvCUR(cache));