This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Merge branch 'blead' into dual/Safe
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 92a5c34..e03997a 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1,7 +1,7 @@
 /*    op.c
  *
 /*    op.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.
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -9,11 +9,13 @@
  */
 
 /*
  */
 
 /*
- * "You see: Mr. Drogo, he married poor Miss Primula Brandybuck.  She was
- * our Mr. Bilbo's first cousin on the mother's side (her mother being the
- * youngest of the Old Took's daughters); and Mr. Drogo was his second
- * cousin.  So Mr. Frodo is his first *and* second cousin, once removed
- * either way, as the saying is, if you follow me."  --the Gaffer
+ * 'You see: Mr. Drogo, he married poor Miss Primula Brandybuck.  She was
+ *  our Mr. Bilbo's first cousin on the mother's side (her mother being the
+ *  youngest of the Old Took's daughters); and Mr. Drogo was his second
+ *  cousin.  So Mr. Frodo is his first *and* second cousin, once removed
+ *  either way, as the saying is, if you follow me.'       --the Gaffer
+ *
+ *     [p.23 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
  */
 
 /* This file contains the functions that create, manipulate and optimize
  */
 
 /* This file contains the functions that create, manipulate and optimize
@@ -55,7 +57,7 @@ context is, either upward in the syntax tree, or either forward or
 backward in the execution order.  (The bottom-up parser builds that
 part of the execution order it knows about, but if you follow the "next"
 links around, you'll find it's actually a closed loop through the
 backward in the execution order.  (The bottom-up parser builds that
 part of the execution order it knows about, but if you follow the "next"
 links around, you'll find it's actually a closed loop through the
-top level node.
+top level node.)
 
 Whenever the bottom-up parser gets to a node that supplies context to
 its components, it invokes that portion of the top-down pass that applies
 
 Whenever the bottom-up parser gets to a node that supplies context to
 its components, it invokes that portion of the top-down pass that applies
@@ -90,7 +92,7 @@ recursive, but it's recursive on basic blocks, not on tree nodes.
    magic type 'H'. This magic (itself) does nothing, but its presence causes
    the values to gain magic type 'h', which has entries for set and clear.
    C<Perl_magic_sethint> updates C<PL_compiling.cop_hints_hash> with a store
    magic type 'H'. This magic (itself) does nothing, but its presence causes
    the values to gain magic type 'h', which has entries for set and clear.
    C<Perl_magic_sethint> updates C<PL_compiling.cop_hints_hash> with a store
-   record, with deletes written by C<Perl_magic_clearhint>. C<SAVE_HINTS>
+   record, with deletes written by C<Perl_magic_clearhint>. C<SAVEHINTS>
    saves the current C<PL_compiling.cop_hints_hash> on the save stack, so that
    it will be correctly restored when any inner compiling scope is exited.
 */
    saves the current C<PL_compiling.cop_hints_hash> on the save stack, so that
    it will be correctly restored when any inner compiling scope is exited.
 */
@@ -101,6 +103,7 @@ recursive, but it's recursive on basic blocks, not on tree nodes.
 #include "keywords.h"
 
 #define CALL_PEEP(o) CALL_FPTR(PL_peepp)(aTHX_ o)
 #include "keywords.h"
 
 #define CALL_PEEP(o) CALL_FPTR(PL_peepp)(aTHX_ o)
+#define CALL_OPFREEHOOK(o) if (PL_opfreehook) CALL_FPTR(PL_opfreehook)(aTHX_ o)
 
 #if defined(PL_OP_SLAB_ALLOC)
 
 
 #if defined(PL_OP_SLAB_ALLOC)
 
@@ -397,14 +400,6 @@ Perl_allocmy(pTHX_ const char *const name)
     /* check for duplicate declaration */
     pad_check_dup(name, is_our, (PL_curstash ? PL_curstash : PL_defstash));
 
     /* check for duplicate declaration */
     pad_check_dup(name, is_our, (PL_curstash ? PL_curstash : PL_defstash));
 
-    if (PL_parser->in_my_stash && *name != '$') {
-       yyerror(Perl_form(aTHX_
-                   "Can't declare class for non-scalar %s in \"%s\"",
-                    name,
-                    is_our ? "our"
-                           : PL_parser->in_my == KEY_state ? "state" : "my"));
-    }
-
     /* allocate a spare slot and store the name in that slot */
 
     off = pad_add_name(name,
     /* allocate a spare slot and store the name in that slot */
 
     off = pad_add_name(name,
@@ -488,6 +483,11 @@ Perl_op_free(pTHX_ OP *o)
        }
     }
 
        }
     }
 
+    /* Call the op_free hook if it has been set. Do it now so that it's called
+     * at the right time for refcounted ops, but still before all of the kids
+     * are freed. */
+    CALL_OPFREEHOOK(o);
+
     if (o->op_flags & OPf_KIDS) {
         register OP *kid, *nextkid;
        for (kid = cUNOPo->op_first; kid; kid = nextkid) {
     if (o->op_flags & OPf_KIDS) {
         register OP *kid, *nextkid;
        for (kid = cUNOPo->op_first; kid; kid = nextkid) {
@@ -495,8 +495,6 @@ Perl_op_free(pTHX_ OP *o)
            op_free(kid);
        }
     }
            op_free(kid);
        }
     }
-    if (type == OP_NULL)
-       type = (OPCODE)o->op_targ;
 
 #ifdef PERL_DEBUG_READONLY_OPS
     Slab_to_rw(o);
 
 #ifdef PERL_DEBUG_READONLY_OPS
     Slab_to_rw(o);
@@ -504,10 +502,16 @@ Perl_op_free(pTHX_ OP *o)
 
     /* COP* is not cleared by op_clear() so that we may track line
      * numbers etc even after null() */
 
     /* COP* is not cleared by op_clear() so that we may track line
      * numbers etc even after null() */
-    if (type == OP_NEXTSTATE || type == OP_DBSTATE) {
+    if (type == OP_NEXTSTATE || type == OP_DBSTATE
+           || (type == OP_NULL /* the COP might have been null'ed */
+               && ((OPCODE)o->op_targ == OP_NEXTSTATE
+                   || (OPCODE)o->op_targ == OP_DBSTATE))) {
        cop_free((COP*)o);
     }
 
        cop_free((COP*)o);
     }
 
+    if (type == OP_NULL)
+       type = (OPCODE)o->op_targ;
+
     op_clear(o);
     if (o->op_latefree) {
        o->op_latefreed = 1;
     op_clear(o);
     if (o->op_latefree) {
        o->op_latefreed = 1;
@@ -548,7 +552,7 @@ Perl_op_clear(pTHX_ OP *o)
     switch (o->op_type) {
     case OP_NULL:      /* Was holding old type, if any. */
        if (PL_madskills && o->op_targ != OP_NULL) {
     switch (o->op_type) {
     case OP_NULL:      /* Was holding old type, if any. */
        if (PL_madskills && o->op_targ != OP_NULL) {
-           o->op_type = (optype)o->op_targ;
+           o->op_type = (Optype)o->op_targ;
            o->op_targ = 0;
            goto retry;
        }
            o->op_targ = 0;
            goto retry;
        }
@@ -580,6 +584,7 @@ Perl_op_clear(pTHX_ OP *o)
        break;
     case OP_METHOD_NAMED:
     case OP_CONST:
        break;
     case OP_METHOD_NAMED:
     case OP_CONST:
+    case OP_HINTSEVAL:
        SvREFCNT_dec(cSVOPo->op_sv);
        cSVOPo->op_sv = NULL;
 #ifdef USE_ITHREADS
        SvREFCNT_dec(cSVOPo->op_sv);
        cSVOPo->op_sv = NULL;
 #ifdef USE_ITHREADS
@@ -630,7 +635,7 @@ Perl_op_clear(pTHX_ OP *o)
            pad_swipe(cPMOPo->op_pmreplrootu.op_pmtargetoff, TRUE);
        }
 #else
            pad_swipe(cPMOPo->op_pmreplrootu.op_pmtargetoff, TRUE);
        }
 #else
-       SvREFCNT_dec((SV*)cPMOPo->op_pmreplrootu.op_pmtargetgv);
+       SvREFCNT_dec(MUTABLE_SV(cPMOPo->op_pmreplrootu.op_pmtargetgv));
 #endif
        /* FALL THROUGH */
     case OP_MATCH:
 #endif
        /* FALL THROUGH */
     case OP_MATCH:
@@ -671,7 +676,6 @@ S_cop_free(pTHX_ COP* cop)
 {
     PERL_ARGS_ASSERT_COP_FREE;
 
 {
     PERL_ARGS_ASSERT_COP_FREE;
 
-    CopLABEL_free(cop);
     CopFILE_free(cop);
     CopSTASH_free(cop);
     if (! specialWARN(cop->cop_warnings))
     CopFILE_free(cop);
     CopSTASH_free(cop);
     if (! specialWARN(cop->cop_warnings))
@@ -691,7 +695,7 @@ S_forget_pmop(pTHX_ PMOP *const o
     PERL_ARGS_ASSERT_FORGET_PMOP;
 
     if (pmstash && !SvIS_FREED(pmstash)) {
     PERL_ARGS_ASSERT_FORGET_PMOP;
 
     if (pmstash && !SvIS_FREED(pmstash)) {
-       MAGIC * const mg = mg_find((SV*)pmstash, PERL_MAGIC_symtab);
+       MAGIC * const mg = mg_find((const SV *)pmstash, PERL_MAGIC_symtab);
        if (mg) {
            PMOP **const array = (PMOP**) mg->mg_ptr;
            U32 count = mg->mg_len / sizeof(PMOP**);
        if (mg) {
            PMOP **const array = (PMOP**) mg->mg_ptr;
            U32 count = mg->mg_len / sizeof(PMOP**);
@@ -779,8 +783,8 @@ Perl_op_refcnt_unlock(pTHX)
 
 #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
 
 
 #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
 
-OP *
-Perl_linklist(pTHX_ OP *o)
+static OP *
+S_linklist(pTHX_ OP *o)
 {
     OP *first;
 
 {
     OP *first;
 
@@ -811,8 +815,8 @@ Perl_linklist(pTHX_ OP *o)
     return o->op_next;
 }
 
     return o->op_next;
 }
 
-OP *
-Perl_scalarkids(pTHX_ OP *o)
+static OP *
+S_scalarkids(pTHX_ OP *o)
 {
     if (o && o->op_flags & OPf_KIDS) {
         OP *kid;
 {
     if (o && o->op_flags & OPf_KIDS) {
         OP *kid;
@@ -910,6 +914,7 @@ Perl_scalar(pTHX_ OP *o)
     case OP_SORT:
        if (ckWARN(WARN_VOID))
            Perl_warner(aTHX_ packWARN(WARN_VOID), "Useless use of sort in scalar context");
     case OP_SORT:
        if (ckWARN(WARN_VOID))
            Perl_warner(aTHX_ packWARN(WARN_VOID), "Useless use of sort in scalar context");
+       break;
     }
     return o;
 }
     }
     return o;
 }
@@ -1133,6 +1138,20 @@ Perl_scalarvoid(pTHX_ OP *o)
 
     case OP_OR:
     case OP_AND:
 
     case OP_OR:
     case OP_AND:
+       kid = cLOGOPo->op_first;
+       if (kid->op_type == OP_NOT
+           && (kid->op_flags & OPf_KIDS)
+           && !PL_madskills) {
+           if (o->op_type == OP_AND) {
+               o->op_type = OP_OR;
+               o->op_ppaddr = PL_ppaddr[OP_OR];
+           } else {
+               o->op_type = OP_AND;
+               o->op_ppaddr = PL_ppaddr[OP_AND];
+           }
+           op_null(kid);
+       }
+
     case OP_DOR:
     case OP_COND_EXPR:
     case OP_ENTERGIVEN:
     case OP_DOR:
     case OP_COND_EXPR:
     case OP_ENTERGIVEN:
@@ -1184,8 +1203,8 @@ Perl_scalarvoid(pTHX_ OP *o)
     return o;
 }
 
     return o;
 }
 
-OP *
-Perl_listkids(pTHX_ OP *o)
+static OP *
+S_listkids(pTHX_ OP *o)
 {
     if (o && o->op_flags & OPf_KIDS) {
         OP *kid;
 {
     if (o && o->op_flags & OPf_KIDS) {
         OP *kid;
@@ -1272,8 +1291,8 @@ Perl_list(pTHX_ OP *o)
     return o;
 }
 
     return o;
 }
 
-OP *
-Perl_scalarseq(pTHX_ OP *o)
+static OP *
+S_scalarseq(pTHX_ OP *o)
 {
     dVAR;
     if (o) {
 {
     dVAR;
     if (o) {
@@ -1745,8 +1764,8 @@ S_is_handle_constructor(const OP *o, I32 numargs)
     }
 }
 
     }
 }
 
-OP *
-Perl_refkids(pTHX_ OP *o, I32 type)
+static OP *
+S_refkids(pTHX_ OP *o, I32 type)
 {
     if (o && o->op_flags & OPf_KIDS) {
         OP *kid;
 {
     if (o && o->op_flags & OPf_KIDS) {
         OP *kid;
@@ -2010,7 +2029,7 @@ Perl_apply_attrs_string(pTHX_ const char *stashpv, CV *cv,
                                  newSVOP(OP_CONST, 0, newSVpv(stashpv,0)),
                                  prepend_elem(OP_LIST,
                                               newSVOP(OP_CONST, 0,
                                  newSVOP(OP_CONST, 0, newSVpv(stashpv,0)),
                                  prepend_elem(OP_LIST,
                                               newSVOP(OP_CONST, 0,
-                                                      newRV((SV*)cv)),
+                                                      newRV(MUTABLE_SV(cv))),
                                                attrs)));
 }
 
                                                attrs)));
 }
 
@@ -2056,8 +2075,8 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
            PL_parser->in_my_stash = NULL;
            apply_attrs(GvSTASH(gv),
                        (type == OP_RV2SV ? GvSV(gv) :
            PL_parser->in_my_stash = NULL;
            apply_attrs(GvSTASH(gv),
                        (type == OP_RV2SV ? GvSV(gv) :
-                        type == OP_RV2AV ? (SV*)GvAV(gv) :
-                        type == OP_RV2HV ? (SV*)GvHV(gv) : (SV*)gv),
+                        type == OP_RV2AV ? MUTABLE_SV(GvAV(gv)) :
+                        type == OP_RV2HV ? MUTABLE_SV(GvHV(gv)) : MUTABLE_SV(gv)),
                        attrs, FALSE);
        }
        o->op_private |= OPpOUR_INTRO;
                        attrs, FALSE);
        }
        o->op_private |= OPpOUR_INTRO;
@@ -2131,14 +2150,6 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs)
 }
 
 OP *
 }
 
 OP *
-Perl_my(pTHX_ OP *o)
-{
-    PERL_ARGS_ASSERT_MY;
-
-    return my_attrs(o, NULL);
-}
-
-OP *
 Perl_sawparens(pTHX_ OP *o)
 {
     PERL_UNUSED_CONTEXT;
 Perl_sawparens(pTHX_ OP *o)
 {
     PERL_UNUSED_CONTEXT;
@@ -2325,14 +2336,13 @@ Perl_newPROG(pTHX_ OP *o)
 
        /* Register with debugger */
        if (PERLDB_INTER) {
 
        /* Register with debugger */
        if (PERLDB_INTER) {
-           CV * const cv
-               = Perl_get_cvn_flags(aTHX_ STR_WITH_LEN("DB::postponed"), 0);
+           CV * const cv = get_cvs("DB::postponed", 0);
            if (cv) {
                dSP;
                PUSHMARK(SP);
            if (cv) {
                dSP;
                PUSHMARK(SP);
-               XPUSHs((SV*)CopFILEGV(&PL_compiling));
+               XPUSHs(MUTABLE_SV(CopFILEGV(&PL_compiling)));
                PUTBACK;
                PUTBACK;
-               call_sv((SV*)cv, G_DISCARD);
+               call_sv(MUTABLE_SV(cv), G_DISCARD);
            }
        }
     }
            }
        }
     }
@@ -2413,8 +2423,8 @@ Perl_jmaybe(pTHX_ OP *o)
     return o;
 }
 
     return o;
 }
 
-OP *
-Perl_fold_constants(pTHX_ register OP *o)
+static OP *
+S_fold_constants(pTHX_ register OP *o)
 {
     dVAR;
     register OP * VOL curop;
 {
     dVAR;
     register OP * VOL curop;
@@ -2426,6 +2436,7 @@ Perl_fold_constants(pTHX_ register OP *o)
     OP *old_next;
     SV * const oldwarnhook = PL_warnhook;
     SV * const olddiehook  = PL_diehook;
     OP *old_next;
     SV * const oldwarnhook = PL_warnhook;
     SV * const olddiehook  = PL_diehook;
+    COP not_compiling;
     dJMPENV;
 
     PERL_ARGS_ASSERT_FOLD_CONSTANTS;
     dJMPENV;
 
     PERL_ARGS_ASSERT_FOLD_CONSTANTS;
@@ -2464,6 +2475,7 @@ Perl_fold_constants(pTHX_ register OP *o)
        /* XXX what about the numeric ops? */
        if (PL_hints & HINT_LOCALE)
            goto nope;
        /* XXX what about the numeric ops? */
        if (PL_hints & HINT_LOCALE)
            goto nope;
+       break;
     }
 
     if (PL_parser && PL_parser->error_count)
     }
 
     if (PL_parser && PL_parser->error_count)
@@ -2489,6 +2501,13 @@ Perl_fold_constants(pTHX_ register OP *o)
     oldscope = PL_scopestack_ix;
     create_eval_scope(G_FAKINGEVAL);
 
     oldscope = PL_scopestack_ix;
     create_eval_scope(G_FAKINGEVAL);
 
+    /* Verify that we don't need to save it:  */
+    assert(PL_curcop == &PL_compiling);
+    StructCopy(&PL_compiling, &not_compiling, COP);
+    PL_curcop = &not_compiling;
+    /* The above ensures that we run with all the correct hints of the
+       currently compiling COP, but that IN_PERL_RUNTIME is not true. */
+    assert(IN_PERL_RUNTIME);
     PL_warnhook = PERL_WARNHOOK_FATAL;
     PL_diehook  = NULL;
     JMPENV_PUSH(ret);
     PL_warnhook = PERL_WARNHOOK_FATAL;
     PL_diehook  = NULL;
     JMPENV_PUSH(ret);
@@ -2507,7 +2526,7 @@ Perl_fold_constants(pTHX_ register OP *o)
     case 3:
        /* Something tried to die.  Abandon constant folding.  */
        /* Pretend the error never happened.  */
     case 3:
        /* Something tried to die.  Abandon constant folding.  */
        /* Pretend the error never happened.  */
-       sv_setpvn(ERRSV,"",0);
+       CLEAR_ERRSV();
        o->op_next = old_next;
        break;
     default:
        o->op_next = old_next;
        break;
     default:
@@ -2522,6 +2541,7 @@ Perl_fold_constants(pTHX_ register OP *o)
     JMPENV_POP;
     PL_warnhook = oldwarnhook;
     PL_diehook  = olddiehook;
     JMPENV_POP;
     PL_warnhook = oldwarnhook;
     PL_diehook  = olddiehook;
+    PL_curcop = &PL_compiling;
 
     if (PL_scopestack_ix > oldscope)
        delete_eval_scope();
 
     if (PL_scopestack_ix > oldscope)
        delete_eval_scope();
@@ -2534,9 +2554,9 @@ Perl_fold_constants(pTHX_ register OP *o)
 #endif
     assert(sv);
     if (type == OP_RV2GV)
 #endif
     assert(sv);
     if (type == OP_RV2GV)
-       newop = newGVOP(OP_GV, 0, (GV*)sv);
+       newop = newGVOP(OP_GV, 0, MUTABLE_GV(sv));
     else
     else
-       newop = newSVOP(OP_CONST, 0, (SV*)sv);
+       newop = newSVOP(OP_CONST, 0, MUTABLE_SV(sv));
     op_getmad(o,newop,'f');
     return newop;
 
     op_getmad(o,newop,'f');
     return newop;
 
@@ -2544,8 +2564,8 @@ Perl_fold_constants(pTHX_ register OP *o)
     return o;
 }
 
     return o;
 }
 
-OP *
-Perl_gen_constant_list(pTHX_ register OP *o)
+static OP *
+S_gen_constant_list(pTHX_ register OP *o)
 {
     dVAR;
     register OP *curop;
 {
     dVAR;
     register OP *curop;
@@ -2750,7 +2770,7 @@ Perl_token_getmad(pTHX_ TOKEN* tk, OP* o, char slot)
     /* faked up qw list? */
     if (slot == '(' &&
        tm->mad_type == MAD_SV &&
     /* faked up qw list? */
     if (slot == '(' &&
        tm->mad_type == MAD_SV &&
-       SvPVX((SV*)tm->mad_val)[0] == 'q')
+       SvPVX((const SV *)tm->mad_val)[0] == 'q')
            slot = 'x';
 
     if (o) {
            slot = 'x';
 
     if (o) {
@@ -2941,7 +2961,7 @@ Perl_mad_free(pTHX_ MADPROP* mp)
            op_free((OP*)mp->mad_val);
        break;
     case MAD_SV:
            op_free((OP*)mp->mad_val);
        break;
     case MAD_SV:
-       sv_free((SV*)mp->mad_val);
+       sv_free(MUTABLE_SV(mp->mad_val));
        break;
     default:
        PerlIO_printf(PerlIO_stderr(), "Unrecognized mad\n");
        break;
     default:
        PerlIO_printf(PerlIO_stderr(), "Unrecognized mad\n");
@@ -2958,8 +2978,8 @@ Perl_newNULLLIST(pTHX)
     return newOP(OP_STUB, 0);
 }
 
     return newOP(OP_STUB, 0);
 }
 
-OP *
-Perl_force_list(pTHX_ OP *o)
+static OP *
+S_force_list(pTHX_ OP *o)
 {
     if (!o || o->op_type != OP_LIST)
        o = newLISTOP(OP_LIST, 0, o, NULL);
 {
     if (!o || o->op_type != OP_LIST)
        o = newLISTOP(OP_LIST, 0, o, NULL);
@@ -3096,8 +3116,8 @@ static int uvcompare(const void *a, const void *b)
     return 0;
 }
 
     return 0;
 }
 
-OP *
-Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
+static OP *
+S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 {
     dVAR;
     SV * const tstr = ((SVOP*)expr)->op_sv;
 {
     dVAR;
     SV * const tstr = ((SVOP*)expr)->op_sv;
@@ -3319,12 +3339,13 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        PerlMemShared_free(cPVOPo->op_pv);
        cPVOPo->op_pv = NULL;
 
        PerlMemShared_free(cPVOPo->op_pv);
        cPVOPo->op_pv = NULL;
 
-       swash = (SV*)swash_init("utf8", "", listsv, bits, none);
+       swash = MUTABLE_SV(swash_init("utf8", "", listsv, bits, none));
 #ifdef USE_ITHREADS
        cPADOPo->op_padix = pad_alloc(OP_TRANS, SVs_PADTMP);
        SvREFCNT_dec(PAD_SVl(cPADOPo->op_padix));
        PAD_SETSV(cPADOPo->op_padix, swash);
        SvPADTMP_on(swash);
 #ifdef USE_ITHREADS
        cPADOPo->op_padix = pad_alloc(OP_TRANS, SVs_PADTMP);
        SvREFCNT_dec(PAD_SVl(cPADOPo->op_padix));
        PAD_SETSV(cPADOPo->op_padix, swash);
        SvPADTMP_on(swash);
+       SvREADONLY_on(swash);
 #else
        cSVOPo->op_sv = swash;
 #endif
 #else
        cSVOPo->op_sv = swash;
 #endif
@@ -3332,7 +3353,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        SvREFCNT_dec(transv);
 
        if (!del && havefinal && rlen)
        SvREFCNT_dec(transv);
 
        if (!del && havefinal && rlen)
-           (void)hv_store((HV*)SvRV(swash), "FINAL", 5,
+           (void)hv_store(MUTABLE_HV(SvRV(swash)), "FINAL", 5,
                           newSVuv((UV)final), 0);
 
        if (grows)
                           newSVuv((UV)final), 0);
 
        if (grows)
@@ -3420,6 +3441,15 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            }
        }
     }
            }
        }
     }
+
+    if(ckWARN(WARN_MISC)) {
+        if(del && rlen == tlen) {
+            Perl_warner(aTHX_ packWARN(WARN_MISC), "Useless use of /d modifier in transliteration operator"); 
+        } else if(rlen > tlen) {
+            Perl_warner(aTHX_ packWARN(WARN_MISC), "Replacement list is longer than search list");
+        } 
+    }
+
     if (grows)
        o->op_private |= OPpTRANS_GROWS;
 #ifdef PERL_MAD
     if (grows)
        o->op_private |= OPpTRANS_GROWS;
 #ifdef PERL_MAD
@@ -3834,7 +3864,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
            SV *meth;
 
            if (version->op_type != OP_CONST || !SvNIOKp(vesv))
            SV *meth;
 
            if (version->op_type != OP_CONST || !SvNIOKp(vesv))
-               Perl_croak(aTHX_ "Version number must be constant number");
+               Perl_croak(aTHX_ "Version number must be a constant number");
 
            /* Make copy of idop so we don't free it twice */
            pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv));
 
            /* Make copy of idop so we don't free it twice */
            pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv));
@@ -3932,7 +3962,11 @@ PERL_LOADMOD_DENY, PERL_LOADMOD_NOIMPORT, or PERL_LOADMOD_IMPORT_OPS
 (or 0 for no flags). ver, if specified, provides version semantics
 similar to C<use Foo::Bar VERSION>.  The optional trailing SV*
 arguments can be used to specify arguments to the module's import()
 (or 0 for no flags). ver, if specified, provides version semantics
 similar to C<use Foo::Bar VERSION>.  The optional trailing SV*
 arguments can be used to specify arguments to the module's import()
-method, similar to C<use Foo::Bar VERSION LIST>.
+method, similar to C<use Foo::Bar VERSION LIST>.  They must be
+terminated with a final NULL pointer.  Note that this list can only
+be omitted when the PERL_LOADMOD_NOIMPORT flag has been used.
+Otherwise at least a single NULL pointer to designate the default
+import list is required.
 
 =cut */
 
 
 =cut */
 
@@ -4235,7 +4269,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                    else if (curop->op_type == OP_PUSHRE) {
 #ifdef USE_ITHREADS
                        if (((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff) {
                    else if (curop->op_type == OP_PUSHRE) {
 #ifdef USE_ITHREADS
                        if (((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff) {
-                           GV *const gv = (GV*)PAD_SVl(((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff);
+                           GV *const gv = MUTABLE_GV(PAD_SVl(((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff));
                            if (gv == PL_defgv
                                || (int)GvASSIGN_GENERATION(gv) == PL_generation)
                                break;
                            if (gv == PL_defgv
                                || (int)GvASSIGN_GENERATION(gv) == PL_generation)
                                break;
@@ -4283,7 +4317,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                        cPADOPx(tmpop)->op_padix = 0;   /* steal it */
 #else
                        pm->op_pmreplrootu.op_pmtargetgv
                        cPADOPx(tmpop)->op_padix = 0;   /* steal it */
 #else
                        pm->op_pmreplrootu.op_pmtargetgv
-                           = (GV*)cSVOPx(tmpop)->op_sv;
+                           = MUTABLE_GV(cSVOPx(tmpop)->op_sv);
                        cSVOPx(tmpop)->op_sv = NULL;    /* steal it */
 #endif
                        pm->op_pmflags |= PMf_ONCE;
                        cSVOPx(tmpop)->op_sv = NULL;    /* steal it */
 #endif
                        pm->op_pmflags |= PMf_ONCE;
@@ -4302,7 +4336,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                      ((LISTOP*)right)->op_last->op_type == OP_CONST)
                    {
                        SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
                      ((LISTOP*)right)->op_last->op_type == OP_CONST)
                    {
                        SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
-                       if (SvIVX(sv) == 0)
+                       if (SvIOK(sv) && SvIVX(sv) == 0)
                            sv_setiv(sv, PL_modcount+1);
                    }
                }
                            sv_setiv(sv, PL_modcount+1);
                    }
                }
@@ -4323,10 +4357,12 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
        if (PL_eval_start)
            PL_eval_start = 0;
        else {
        if (PL_eval_start)
            PL_eval_start = 0;
        else {
-           /* FIXME for MAD */
-           op_free(o);
-           o = newSVOP(OP_CONST, 0, newSViv(CopARYBASE_get(&PL_compiling)));
-           o->op_private |= OPpCONST_ARYBASE;
+           if (!PL_madskills) { /* assignment to $[ is ignored when making a mad dump */
+               deprecate("assignment to $[");
+               op_free(o);
+               o = newSVOP(OP_CONST, 0, newSViv(CopARYBASE_get(&PL_compiling)));
+               o->op_private |= OPpCONST_ARYBASE;
+           }
        }
     }
     return o;
        }
     }
     return o;
@@ -4356,10 +4392,6 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
     CopHINTS_set(&PL_compiling, CopHINTS_get(cop));
     cop->op_next = (OP*)cop;
 
     CopHINTS_set(&PL_compiling, CopHINTS_get(cop));
     cop->op_next = (OP*)cop;
 
-    if (label) {
-       CopLABEL_set(cop, label);
-       PL_hints |= HINT_BLOCK_SCOPE;
-    }
     cop->cop_seq = seq;
     /* CopARYBASE is now "virtual", in that it's stored as a flag bit in
        CopHINTS and a possible value in cop_hints_hash, so no need to copy it.
     cop->cop_seq = seq;
     /* CopARYBASE is now "virtual", in that it's stored as a flag bit in
        CopHINTS and a possible value in cop_hints_hash, so no need to copy it.
@@ -4371,6 +4403,16 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
        cop->cop_hints_hash->refcounted_he_refcnt++;
        HINTS_REFCNT_UNLOCK;
     }
        cop->cop_hints_hash->refcounted_he_refcnt++;
        HINTS_REFCNT_UNLOCK;
     }
+    if (label) {
+       cop->cop_hints_hash
+           = Perl_store_cop_label(aTHX_ cop->cop_hints_hash, label);
+                                                    
+       PL_hints |= HINT_BLOCK_SCOPE;
+       /* It seems that we need to defer freeing this pointer, as other parts
+          of the grammar end up wanting to copy it after this op has been
+          created. */
+       SAVEFREEPV(label);
+    }
 
     if (PL_parser && PL_parser->copline == NOLINE)
         CopLINE_set(cop, CopLINE(PL_curcop));
 
     if (PL_parser && PL_parser->copline == NOLINE)
         CopLINE_set(cop, CopLINE(PL_curcop));
@@ -4386,7 +4428,8 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 #endif
     CopSTASH_set(cop, PL_curstash);
 
 #endif
     CopSTASH_set(cop, PL_curstash);
 
-    if (PERLDB_LINE && PL_curstash != PL_debstash) {
+    if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash) {
+       /* this line can have a breakpoint - store the cop in IV */
        AV *av = CopFILEAVx(PL_curcop);
        if (av) {
            SV * const * const svp = av_fetch(av, (I32)CopLINE(cop), FALSE);
        AV *av = CopFILEAVx(PL_curcop);
        if (av) {
            SV * const * const svp = av_fetch(av, (I32)CopLINE(cop), FALSE);
@@ -4397,6 +4440,8 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
        }
     }
 
        }
     }
 
+    if (flags & OPf_SPECIAL)
+       op_null((OP*)cop);
     return prepend_elem(OP_LINESEQ, (OP*)cop, o);
 }
 
     return prepend_elem(OP_LINESEQ, (OP*)cop, o);
 }
 
@@ -4412,46 +4457,95 @@ Perl_newLOGOP(pTHX_ I32 type, I32 flags, OP *first, OP *other)
 }
 
 STATIC OP *
 }
 
 STATIC OP *
+S_search_const(pTHX_ OP *o)
+{
+    PERL_ARGS_ASSERT_SEARCH_CONST;
+
+    switch (o->op_type) {
+       case OP_CONST:
+           return o;
+       case OP_NULL:
+           if (o->op_flags & OPf_KIDS)
+               return search_const(cUNOPo->op_first);
+           break;
+       case OP_LEAVE:
+       case OP_SCOPE:
+       case OP_LINESEQ:
+       {
+           OP *kid;
+           if (!(o->op_flags & OPf_KIDS))
+               return NULL;
+           kid = cLISTOPo->op_first;
+           do {
+               switch (kid->op_type) {
+                   case OP_ENTER:
+                   case OP_NULL:
+                   case OP_NEXTSTATE:
+                       kid = kid->op_sibling;
+                       break;
+                   default:
+                       if (kid != cLISTOPo->op_last)
+                           return NULL;
+                       goto last;
+               }
+           } while (kid);
+           if (!kid)
+               kid = cLISTOPo->op_last;
+last:
+           return search_const(kid);
+       }
+    }
+
+    return NULL;
+}
+
+STATIC OP *
 S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 {
     dVAR;
     LOGOP *logop;
     OP *o;
 S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 {
     dVAR;
     LOGOP *logop;
     OP *o;
-    OP *first = *firstp;
-    OP * const other = *otherp;
+    OP *first;
+    OP *other;
+    OP *cstop = NULL;
+    int prepend_not = 0;
 
     PERL_ARGS_ASSERT_NEW_LOGOP;
 
 
     PERL_ARGS_ASSERT_NEW_LOGOP;
 
+    first = *firstp;
+    other = *otherp;
+
     if (type == OP_XOR)                /* Not short circuit, but here by precedence. */
        return newBINOP(type, flags, scalar(first), scalar(other));
 
     scalarboolean(first);
     if (type == OP_XOR)                /* Not short circuit, but here by precedence. */
        return newBINOP(type, flags, scalar(first), scalar(other));
 
     scalarboolean(first);
-    /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
+    /* optimize AND and OR ops that have NOTs as children */
     if (first->op_type == OP_NOT
     if (first->op_type == OP_NOT
-       && (first->op_flags & OPf_SPECIAL)
        && (first->op_flags & OPf_KIDS)
        && (first->op_flags & OPf_KIDS)
+       && ((first->op_flags & OPf_SPECIAL) /* unless ($x) { } */
+           || (other->op_type == OP_NOT))  /* if (!$x && !$y) { } */
        && !PL_madskills) {
        if (type == OP_AND || type == OP_OR) {
            if (type == OP_AND)
                type = OP_OR;
            else
                type = OP_AND;
        && !PL_madskills) {
        if (type == OP_AND || type == OP_OR) {
            if (type == OP_AND)
                type = OP_OR;
            else
                type = OP_AND;
-           o = first;
-           first = *firstp = cUNOPo->op_first;
-           if (o->op_next)
-               first->op_next = o->op_next;
-           cUNOPo->op_first = NULL;
-           op_free(o);
+           op_null(first);
+           if (other->op_type == OP_NOT) { /* !a AND|OR !b => !(a OR|AND b) */
+               op_null(other);
+               prepend_not = 1; /* prepend a NOT op later */
+           }
        }
     }
        }
     }
-    if (first->op_type == OP_CONST) {
-       if (first->op_private & OPpCONST_STRICT)
-           no_bareword_allowed(first);
-       else if ((first->op_private & OPpCONST_BARE) && ckWARN(WARN_BAREWORD))
+    /* search for a constant op that could let us fold the test */
+    if ((cstop = search_const(first))) {
+       if (cstop->op_private & OPpCONST_STRICT)
+           no_bareword_allowed(cstop);
+       else if ((cstop->op_private & OPpCONST_BARE) && ckWARN(WARN_BAREWORD))
                Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional");
                Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional");
-       if ((type == OP_AND &&  SvTRUE(((SVOP*)first)->op_sv)) ||
-           (type == OP_OR  && !SvTRUE(((SVOP*)first)->op_sv)) ||
-           (type == OP_DOR && !SvOK(((SVOP*)first)->op_sv))) {
+       if ((type == OP_AND &&  SvTRUE(((SVOP*)cstop)->op_sv)) ||
+           (type == OP_OR  && !SvTRUE(((SVOP*)cstop)->op_sv)) ||
+           (type == OP_DOR && !SvOK(((SVOP*)cstop)->op_sv))) {
            *firstp = NULL;
            if (other->op_type == OP_CONST)
                other->op_private |= OPpCONST_SHORTCIRCUIT;
            *firstp = NULL;
            if (other->op_type == OP_CONST)
                other->op_private |= OPpCONST_SHORTCIRCUIT;
@@ -4462,6 +4556,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
                return newop;
            }
            op_free(first);
                return newop;
            }
            op_free(first);
+           if (other->op_type == OP_LEAVE)
+               other = newUNOP(OP_NULL, OPf_SPECIAL, other);
            return other;
        }
        else {
            return other;
        }
        else {
@@ -4558,7 +4654,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 
     CHECKOP(type,logop);
 
 
     CHECKOP(type,logop);
 
-    o = newUNOP(OP_NULL, 0, (OP*)logop);
+    o = newUNOP(prepend_not ? OP_NOT : OP_NULL, 0, (OP*)logop);
     other->op_next = o;
 
     return o;
     other->op_next = o;
 
     return o;
@@ -4571,6 +4667,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
     LOGOP *logop;
     OP *start;
     OP *o;
     LOGOP *logop;
     OP *start;
     OP *o;
+    OP *cstop;
 
     PERL_ARGS_ASSERT_NEWCONDOP;
 
 
     PERL_ARGS_ASSERT_NEWCONDOP;
 
@@ -4580,14 +4677,14 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
        return newLOGOP(OP_OR, 0, first, falseop);
 
     scalarboolean(first);
        return newLOGOP(OP_OR, 0, first, falseop);
 
     scalarboolean(first);
-    if (first->op_type == OP_CONST) {
+    if ((cstop = search_const(first))) {
        /* Left or right arm of the conditional?  */
        /* Left or right arm of the conditional?  */
-       const bool left = SvTRUE(((SVOP*)first)->op_sv);
+       const bool left = SvTRUE(((SVOP*)cstop)->op_sv);
        OP *live = left ? trueop : falseop;
        OP *const dead = left ? falseop : trueop;
        OP *live = left ? trueop : falseop;
        OP *const dead = left ? falseop : trueop;
-        if (first->op_private & OPpCONST_BARE &&
-           first->op_private & OPpCONST_STRICT) {
-           no_bareword_allowed(first);
+        if (cstop->op_private & OPpCONST_BARE &&
+           cstop->op_private & OPpCONST_STRICT) {
+           no_bareword_allowed(cstop);
        }
        if (PL_madskills) {
            /* This is all dead code when PERL_MAD is not defined.  */
        }
        if (PL_madskills) {
            /* This is all dead code when PERL_MAD is not defined.  */
@@ -4598,6 +4695,8 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
            op_free(first);
            op_free(dead);
        }
            op_free(first);
            op_free(dead);
        }
+       if (live->op_type == OP_LEAVE)
+           live = newUNOP(OP_NULL, OPf_SPECIAL, live);
        return live;
     }
     NewOp(1101, logop, 1, LOGOP);
        return live;
     }
     NewOp(1101, logop, 1, LOGOP);
@@ -5039,7 +5138,7 @@ S_newGIVWHENOP(pTHX_ OP *cond, OP *block,
     PERL_ARGS_ASSERT_NEWGIVWHENOP;
 
     NewOp(1101, enterop, 1, LOGOP);
     PERL_ARGS_ASSERT_NEWGIVWHENOP;
 
     NewOp(1101, enterop, 1, LOGOP);
-    enterop->op_type = (optype)enter_opcode;
+    enterop->op_type = (Optype)enter_opcode;
     enterop->op_ppaddr = PL_ppaddr[enter_opcode];
     enterop->op_flags =  (U8) OPf_KIDS;
     enterop->op_targ = ((entertarg == NOT_IN_PAD) ? 0 : entertarg);
     enterop->op_ppaddr = PL_ppaddr[enter_opcode];
     enterop->op_flags =  (U8) OPf_KIDS;
     enterop->op_targ = ((entertarg == NOT_IN_PAD) ? 0 : entertarg);
@@ -5092,6 +5191,7 @@ S_looks_like_bool(pTHX_ const OP *o)
 
     switch(o->op_type) {
        case OP_OR:
 
     switch(o->op_type) {
        case OP_OR:
+       case OP_DOR:
            return looks_like_bool(cLOGOPo->op_first);
 
        case OP_AND:
            return looks_like_bool(cLOGOPo->op_first);
 
        case OP_AND:
@@ -5107,7 +5207,6 @@ S_looks_like_bool(pTHX_ const OP *o)
        case OP_ENTERSUB:
 
        case OP_NOT:    case OP_XOR:
        case OP_ENTERSUB:
 
        case OP_NOT:    case OP_XOR:
-       /* Note that OP_DOR is not here */
 
        case OP_EQ:     case OP_NE:     case OP_LT:
        case OP_GT:     case OP_LE:     case OP_GE:
 
        case OP_EQ:     case OP_NE:     case OP_LT:
        case OP_GT:     case OP_LE:     case OP_GE:
@@ -5132,6 +5231,8 @@ S_looks_like_bool(pTHX_ const OP *o)
        case OP_DEFINED: case OP_EXISTS:
        case OP_MATCH:   case OP_EOF:
 
        case OP_DEFINED: case OP_EXISTS:
        case OP_MATCH:   case OP_EOF:
 
+       case OP_FLOP:
+
            return TRUE;
        
        case OP_CONST:
            return TRUE;
        
        case OP_CONST:
@@ -5140,7 +5241,9 @@ S_looks_like_bool(pTHX_ const OP *o)
            ||  cSVOPo->op_sv == &PL_sv_no)
            
                return TRUE;
            ||  cSVOPo->op_sv == &PL_sv_no)
            
                return TRUE;
-               
+           else
+               return FALSE;
+
        /* FALL THROUGH */
        default:
            return FALSE;
        /* FALL THROUGH */
        default:
            return FALSE;
@@ -5225,7 +5328,7 @@ Perl_cv_undef(pTHX_ CV *cv)
        CvSTART(cv) = NULL;
        LEAVE;
     }
        CvSTART(cv) = NULL;
        LEAVE;
     }
-    SvPOK_off((SV*)cv);                /* forget prototype */
+    SvPOK_off(MUTABLE_SV(cv));         /* forget prototype */
     CvGV(cv) = NULL;
 
     pad_undef(cv);
     CvGV(cv) = NULL;
 
     pad_undef(cv);
@@ -5237,7 +5340,7 @@ Perl_cv_undef(pTHX_ CV *cv)
        CvOUTSIDE(cv) = NULL;
     }
     if (CvCONST(cv)) {
        CvOUTSIDE(cv) = NULL;
     }
     if (CvCONST(cv)) {
-       SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
+       SvREFCNT_dec(MUTABLE_SV(CvXSUBANY(cv).any_ptr));
        CvCONST_off(cv);
     }
     if (CvISXSUB(cv) && CvXSUB(cv)) {
        CvCONST_off(cv);
     }
     if (CvISXSUB(cv) && CvXSUB(cv)) {
@@ -5297,14 +5400,14 @@ L<perlsub/"Constant Functions">.
 =cut
 */
 SV *
 =cut
 */
 SV *
-Perl_cv_const_sv(pTHX_ CV *cv)
+Perl_cv_const_sv(pTHX_ const CV *const cv)
 {
     PERL_UNUSED_CONTEXT;
     if (!cv)
        return NULL;
     if (!(SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM))
        return NULL;
 {
     PERL_UNUSED_CONTEXT;
     if (!cv)
        return NULL;
     if (!(SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM))
        return NULL;
-    return CvCONST(cv) ? (SV*)CvXSUBANY(cv).any_ptr : NULL;
+    return CvCONST(cv) ? MUTABLE_SV(CvXSUBANY(cv).any_ptr) : NULL;
 }
 
 /* op_const_sv:  examine an optree to determine whether it's in-lineable.
 }
 
 /* op_const_sv:  examine an optree to determine whether it's in-lineable.
@@ -5425,7 +5528,6 @@ CV *
 Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 {
     dVAR;
 Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 {
     dVAR;
-    const char *aname;
     GV *gv;
     const char *ps;
     STRLEN ps_len;
     GV *gv;
     const char *ps;
     STRLEN ps_len;
@@ -5441,6 +5543,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
           || PL_madskills)
        ? GV_ADDMULTI : GV_ADDMULTI | GV_NOINIT;
     const char * const name = o ? SvPV_nolen_const(cSVOPo->op_sv) : NULL;
           || PL_madskills)
        ? GV_ADDMULTI : GV_ADDMULTI | GV_NOINIT;
     const char * const name = o ? SvPV_nolen_const(cSVOPo->op_sv) : NULL;
+    bool has_name;
 
     if (proto) {
        assert(proto->op_type == OP_CONST);
 
     if (proto) {
        assert(proto->op_type == OP_CONST);
@@ -5449,20 +5552,23 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     else
        ps = NULL;
 
     else
        ps = NULL;
 
-    if (!name && PERLDB_NAMEANON && CopLINE(PL_curcop)) {
+    if (name) {
+       gv = gv_fetchsv(cSVOPo->op_sv, gv_fetch_flags, SVt_PVCV);
+       has_name = TRUE;
+    } else if (PERLDB_NAMEANON && CopLINE(PL_curcop)) {
        SV * const sv = sv_newmortal();
        Perl_sv_setpvf(aTHX_ sv, "%s[%s:%"IVdf"]",
                       PL_curstash ? "__ANON__" : "__ANON__::__ANON__",
                       CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
        SV * const sv = sv_newmortal();
        Perl_sv_setpvf(aTHX_ sv, "%s[%s:%"IVdf"]",
                       PL_curstash ? "__ANON__" : "__ANON__::__ANON__",
                       CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
-       aname = SvPVX_const(sv);
+       gv = gv_fetchsv(sv, gv_fetch_flags, SVt_PVCV);
+       has_name = TRUE;
+    } else if (PL_curstash) {
+       gv = gv_fetchpvs("__ANON__", gv_fetch_flags, SVt_PVCV);
+       has_name = FALSE;
+    } else {
+       gv = gv_fetchpvs("__ANON__::__ANON__", gv_fetch_flags, SVt_PVCV);
+       has_name = FALSE;
     }
     }
-    else
-       aname = NULL;
-
-    gv = name ? gv_fetchsv(cSVOPo->op_sv, gv_fetch_flags, SVt_PVCV)
-       : gv_fetchpv(aname ? aname
-                    : (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"),
-                    gv_fetch_flags, SVt_PVCV);
 
     if (!PL_madskills) {
        if (o)
 
     if (!PL_madskills) {
        if (o)
@@ -5476,17 +5582,18 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (SvTYPE(gv) != SVt_PVGV) {      /* Maybe prototype now, and had at
                                           maximum a prototype before. */
        if (SvTYPE(gv) > SVt_NULL) {
     if (SvTYPE(gv) != SVt_PVGV) {      /* Maybe prototype now, and had at
                                           maximum a prototype before. */
        if (SvTYPE(gv) > SVt_NULL) {
-           if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1)
+           if (!SvPOK((const SV *)gv)
+               && !(SvIOK((const SV *)gv) && SvIVX((const SV *)gv) == -1)
                && ckWARN_d(WARN_PROTOTYPE))
            {
                Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "Runaway prototype");
            }
                && ckWARN_d(WARN_PROTOTYPE))
            {
                Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "Runaway prototype");
            }
-           cv_ckproto_len((CV*)gv, NULL, ps, ps_len);
+           cv_ckproto_len((const CV *)gv, NULL, ps, ps_len);
        }
        if (ps)
        }
        if (ps)
-           sv_setpvn((SV*)gv, ps, ps_len);
+           sv_setpvn(MUTABLE_SV(gv), ps, ps_len);
        else
        else
-           sv_setiv((SV*)gv, -1);
+           sv_setiv(MUTABLE_SV(gv), -1);
 
        SvREFCNT_dec(PL_compcv);
        cv = PL_compcv = NULL;
 
        SvREFCNT_dec(PL_compcv);
        cv = PL_compcv = NULL;
@@ -5495,12 +5602,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 
     cv = (!name || GvCVGEN(gv)) ? NULL : GvCV(gv);
 
 
     cv = (!name || GvCVGEN(gv)) ? NULL : GvCV(gv);
 
-#ifdef GV_UNIQUE_CHECK
-    if (cv && GvUNIQUE(gv) && SvREADONLY(cv)) {
-        Perl_croak(aTHX_ "Can't define subroutine %s (GV is unique)", name);
-    }
-#endif
-
     if (!block || !ps || *ps || attrs
        || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS)
 #ifdef PERL_MAD
     if (!block || !ps || *ps || attrs
        || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS)
 #ifdef PERL_MAD
@@ -5514,12 +5615,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (cv) {
         const bool exists = CvROOT(cv) || CvXSUB(cv);
 
     if (cv) {
         const bool exists = CvROOT(cv) || CvXSUB(cv);
 
-#ifdef GV_UNIQUE_CHECK
-        if (exists && GvUNIQUE(gv)) {
-            Perl_croak(aTHX_ "Can't redefine unique subroutine %s", name);
-        }
-#endif
-
         /* if the subroutine doesn't exist and wasn't pre-declared
          * with a prototype, assume it will be AUTOLOADed,
          * skipping the prototype check
         /* if the subroutine doesn't exist and wasn't pre-declared
          * with a prototype, assume it will be AUTOLOADed,
          * skipping the prototype check
@@ -5573,7 +5668,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        SvREFCNT_inc_simple_void_NN(const_sv);
        if (cv) {
            assert(!CvROOT(cv) && !CvCONST(cv));
        SvREFCNT_inc_simple_void_NN(const_sv);
        if (cv) {
            assert(!CvROOT(cv) && !CvCONST(cv));
-           sv_setpvn((SV*)cv, "", 0);  /* prototype is "" */
+           sv_setpvs(MUTABLE_SV(cv), "");  /* prototype is "" */
            CvXSUBANY(cv).any_ptr = const_sv;
            CvXSUB(cv) = const_sv_xsub;
            CvCONST_on(cv);
            CvXSUBANY(cv).any_ptr = const_sv;
            CvXSUB(cv) = const_sv_xsub;
            CvCONST_on(cv);
@@ -5609,7 +5704,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                    || block->op_type == OP_NULL
 #endif
                    )) {
                    || block->op_type == OP_NULL
 #endif
                    )) {
-           rcv = (SV*)cv;
+           rcv = MUTABLE_SV(cv);
            /* Might have had built-in attributes applied -- propagate them. */
            CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
            if (CvGV(cv) && GvSTASH(CvGV(cv)))
            /* Might have had built-in attributes applied -- propagate them. */
            CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
            if (CvGV(cv) && GvSTASH(CvGV(cv)))
@@ -5621,7 +5716,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
        else {
            /* possibly about to re-define existing subr -- ignore old cv */
        }
        else {
            /* possibly about to re-define existing subr -- ignore old cv */
-           rcv = (SV*)PL_compcv;
+           rcv = MUTABLE_SV(PL_compcv);
            if (name && GvSTASH(gv))
                stash = GvSTASH(gv);
            else
            if (name && GvSTASH(gv))
                stash = GvSTASH(gv);
            else
@@ -5667,7 +5762,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            GvCV(gv) = cv;
            if (PL_madskills) {
                if (strEQ(name, "import")) {
            GvCV(gv) = cv;
            if (PL_madskills) {
                if (strEQ(name, "import")) {
-                   PL_formfeed = (SV*)cv;
+                   PL_formfeed = MUTABLE_SV(cv);
                    Perl_warner(aTHX_ packWARN(WARN_VOID), "%lx\n", (long)cv);
                }
            }
                    Perl_warner(aTHX_ packWARN(WARN_VOID), "%lx\n", (long)cv);
                }
            }
@@ -5680,7 +5775,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     CvSTASH(cv) = PL_curstash;
 
     if (ps)
     CvSTASH(cv) = PL_curstash;
 
     if (ps)
-       sv_setpvn((SV*)cv, ps, ps_len);
+       sv_setpvn(MUTABLE_SV(cv), ps, ps_len);
 
     if (PL_parser && PL_parser->error_count) {
        op_free(block);
 
     if (PL_parser && PL_parser->error_count) {
        op_free(block);
@@ -5705,6 +5800,12 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (!block)
        goto done;
 
     if (!block)
        goto done;
 
+    /* If we assign an optree to a PVCV, then we've defined a subroutine that
+       the debugger could be able to set a breakpoint in, so signal to
+       pp_entereval that it should not throw away any saved lines at scope
+       exit.  */
+       
+    PL_breakable_sub_gen++;
     if (CvLVALUE(cv)) {
        CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0,
                             mod(scalarseq(block), OP_LEAVESUBLV));
     if (CvLVALUE(cv)) {
        CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0,
                             mod(scalarseq(block), OP_LEAVESUBLV));
@@ -5741,7 +5842,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            CvCONST_on(cv);
     }
 
            CvCONST_on(cv);
     }
 
-    if (name || aname) {
+    if (has_name) {
        if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
            SV * const sv = newSV(0);
            SV * const tmpstr = sv_newmortal();
        if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
            SV * const sv = newSV(0);
            SV * const tmpstr = sv_newmortal();
@@ -5763,7 +5864,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                    PUSHMARK(SP);
                    XPUSHs(tmpstr);
                    PUTBACK;
                    PUSHMARK(SP);
                    XPUSHs(tmpstr);
                    PUTBACK;
-                   call_sv((SV*)pcv, G_DISCARD);
+                   call_sv(MUTABLE_SV(pcv), G_DISCARD);
                }
            }
        }
                }
            }
        }
@@ -5796,7 +5897,7 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
            SAVECOPLINE(&PL_compiling);
 
            DEBUG_x( dump_sub(gv) );
            SAVECOPLINE(&PL_compiling);
 
            DEBUG_x( dump_sub(gv) );
-           Perl_av_create_and_push(aTHX_ &PL_beginav, (SV*)cv);
+           Perl_av_create_and_push(aTHX_ &PL_beginav, MUTABLE_SV(cv));
            GvCV(gv) = 0;               /* cv has been hijacked */
            call_list(oldscope, PL_beginav);
 
            GvCV(gv) = 0;               /* cv has been hijacked */
            call_list(oldscope, PL_beginav);
 
@@ -5810,13 +5911,13 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
        if (*name == 'E') {
            if strEQ(name, "END") {
                DEBUG_x( dump_sub(gv) );
        if (*name == 'E') {
            if strEQ(name, "END") {
                DEBUG_x( dump_sub(gv) );
-               Perl_av_create_and_unshift_one(aTHX_ &PL_endav, (SV*)cv);
+               Perl_av_create_and_unshift_one(aTHX_ &PL_endav, MUTABLE_SV(cv));
            } else
                return;
        } else if (*name == 'U') {
            if (strEQ(name, "UNITCHECK")) {
                /* It's never too late to run a unitcheck block */
            } else
                return;
        } else if (*name == 'U') {
            if (strEQ(name, "UNITCHECK")) {
                /* It's never too late to run a unitcheck block */
-               Perl_av_create_and_unshift_one(aTHX_ &PL_unitcheckav, (SV*)cv);
+               Perl_av_create_and_unshift_one(aTHX_ &PL_unitcheckav, MUTABLE_SV(cv));
            }
            else
                return;
            }
            else
                return;
@@ -5825,7 +5926,7 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
                if (PL_main_start && ckWARN(WARN_VOID))
                    Perl_warner(aTHX_ packWARN(WARN_VOID),
                                "Too late to run CHECK block");
                if (PL_main_start && ckWARN(WARN_VOID))
                    Perl_warner(aTHX_ packWARN(WARN_VOID),
                                "Too late to run CHECK block");
-               Perl_av_create_and_unshift_one(aTHX_ &PL_checkav, (SV*)cv);
+               Perl_av_create_and_unshift_one(aTHX_ &PL_checkav, MUTABLE_SV(cv));
            }
            else
                return;
            }
            else
                return;
@@ -5834,7 +5935,7 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
                if (PL_main_start && ckWARN(WARN_VOID))
                    Perl_warner(aTHX_ packWARN(WARN_VOID),
                                "Too late to run INIT block");
                if (PL_main_start && ckWARN(WARN_VOID))
                    Perl_warner(aTHX_ packWARN(WARN_VOID),
                                "Too late to run INIT block");
-               Perl_av_create_and_push(aTHX_ &PL_initav, (SV*)cv);
+               Perl_av_create_and_push(aTHX_ &PL_initav, MUTABLE_SV(cv));
            }
            else
                return;
            }
            else
                return;
@@ -5851,6 +5952,11 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
 Creates a constant sub equivalent to Perl C<sub FOO () { 123 }> which is
 eligible for inlining at compile-time.
 
 Creates a constant sub equivalent to Perl C<sub FOO () { 123 }> which is
 eligible for inlining at compile-time.
 
+Passing NULL for SV creates a constant sub equivalent to C<sub BAR () {}>,
+which won't be called if used as a destructor, but will suppress the overhead
+of a call to C<AUTOLOAD>.  (This form, however, isn't eligible for inlining at
+compile time.)
+
 =cut
 */
 
 =cut
 */
 
@@ -5860,14 +5966,11 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
     dVAR;
     CV* cv;
 #ifdef USE_ITHREADS
     dVAR;
     CV* cv;
 #ifdef USE_ITHREADS
-    const char *const temp_p = CopFILE(PL_curcop);
-    const STRLEN len = temp_p ? strlen(temp_p) : 0;
+    const char *const file = CopFILE(PL_curcop);
 #else
     SV *const temp_sv = CopFILESV(PL_curcop);
 #else
     SV *const temp_sv = CopFILESV(PL_curcop);
-    STRLEN len;
-    const char *const temp_p = temp_sv ? SvPV_const(temp_sv, len) : NULL;
+    const char *const file = temp_sv ? SvPV_nolen_const(temp_sv) : NULL;
 #endif
 #endif
-    char *const file = savepvn(temp_p, temp_p ? len : 0);
 
     ENTER;
 
 
     ENTER;
 
@@ -5895,10 +5998,10 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
        and so doesn't get free()d.  (It's expected to be from the C pre-
        processor __FILE__ directive). But we need a dynamically allocated one,
        and we need it to get freed.  */
        and so doesn't get free()d.  (It's expected to be from the C pre-
        processor __FILE__ directive). But we need a dynamically allocated one,
        and we need it to get freed.  */
-    cv = newXS_flags(name, const_sv_xsub, file, "", XS_DYNAMIC_FILENAME);
+    cv = newXS_flags(name, const_sv_xsub, file ? file : "", "",
+                    XS_DYNAMIC_FILENAME);
     CvXSUBANY(cv).any_ptr = sv;
     CvCONST_on(cv);
     CvXSUBANY(cv).any_ptr = sv;
     CvCONST_on(cv);
-    Safefree(file);
 
 #ifdef USE_ITHREADS
     if (stash)
 
 #ifdef USE_ITHREADS
     if (stash)
@@ -5940,7 +6043,7 @@ Perl_newXS_flags(pTHX_ const char *name, XSUBADDR_t subaddr,
        }
 
        /* This gets free()d.  :-)  */
        }
 
        /* This gets free()d.  :-)  */
-       sv_usepvn_flags((SV*)cv, proto_and_file, proto_and_file_len,
+       sv_usepvn_flags(MUTABLE_SV(cv), proto_and_file, proto_and_file_len,
                        SV_HAS_TRAILING_NUL);
        if (proto) {
            /* This gives us the correct prototype, rather than one with the
                        SV_HAS_TRAILING_NUL);
        if (proto) {
            /* This gives us the correct prototype, rather than one with the
@@ -5951,7 +6054,7 @@ Perl_newXS_flags(pTHX_ const char *name, XSUBADDR_t subaddr,
        }
        CvFILE(cv) = proto_and_file + proto_len;
     } else {
        }
        CvFILE(cv) = proto_and_file + proto_len;
     } else {
-       sv_setpv((SV *)cv, proto);
+       sv_setpv(MUTABLE_SV(cv), proto);
     }
     return cv;
 }
     }
     return cv;
 }
@@ -6015,7 +6118,7 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
     if (cv)                            /* must reuse cv if autoloaded */
        cv_undef(cv);
     else {
     if (cv)                            /* must reuse cv if autoloaded */
        cv_undef(cv);
     else {
-       cv = (CV*)newSV_type(SVt_PVCV);
+       cv = MUTABLE_CV(newSV_type(SVt_PVCV));
        if (name) {
            GvCV(gv) = cv;
            GvCVGEN(gv) = 0;
        if (name) {
            GvCV(gv) = cv;
            GvCVGEN(gv) = 0;
@@ -6054,20 +6157,19 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
        ? gv_fetchsv(cSVOPo->op_sv, GV_ADD, SVt_PVFM)
        : gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVFM);
 
        ? gv_fetchsv(cSVOPo->op_sv, GV_ADD, SVt_PVFM)
        : gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVFM);
 
-#ifdef GV_UNIQUE_CHECK
-    if (GvUNIQUE(gv)) {
-        Perl_croak(aTHX_ "Bad symbol for form (GV is unique)");
-    }
-#endif
     GvMULTI_on(gv);
     if ((cv = GvFORM(gv))) {
        if (ckWARN(WARN_REDEFINE)) {
            const line_t oldline = CopLINE(PL_curcop);
            if (PL_parser && PL_parser->copline != NOLINE)
                CopLINE_set(PL_curcop, PL_parser->copline);
     GvMULTI_on(gv);
     if ((cv = GvFORM(gv))) {
        if (ckWARN(WARN_REDEFINE)) {
            const line_t oldline = CopLINE(PL_curcop);
            if (PL_parser && PL_parser->copline != NOLINE)
                CopLINE_set(PL_curcop, PL_parser->copline);
-           Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
-                       o ? "Format %"SVf" redefined"
-                       : "Format STDOUT redefined", SVfARG(cSVOPo->op_sv));
+           if (o) {
+               Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
+                           "Format %"SVf" redefined", SVfARG(cSVOPo->op_sv));
+           } else {
+               Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
+                           "Format STDOUT redefined");
+           }
            CopLINE_set(PL_curcop, oldline);
        }
        SvREFCNT_dec(cv);
            CopLINE_set(PL_curcop, oldline);
        }
        SvREFCNT_dec(cv);
@@ -6122,7 +6224,7 @@ Perl_newANONATTRSUB(pTHX_ I32 floor, OP *proto, OP *attrs, OP *block)
 {
     return newUNOP(OP_REFGEN, 0,
        newSVOP(OP_ANONCODE, 0,
 {
     return newUNOP(OP_REFGEN, 0,
        newSVOP(OP_ANONCODE, 0,
-               (SV*)newATTRSUB(floor, 0, proto, attrs, block)));
+               MUTABLE_SV(newATTRSUB(floor, 0, proto, attrs, block))));
 }
 
 OP *
 }
 
 OP *
@@ -6372,6 +6474,8 @@ Perl_ck_delete(pTHX_ OP *o)
            Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or slice",
                  OP_DESC(o));
        }
            Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or slice",
                  OP_DESC(o));
        }
+       if (kid->op_private & OPpLVAL_INTRO)
+           o->op_private |= OPpLVAL_INTRO;
        op_null(kid);
     }
     return o;
        op_null(kid);
     }
     return o;
@@ -6445,6 +6549,8 @@ Perl_ck_eval(pTHX_ OP *o)
            /* establish postfix order */
            enter->op_next = (OP*)enter;
 
            /* establish postfix order */
            enter->op_next = (OP*)enter;
 
+           CHECKOP(OP_ENTERTRY, enter);
+
            o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
            o->op_type = OP_LEAVETRY;
            o->op_ppaddr = PL_ppaddr[OP_LEAVETRY];
            o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
            o->op_type = OP_LEAVETRY;
            o->op_ppaddr = PL_ppaddr[OP_LEAVETRY];
@@ -6468,12 +6574,9 @@ Perl_ck_eval(pTHX_ OP *o)
     }
     o->op_targ = (PADOFFSET)PL_hints;
     if ((PL_hints & HINT_LOCALIZE_HH) != 0 && GvHV(PL_hintgv)) {
     }
     o->op_targ = (PADOFFSET)PL_hints;
     if ((PL_hints & HINT_LOCALIZE_HH) != 0 && GvHV(PL_hintgv)) {
-       /* Store a copy of %^H that pp_entereval can pick up.
-          OPf_SPECIAL flags the opcode as being for this purpose,
-          so that it in turn will return a copy at every
-          eval.*/
-       OP *hhop = newSVOP(OP_CONST, OPf_SPECIAL,
-                          (SV*)Perl_hv_copy_hints_hv(aTHX_ GvHV(PL_hintgv)));
+       /* Store a copy of %^H that pp_entereval can pick up. */
+       OP *hhop = newSVOP(OP_HINTSEVAL, 0,
+                          MUTABLE_SV(Perl_hv_copy_hints_hv(aTHX_ GvHV(PL_hintgv))));
        cUNOPo->op_first->op_sibling = hhop;
        o->op_private |= OPpEVAL_HAS_HH;
     }
        cUNOPo->op_first->op_sibling = hhop;
        o->op_private |= OPpEVAL_HAS_HH;
     }
@@ -6535,7 +6638,7 @@ Perl_ck_exists(pTHX_ OP *o)
        else if (kid->op_type == OP_AELEM)
            o->op_flags |= OPf_SPECIAL;
        else if (kid->op_type != OP_HELEM)
        else if (kid->op_type == OP_AELEM)
            o->op_flags |= OPf_SPECIAL;
        else if (kid->op_type != OP_HELEM)
-           Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element",
+           Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or a subroutine",
                        OP_DESC(o));
        op_null(kid);
     }
                        OP_DESC(o));
        op_null(kid);
     }
@@ -6649,7 +6752,7 @@ Perl_ck_rvconst(pTHX_ register OP *o)
            kPADOP->op_padix = pad_alloc(OP_GV, SVs_PADTMP);
            SvREFCNT_dec(PAD_SVl(kPADOP->op_padix));
            GvIN_PAD_on(gv);
            kPADOP->op_padix = pad_alloc(OP_GV, SVs_PADTMP);
            SvREFCNT_dec(PAD_SVl(kPADOP->op_padix));
            GvIN_PAD_on(gv);
-           PAD_SETSV(kPADOP->op_padix, (SV*) SvREFCNT_inc_simple_NN(gv));
+           PAD_SETSV(kPADOP->op_padix, MUTABLE_SV(SvREFCNT_inc_simple_NN(gv)));
 #else
            kid->op_sv = SvREFCNT_inc_simple_NN(gv);
 #endif
 #else
            kid->op_sv = SvREFCNT_inc_simple_NN(gv);
 #endif
@@ -6685,7 +6788,7 @@ Perl_ck_ftst(pTHX_ OP *o)
 #endif
            return newop;
        }
 #endif
            return newop;
        }
-       if ((PL_hints & HINT_FILETEST_ACCESS) && OP_IS_FILETEST_ACCESS(o))
+       if ((PL_hints & HINT_FILETEST_ACCESS) && OP_IS_FILETEST_ACCESS(o->op_type))
            o->op_private |= OPpFT_ACCESS;
        if (PL_check[kidtype] == MEMBER_TO_FPTR(Perl_ck_ftst)
                && kidtype != OP_STAT && kidtype != OP_LSTAT)
            o->op_private |= OPpFT_ACCESS;
        if (PL_check[kidtype] == MEMBER_TO_FPTR(Perl_ck_ftst)
                && kidtype != OP_STAT && kidtype != OP_LSTAT)
@@ -6929,7 +7032,7 @@ Perl_ck_fun(pTHX_ OP *o)
                                namesv = PAD_SVl(targ);
                                SvUPGRADE(namesv, SVt_PV);
                                if (*name != '$')
                                namesv = PAD_SVl(targ);
                                SvUPGRADE(namesv, SVt_PV);
                                if (*name != '$')
-                                   sv_setpvn(namesv, "$", 1);
+                                   sv_setpvs(namesv, "$");
                                sv_catpvn(namesv, name, len);
                            }
                        }
                                sv_catpvn(namesv, name, len);
                            }
                        }
@@ -7012,7 +7115,7 @@ Perl_ck_glob(pTHX_ OP *o)
        gv = gv_fetchpvs("CORE::GLOBAL::glob", 0, SVt_PVCV);
        glob_gv = gv_fetchpvs("File::Glob::csh_glob", 0, SVt_PVCV);
        GvCV(gv) = GvCV(glob_gv);
        gv = gv_fetchpvs("CORE::GLOBAL::glob", 0, SVt_PVCV);
        glob_gv = gv_fetchpvs("File::Glob::csh_glob", 0, SVt_PVCV);
        GvCV(gv) = GvCV(glob_gv);
-       SvREFCNT_inc_void((SV*)GvCV(gv));
+       SvREFCNT_inc_void(MUTABLE_SV(GvCV(gv)));
        GvIMPORTED_CV_on(gv);
        LEAVE;
     }
        GvIMPORTED_CV_on(gv);
        LEAVE;
     }
@@ -7124,15 +7227,6 @@ Perl_ck_index(pTHX_ OP *o)
 }
 
 OP *
 }
 
 OP *
-Perl_ck_lengthconst(pTHX_ OP *o)
-{
-    PERL_ARGS_ASSERT_CK_LENGTHCONST;
-
-    /* XXX length optimization goes here */
-    return ck_fun(o);
-}
-
-OP *
 Perl_ck_lfun(pTHX_ OP *o)
 {
     const OPCODE type = o->op_type;
 Perl_ck_lfun(pTHX_ OP *o)
 {
     const OPCODE type = o->op_type;
@@ -7403,7 +7497,9 @@ Perl_ck_open(pTHX_ OP *o)
     if (table) {
        SV **svp = hv_fetchs(table, "open_IN", FALSE);
        if (svp && *svp) {
     if (table) {
        SV **svp = hv_fetchs(table, "open_IN", FALSE);
        if (svp && *svp) {
-           const I32 mode = mode_from_discipline(*svp);
+           STRLEN len = 0;
+           const char *d = SvPV_const(*svp, len);
+           const I32 mode = mode_from_discipline(d, len);
            if (mode & O_BINARY)
                o->op_private |= OPpOPEN_IN_RAW;
            else if (mode & O_TEXT)
            if (mode & O_BINARY)
                o->op_private |= OPpOPEN_IN_RAW;
            else if (mode & O_TEXT)
@@ -7412,7 +7508,9 @@ Perl_ck_open(pTHX_ OP *o)
 
        svp = hv_fetchs(table, "open_OUT", FALSE);
        if (svp && *svp) {
 
        svp = hv_fetchs(table, "open_OUT", FALSE);
        if (svp && *svp) {
-           const I32 mode = mode_from_discipline(*svp);
+           STRLEN len = 0;
+           const char *d = SvPV_const(*svp, len);
+           const I32 mode = mode_from_discipline(d, len);
            if (mode & O_BINARY)
                o->op_private |= OPpOPEN_OUT_RAW;
            else if (mode & O_TEXT)
            if (mode & O_BINARY)
                o->op_private |= OPpOPEN_OUT_RAW;
            else if (mode & O_TEXT)
@@ -7545,14 +7643,29 @@ OP *
 Perl_ck_return(pTHX_ OP *o)
 {
     dVAR;
 Perl_ck_return(pTHX_ OP *o)
 {
     dVAR;
+    OP *kid;
 
     PERL_ARGS_ASSERT_CK_RETURN;
 
 
     PERL_ARGS_ASSERT_CK_RETURN;
 
+    kid = cLISTOPo->op_first->op_sibling;
     if (CvLVALUE(PL_compcv)) {
     if (CvLVALUE(PL_compcv)) {
-        OP *kid;
-       for (kid = cLISTOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
+       for (; kid; kid = kid->op_sibling)
            mod(kid, OP_LEAVESUBLV);
            mod(kid, OP_LEAVESUBLV);
+    } else {
+       for (; kid; kid = kid->op_sibling)
+           if ((kid->op_type == OP_NULL)
+               && ((kid->op_flags & (OPf_SPECIAL|OPf_KIDS)) == (OPf_SPECIAL|OPf_KIDS))) {
+               /* This is a do block */
+               OP *op = kUNOP->op_first;
+               if (op->op_type == OP_LEAVE && op->op_flags & OPf_KIDS) {
+                   op = cUNOPx(op)->op_first;
+                   assert(op->op_type == OP_ENTER && !(op->op_flags & OPf_SPECIAL));
+                   /* Force the use of the caller's context */
+                   op->op_flags |= OPf_SPECIAL;
+               }
+           }
     }
     }
+
     return o;
 }
 
     return o;
 }
 
@@ -7835,7 +7948,7 @@ Perl_ck_join(pTHX_ OP *o)
     if (kid && kid->op_type == OP_MATCH) {
        if (ckWARN(WARN_SYNTAX)) {
             const REGEXP *re = PM_GETRE(kPMOP);
     if (kid && kid->op_type == OP_MATCH) {
        if (ckWARN(WARN_SYNTAX)) {
             const REGEXP *re = PM_GETRE(kPMOP);
-           const char *pmstr = re ? RX_PRECOMP(re) : "STRING";
+           const char *pmstr = re ? RX_PRECOMP_const(re) : "STRING";
            const STRLEN len = re ? RX_PRELEN(re) : 6;
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                        "/%.*s/ should probably be written as \"%.*s\"",
            const STRLEN len = re ? RX_PRELEN(re) : 6;
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                        "/%.*s/ should probably be written as \"%.*s\"",
@@ -7881,7 +7994,7 @@ Perl_ck_subr(pTHX_ OP *o)
                if (SvPOK(cv)) {
                    STRLEN len;
                    namegv = CvANON(cv) ? gv : CvGV(cv);
                if (SvPOK(cv)) {
                    STRLEN len;
                    namegv = CvANON(cv) ? gv : CvGV(cv);
-                   proto = SvPV((SV*)cv, len);
+                   proto = SvPV(MUTABLE_SV(cv), len);
                    proto_end = proto + len;
                }
            }
                    proto_end = proto + len;
                }
            }
@@ -8003,7 +8116,7 @@ Perl_ck_subr(pTHX_ OP *o)
                         const char *p = proto;
                         const char *const end = proto;
                         contextclass = 0;
                         const char *p = proto;
                         const char *const end = proto;
                         contextclass = 0;
-                        while (*--p != '[');
+                        while (*--p != '[') {}
                         bad_type(arg, Perl_form(aTHX_ "one of %.*s",
                                                 (int)(end - p), p),
                                  gv_ename(namegv), o3);
                         bad_type(arg, Perl_form(aTHX_ "one of %.*s",
                                                 (int)(end - p), p),
                                  gv_ename(namegv), o3);
@@ -8234,20 +8347,21 @@ Perl_peep(pTHX_ register OP *o)
            if (cSVOPo->op_private & OPpCONST_STRICT)
                no_bareword_allowed(o);
 #ifdef USE_ITHREADS
            if (cSVOPo->op_private & OPpCONST_STRICT)
                no_bareword_allowed(o);
 #ifdef USE_ITHREADS
+       case OP_HINTSEVAL:
        case OP_METHOD_NAMED:
            /* Relocate sv to the pad for thread safety.
             * Despite being a "constant", the SV is written to,
             * for reference counts, sv_upgrade() etc. */
            if (cSVOP->op_sv) {
                const PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP);
        case OP_METHOD_NAMED:
            /* Relocate sv to the pad for thread safety.
             * Despite being a "constant", the SV is written to,
             * for reference counts, sv_upgrade() etc. */
            if (cSVOP->op_sv) {
                const PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP);
-               if (o->op_type == OP_CONST && SvPADTMP(cSVOPo->op_sv)) {
+               if (o->op_type != OP_METHOD_NAMED && SvPADTMP(cSVOPo->op_sv)) {
                    /* If op_sv is already a PADTMP then it is being used by
                     * some pad, so make a copy. */
                    sv_setsv(PAD_SVl(ix),cSVOPo->op_sv);
                    SvREADONLY_on(PAD_SVl(ix));
                    SvREFCNT_dec(cSVOPo->op_sv);
                }
                    /* If op_sv is already a PADTMP then it is being used by
                     * some pad, so make a copy. */
                    sv_setsv(PAD_SVl(ix),cSVOPo->op_sv);
                    SvREADONLY_on(PAD_SVl(ix));
                    SvREFCNT_dec(cSVOPo->op_sv);
                }
-               else if (o->op_type == OP_CONST
+               else if (o->op_type != OP_METHOD_NAMED
                         && cSVOPo->op_sv == &PL_sv_undef) {
                    /* PL_sv_undef is hack - it's unsafe to store it in the
                       AV that is the pad, because av_fetch treats values of
                         && cSVOPo->op_sv == &PL_sv_undef) {
                    /* PL_sv_undef is hack - it's unsafe to store it in the
                       AV that is the pad, because av_fetch treats values of
@@ -8458,7 +8572,7 @@ Perl_peep(pTHX_ register OP *o)
 
            /* Make the CONST have a shared SV */
            svp = cSVOPx_svp(((BINOP*)o)->op_last);
 
            /* Make the CONST have a shared SV */
            svp = cSVOPx_svp(((BINOP*)o)->op_last);
-           if ((!SvFAKE(sv = *svp) || !SvREADONLY(sv)) && !IS_PADCONST(sv)) {
+           if (!SvFAKE(sv = *svp) || !SvREADONLY(sv)) {
                key = SvPV_const(sv, keylen);
                lexname = newSVpvn_share(key,
                                         SvUTF8(sv) ? -(I32)keylen : (I32)keylen,
                key = SvPV_const(sv, keylen);
                lexname = newSVpvn_share(key,
                                         SvUTF8(sv) ? -(I32)keylen : (I32)keylen,
@@ -8863,15 +8977,20 @@ const_sv_xsub(pTHX_ CV* cv)
 {
     dVAR;
     dXSARGS;
 {
     dVAR;
     dXSARGS;
+    SV *const sv = MUTABLE_SV(XSANY.any_ptr);
     if (items != 0) {
        NOOP;
 #if 0
     if (items != 0) {
        NOOP;
 #if 0
+       /* diag_listed_as: SKIPME */
         Perl_croak(aTHX_ "usage: %s::%s()",
                    HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
 #endif
     }
         Perl_croak(aTHX_ "usage: %s::%s()",
                    HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
 #endif
     }
+    if (!sv) {
+       XSRETURN(0);
+    }
     EXTEND(sp, 1);
     EXTEND(sp, 1);
-    ST(0) = (SV*)XSANY.any_ptr;
+    ST(0) = sv;
     XSRETURN(1);
 }
 
     XSRETURN(1);
 }
 
Unnamed repository; edit this file 'description' to name the repository.