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
buigid #24905 - the code planted to call glob() retained an
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 8c947b7..b39d81e 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1,6 +1,7 @@
 /*    op.c
  *
 /*    op.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2003, 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.
@@ -29,13 +30,8 @@
 #define PERL_SLAB_SIZE 2048
 #endif
 
 #define PERL_SLAB_SIZE 2048
 #endif
 
-#define NewOp(m,var,c,type) \
-       STMT_START { var = (type *) Slab_Alloc(m,c*sizeof(type)); } STMT_END
-
-#define FreeOp(p) Slab_Free(p)
-
-STATIC void *
-S_Slab_Alloc(pTHX_ int m, size_t sz)
+void *
+Perl_Slab_Alloc(pTHX_ int m, size_t sz)
 {
     /*
      * To make incrementing use count easy PL_OpSlab is an I32 *
 {
     /*
      * To make incrementing use count easy PL_OpSlab is an I32 *
@@ -73,8 +69,8 @@ S_Slab_Alloc(pTHX_ int m, size_t sz)
     return (void *)(PL_OpPtr + 1);
 }
 
     return (void *)(PL_OpPtr + 1);
 }
 
-STATIC void
-S_Slab_Free(pTHX_ void *op)
+void
+Perl_Slab_Free(pTHX_ void *op)
 {
     I32 **ptr = (I32 **) op;
     I32 *slab = ptr[-1];
 {
     I32 **ptr = (I32 **) op;
     I32 *slab = ptr[-1];
@@ -82,9 +78,9 @@ S_Slab_Free(pTHX_ void *op)
     assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) );
     assert( *slab > 0 );
     if (--(*slab) == 0) {
     assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) );
     assert( *slab > 0 );
     if (--(*slab) == 0) {
-     #ifdef NETWARE
-      #define PerlMemShared PerlMem
-     #endif
+#  ifdef NETWARE
+#    define PerlMemShared PerlMem
+#  endif
        
     PerlMemShared_free(slab);
        if (slab == PL_OpSlab) {
        
     PerlMemShared_free(slab);
        if (slab == PL_OpSlab) {
@@ -92,10 +88,6 @@ S_Slab_Free(pTHX_ void *op)
        }
     }
 }
        }
     }
 }
-
-#else
-#define NewOp(m, var, c, type) Newz(m, var, c, type)
-#define FreeOp(p) Safefree(p)
 #endif
 /*
  * In the following definition, the ", Nullop" is just to make the compiler
 #endif
 /*
  * In the following definition, the ", Nullop" is just to make the compiler
@@ -152,8 +144,8 @@ STATIC void
 S_no_bareword_allowed(pTHX_ OP *o)
 {
     qerror(Perl_mess(aTHX_
 S_no_bareword_allowed(pTHX_ OP *o)
 {
     qerror(Perl_mess(aTHX_
-                    "Bareword \"%s\" not allowed while \"strict subs\" in use",
-                    SvPV_nolen(cSVOPo_sv)));
+                    "Bareword \"%"SVf"\" not allowed while \"strict subs\" in use",
+                    cSVOPo_sv));
 }
 
 /* "register" allocation */
 }
 
 /* "register" allocation */
@@ -193,7 +185,7 @@ Perl_allocmy(pTHX_ char *name)
 
     /* check for duplicate declaration */
     pad_check_dup(name,
 
     /* check for duplicate declaration */
     pad_check_dup(name,
-               PL_in_my == KEY_our,
+               (bool)(PL_in_my == KEY_our),
                (PL_curstash ? PL_curstash : PL_defstash)
     );
 
                (PL_curstash ? PL_curstash : PL_defstash)
     );
 
@@ -299,6 +291,18 @@ Perl_op_clear(pTHX_ OP *o)
     case OP_CONST:
        SvREFCNT_dec(cSVOPo->op_sv);
        cSVOPo->op_sv = Nullsv;
     case OP_CONST:
        SvREFCNT_dec(cSVOPo->op_sv);
        cSVOPo->op_sv = Nullsv;
+#ifdef USE_ITHREADS
+       /** Bug #15654
+         Even if op_clear does a pad_free for the target of the op,
+         pad_free doesn't actually remove the sv that exists in the bad
+         instead it lives on. This results in that it could be reused as 
+         a target later on when the pad was reallocated.
+       **/
+        if(o->op_targ) {
+          pad_swipe(o->op_targ,1);
+          o->op_targ = 0;
+        }
+#endif
        break;
     case OP_GOTO:
     case OP_NEXT:
        break;
     case OP_GOTO:
     case OP_NEXT:
@@ -875,10 +879,23 @@ S_modkids(pTHX_ OP *o, I32 type)
     return o;
 }
 
     return o;
 }
 
+/* Propagate lvalue ("modifiable") context to an op and it's children.
+ * 'type' represents the context type, roughly based on the type of op that
+ * would do the modifying, although local() is represented by OP_NULL.
+ * It's responsible for detecting things that can't be modified,  flag
+ * things that need to behave specially in an lvalue context (e.g., "$$x = 5"
+ * might have to vivify a reference in $x), and so on.
+ *
+ * For example, "$a+1 = 2" would cause mod() to be called with o being
+ * OP_ADD and type being OP_SASSIGN, and would output an error.
+ */
+
 OP *
 Perl_mod(pTHX_ OP *o, I32 type)
 {
     OP *kid;
 OP *
 Perl_mod(pTHX_ OP *o, I32 type)
 {
     OP *kid;
+    /* -1 = error on localize, 0 = ignore localize, 1 = ok to localize */
+    int localize = -1;
 
     if (!o || PL_error_count)
        return o;
 
     if (!o || PL_error_count)
        return o;
@@ -891,6 +908,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 
     switch (o->op_type) {
     case OP_UNDEF:
 
     switch (o->op_type) {
     case OP_UNDEF:
+       localize = 0;
        PL_modcount++;
        return o;
     case OP_CONST:
        PL_modcount++;
        return o;
     case OP_CONST:
@@ -1047,14 +1065,13 @@ Perl_mod(pTHX_ OP *o, I32 type)
        break;
 
     case OP_COND_EXPR:
        break;
 
     case OP_COND_EXPR:
+       localize = 1;
        for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
            mod(kid, type);
        break;
 
     case OP_RV2AV:
     case OP_RV2HV:
        for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
            mod(kid, type);
        break;
 
     case OP_RV2AV:
     case OP_RV2HV:
-       if (!type && cUNOPo->op_first->op_type != OP_GV)
-           Perl_croak(aTHX_ "Can't localize through a reference");
        if (type == OP_REFGEN && o->op_flags & OPf_PARENS) {
            PL_modcount = RETURN_UNLIMITED_NUMBER;
            return o;           /* Treat \(@foo) like ordinary list. */
        if (type == OP_REFGEN && o->op_flags & OPf_PARENS) {
            PL_modcount = RETURN_UNLIMITED_NUMBER;
            return o;           /* Treat \(@foo) like ordinary list. */
@@ -1069,6 +1086,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
     case OP_HSLICE:
        if (type == OP_LEAVESUBLV)
            o->op_private |= OPpMAYBE_LVSUB;
     case OP_HSLICE:
        if (type == OP_LEAVESUBLV)
            o->op_private |= OPpMAYBE_LVSUB;
+       localize = 1;
        /* FALL THROUGH */
     case OP_AASSIGN:
     case OP_NEXTSTATE:
        /* FALL THROUGH */
     case OP_AASSIGN:
     case OP_NEXTSTATE:
@@ -1076,9 +1094,8 @@ Perl_mod(pTHX_ OP *o, I32 type)
        PL_modcount = RETURN_UNLIMITED_NUMBER;
        break;
     case OP_RV2SV:
        PL_modcount = RETURN_UNLIMITED_NUMBER;
        break;
     case OP_RV2SV:
-       if (!type && cUNOPo->op_first->op_type != OP_GV)
-           Perl_croak(aTHX_ "Can't localize through a reference");
        ref(cUNOPo->op_first, o->op_type);
        ref(cUNOPo->op_first, o->op_type);
+       localize = 1;
        /* FALL THROUGH */
     case OP_GV:
     case OP_AV2ARYLEN:
        /* FALL THROUGH */
     case OP_GV:
     case OP_AV2ARYLEN:
@@ -1087,7 +1104,11 @@ Perl_mod(pTHX_ OP *o, I32 type)
     case OP_ANDASSIGN:
     case OP_ORASSIGN:
     case OP_DORASSIGN:
     case OP_ANDASSIGN:
     case OP_ORASSIGN:
     case OP_DORASSIGN:
+       PL_modcount++;
+       break;
+
     case OP_AELEMFAST:
     case OP_AELEMFAST:
+       localize = 1;
        PL_modcount++;
        break;
 
        PL_modcount++;
        break;
 
@@ -1103,17 +1124,13 @@ Perl_mod(pTHX_ OP *o, I32 type)
        /* FALL THROUGH */
     case OP_PADSV:
        PL_modcount++;
        /* FALL THROUGH */
     case OP_PADSV:
        PL_modcount++;
-       if (!type)
-       {   /* XXX DAPM 2002.08.25 tmp assert test */
-           /* XXX */ assert(av_fetch(PL_comppad_name, (o->op_targ), FALSE));
-           /* XXX */ assert(*av_fetch(PL_comppad_name, (o->op_targ), FALSE));
-
+       if (!type) /* local() */
            Perl_croak(aTHX_ "Can't localize lexical variable %s",
                 PAD_COMPNAME_PV(o->op_targ));
            Perl_croak(aTHX_ "Can't localize lexical variable %s",
                 PAD_COMPNAME_PV(o->op_targ));
-       }
        break;
 
     case OP_PUSHMARK:
        break;
 
     case OP_PUSHMARK:
+       localize = 0;
        break;
 
     case OP_KEYS:
        break;
 
     case OP_KEYS:
@@ -1144,6 +1161,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
            o->op_private |= OPpLVAL_DEFER;
        if (type == OP_LEAVESUBLV)
            o->op_private |= OPpMAYBE_LVSUB;
            o->op_private |= OPpLVAL_DEFER;
        if (type == OP_LEAVESUBLV)
            o->op_private |= OPpMAYBE_LVSUB;
+       localize = 1;
        PL_modcount++;
        break;
 
        PL_modcount++;
        break;
 
@@ -1151,11 +1169,13 @@ Perl_mod(pTHX_ OP *o, I32 type)
     case OP_LEAVE:
     case OP_ENTER:
     case OP_LINESEQ:
     case OP_LEAVE:
     case OP_ENTER:
     case OP_LINESEQ:
+       localize = 0;
        if (o->op_flags & OPf_KIDS)
            mod(cLISTOPo->op_last, type);
        break;
 
     case OP_NULL:
        if (o->op_flags & OPf_KIDS)
            mod(cLISTOPo->op_last, type);
        break;
 
     case OP_NULL:
+       localize = 0;
        if (o->op_flags & OPf_SPECIAL)          /* do BLOCK */
            goto nomod;
        else if (!(o->op_flags & OPf_KIDS))
        if (o->op_flags & OPf_SPECIAL)          /* do BLOCK */
            goto nomod;
        else if (!(o->op_flags & OPf_KIDS))
@@ -1166,6 +1186,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
        }
        /* FALL THROUGH */
     case OP_LIST:
        }
        /* FALL THROUGH */
     case OP_LIST:
+       localize = 0;
        for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
            mod(kid, type);
        break;
        for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
            mod(kid, type);
        break;
@@ -1188,10 +1209,21 @@ Perl_mod(pTHX_ OP *o, I32 type)
 
     if (type == OP_AASSIGN || type == OP_SASSIGN)
        o->op_flags |= OPf_SPECIAL|OPf_REF;
 
     if (type == OP_AASSIGN || type == OP_SASSIGN)
        o->op_flags |= OPf_SPECIAL|OPf_REF;
-    else if (!type) {
-       o->op_private |= OPpLVAL_INTRO;
-       o->op_flags &= ~OPf_SPECIAL;
-       PL_hints |= HINT_BLOCK_SCOPE;
+    else if (!type) { /* local() */
+       switch (localize) {
+       case 1:
+           o->op_private |= OPpLVAL_INTRO;
+           o->op_flags &= ~OPf_SPECIAL;
+           PL_hints |= HINT_BLOCK_SCOPE;
+           break;
+       case 0:
+           break;
+       case -1:
+           if (ckWARN(WARN_SYNTAX)) {
+               Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+                   "Useless localization of %s", OP_DESC(o));
+           }
+       }
     }
     else if (type != OP_GREPSTART && type != OP_ENTERSUB
              && type != OP_LEAVESUBLV)
     }
     else if (type != OP_GREPSTART && type != OP_ENTERSUB
              && type != OP_LEAVESUBLV)
@@ -1705,18 +1737,16 @@ Perl_scope(pTHX_ OP *o)
            o->op_type = OP_LEAVE;
            o->op_ppaddr = PL_ppaddr[OP_LEAVE];
        }
            o->op_type = OP_LEAVE;
            o->op_ppaddr = PL_ppaddr[OP_LEAVE];
        }
-       else {
-           if (o->op_type == OP_LINESEQ) {
-               OP *kid;
-               o->op_type = OP_SCOPE;
-               o->op_ppaddr = PL_ppaddr[OP_SCOPE];
-               kid = ((LISTOP*)o)->op_first;
-               if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
-                   op_null(kid);
-           }
-           else
-               o = newLISTOP(OP_SCOPE, 0, o, Nullop);
+       else if (o->op_type == OP_LINESEQ) {
+           OP *kid;
+           o->op_type = OP_SCOPE;
+           o->op_ppaddr = PL_ppaddr[OP_SCOPE];
+           kid = ((LISTOP*)o)->op_first;
+           if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
+               op_null(kid);
        }
        }
+       else
+           o = newLISTOP(OP_SCOPE, 0, o, Nullop);
     }
     return o;
 }
     }
     return o;
 }
@@ -1734,6 +1764,8 @@ int
 Perl_block_start(pTHX_ int full)
 {
     int retval = PL_savestack_ix;
 Perl_block_start(pTHX_ int full)
 {
     int retval = PL_savestack_ix;
+    /* If there were syntax errors, don't try to start a block */
+    if (PL_yynerrs) return retval;
 
     pad_block_start(full);
     SAVEHINTS();
 
     pad_block_start(full);
     SAVEHINTS();
@@ -1755,10 +1787,9 @@ OP*
 Perl_block_end(pTHX_ I32 floor, OP *seq)
 {
     int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
 Perl_block_end(pTHX_ I32 floor, OP *seq)
 {
     int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
-    line_t copline = PL_copline;
-    /* there should be a nextstate in every block */
-    OP* retval = seq ? scalarseq(seq) : newSTATEOP(0, Nullch, seq);
-    PL_copline = copline;  /* XXX newSTATEOP may reset PL_copline */
+    OP* retval = scalarseq(seq);
+    /* If there were syntax errors, don't try to close a block */
+    if (PL_yynerrs) return retval;
     LEAVE_SCOPE(floor);
     PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
     if (needblockscope)
     LEAVE_SCOPE(floor);
     PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
     if (needblockscope)
@@ -1789,8 +1820,12 @@ Perl_newPROG(pTHX_ OP *o)
        CALL_PEEP(PL_eval_start);
     }
     else {
        CALL_PEEP(PL_eval_start);
     }
     else {
-       if (!o)
+       if (o->op_type == OP_STUB) {
+           PL_comppad_name = 0;
+           PL_compcv = 0;
+           FreeOp(o);
            return;
            return;
+       }
        PL_main_root = scope(sawparens(scalarvoid(o)));
        PL_curcop = &PL_compiling;
        PL_main_start = LINKLIST(PL_main_root);
        PL_main_root = scope(sawparens(scalarvoid(o)));
        PL_curcop = &PL_compiling;
        PL_main_start = LINKLIST(PL_main_root);
@@ -1830,14 +1865,23 @@ Perl_localize(pTHX_ OP *o, I32 lex)
            && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',')
        {
            char *s = PL_bufptr;
            && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',')
        {
            char *s = PL_bufptr;
+           int sigil = 0;
 
 
-           while (*s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s) || strchr("@$%, ", *s)))
+           /* some heuristics to detect a potential error */
+           while (*s && (strchr(", \t\n", *s)
+                       || (strchr("@$%*", *s) && ++sigil) ))
                s++;
                s++;
-
-           if (*s == ';' || *s == '=')
-               Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS),
-                           "Parentheses missing around \"%s\" list",
-                           lex ? (PL_in_my == KEY_our ? "our" : "my") : "local");
+           if (sigil) {
+               while (*s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s)
+                           || strchr("@$%*, \t\n", *s)))
+                   s++;
+
+               if (*s == ';' || *s == '=')
+                   Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS),
+                               "Parentheses missing around \"%s\" list",
+                               lex ? (PL_in_my == KEY_our ? "our" : "my")
+                               : "local");
+           }
        }
     }
     if (lex)
        }
     }
     if (lex)
@@ -1933,19 +1977,7 @@ Perl_fold_constants(pTHX_ register OP *o)
     op_free(o);
     if (type == OP_RV2GV)
        return newGVOP(OP_GV, 0, (GV*)sv);
     op_free(o);
     if (type == OP_RV2GV)
        return newGVOP(OP_GV, 0, (GV*)sv);
-    else {
-       /* try to smush double to int, but don't smush -2.0 to -2 */
-       if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK &&
-           type != OP_NEGATE)
-       {
-#ifdef PERL_PRESERVE_IVUV
-           /* Only bother to attempt to fold to IV if
-              most operators will benefit  */
-           SvIV_please(sv);
-#endif
-       }
-       return newSVOP(OP_CONST, 0, sv);
-    }
+    return newSVOP(OP_CONST, 0, sv);
 
   nope:
     return o;
 
   nope:
     return o;
@@ -1972,6 +2004,8 @@ Perl_gen_constant_list(pTHX_ register OP *o)
 
     o->op_type = OP_RV2AV;
     o->op_ppaddr = PL_ppaddr[OP_RV2AV];
 
     o->op_type = OP_RV2AV;
     o->op_ppaddr = PL_ppaddr[OP_RV2AV];
+    o->op_flags &= ~OPf_REF;   /* treat \(1..2) like an ordinary list */
+    o->op_flags |= OPf_PARENS; /* and flatten \(1..2,3) */
     o->op_seq = 0;             /* needs to be revisited in peep() */
     curop = ((UNOP*)o)->op_first;
     ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--));
     o->op_seq = 0;             /* needs to be revisited in peep() */
     curop = ((UNOP*)o)->op_first;
     ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--));
@@ -2132,7 +2166,7 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
            listop->op_last = pushop;
     }
 
            listop->op_last = pushop;
     }
 
-    return (OP*)listop;
+    return CHECKOP(type, listop);
 }
 
 OP *
 }
 
 OP *
@@ -2255,13 +2289,13 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        U8* tend = t + tlen;
        U8* rend = r + rlen;
        STRLEN ulen;
        U8* tend = t + tlen;
        U8* rend = r + rlen;
        STRLEN ulen;
-       U32 tfirst = 1;
-       U32 tlast = 0;
-       I32 tdiff;
-       U32 rfirst = 1;
-       U32 rlast = 0;
-       I32 rdiff;
-       I32 diff;
+       UV tfirst = 1;
+       UV tlast = 0;
+       IV tdiff;
+       UV rfirst = 1;
+       UV rlast = 0;
+       IV rdiff;
+       IV diff;
        I32 none = 0;
        U32 max = 0;
        I32 bits;
        I32 none = 0;
        U32 max = 0;
        I32 bits;
@@ -2569,7 +2603,7 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
        PmopSTASH_set(pmop,PL_curstash);
     }
 
        PmopSTASH_set(pmop,PL_curstash);
     }
 
-    return (OP*)pmop;
+    return CHECKOP(type, pmop);
 }
 
 OP *
 }
 
 OP *
@@ -2616,6 +2650,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
                           : OPf_KIDS);
        rcop->op_private = 1;
        rcop->op_other = o;
                           : OPf_KIDS);
        rcop->op_private = 1;
        rcop->op_other = o;
+       /* /$x/ may cause an eval, since $x might be qr/(?{..})/  */
+       PL_cv_has_eval = 1;
 
        /* establish postfix order */
        if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL)) {
 
        /* establish postfix order */
        if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL)) {
@@ -2635,7 +2671,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
        OP *curop;
        if (pm->op_pmflags & PMf_EVAL) {
            curop = 0;
        OP *curop;
        if (pm->op_pmflags & PMf_EVAL) {
            curop = 0;
-           if (CopLINE(PL_curcop) < PL_multi_end)
+           if (CopLINE(PL_curcop) < (line_t)PL_multi_end)
                CopLINE_set(PL_curcop, (line_t)PL_multi_end);
        }
        else if (repl->op_type == OP_CONST)
                CopLINE_set(PL_curcop, (line_t)PL_multi_end);
        }
        else if (repl->op_type == OP_CONST)
@@ -2647,7 +2683,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
                    if (curop->op_type == OP_GV) {
                        GV *gv = cGVOPx_gv(curop);
                        repl_has_vars = 1;
                    if (curop->op_type == OP_GV) {
                        GV *gv = cGVOPx_gv(curop);
                        repl_has_vars = 1;
-                       if (strchr("&`'123456789+", *GvENAME(gv)))
+                       if (strchr("&`'123456789+-\016\022", *GvENAME(gv)))
                            break;
                    }
                    else if (curop->op_type == OP_RV2CV)
                            break;
                    }
                    else if (curop->op_type == OP_RV2CV)
@@ -2794,13 +2830,13 @@ Perl_package(pTHX_ OP *o)
 }
 
 void
 }
 
 void
-Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
+Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
 {
     OP *pack;
     OP *imop;
     OP *veop;
 
 {
     OP *pack;
     OP *imop;
     OP *veop;
 
-    if (id->op_type != OP_CONST)
+    if (idop->op_type != OP_CONST)
        Perl_croak(aTHX_ "Module name must be constant");
 
     veop = Nullop;
        Perl_croak(aTHX_ "Module name must be constant");
 
     veop = Nullop;
@@ -2818,8 +2854,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
            if (version->op_type != OP_CONST || !SvNIOKp(vesv))
                Perl_croak(aTHX_ "Version number must be constant number");
 
            if (version->op_type != OP_CONST || !SvNIOKp(vesv))
                Perl_croak(aTHX_ "Version number must be constant number");
 
-           /* Make copy of id so we don't free it twice */
-           pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
+           /* Make copy of idop so we don't free it twice */
+           pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv));
 
            /* Fake up a method call to VERSION */
            meth = newSVpvn("VERSION",7);
 
            /* Fake up a method call to VERSION */
            meth = newSVpvn("VERSION",7);
@@ -2836,14 +2872,14 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
     /* Fake up an import/unimport */
     if (arg && arg->op_type == OP_STUB)
        imop = arg;             /* no import on explicit () */
     /* Fake up an import/unimport */
     if (arg && arg->op_type == OP_STUB)
        imop = arg;             /* no import on explicit () */
-    else if (SvNIOKp(((SVOP*)id)->op_sv)) {
+    else if (SvNIOKp(((SVOP*)idop)->op_sv)) {
        imop = Nullop;          /* use 5.0; */
     }
     else {
        SV *meth;
 
        imop = Nullop;          /* use 5.0; */
     }
     else {
        SV *meth;
 
-       /* Make copy of id so we don't free it twice */
-       pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
+       /* Make copy of idop so we don't free it twice */
+       pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv));
 
        /* Fake up a method call to import/unimport */
        meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);
 
        /* Fake up a method call to import/unimport */
        meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);
@@ -2863,7 +2899,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
        Nullop,
        append_elem(OP_LINESEQ,
            append_elem(OP_LINESEQ,
        Nullop,
        append_elem(OP_LINESEQ,
            append_elem(OP_LINESEQ,
-               newSTATEOP(0, Nullch, newUNOP(OP_REQUIRE, 0, id)),
+               newSTATEOP(0, Nullch, newUNOP(OP_REQUIRE, 0, idop)),
                newSTATEOP(0, Nullch, veop)),
            newSTATEOP(0, Nullch, imop) ));
 
                newSTATEOP(0, Nullch, veop)),
            newSTATEOP(0, Nullch, imop) ));
 
@@ -2887,6 +2923,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
     PL_hints |= HINT_BLOCK_SCOPE;
     PL_copline = NOLINE;
     PL_expect = XSTATE;
     PL_hints |= HINT_BLOCK_SCOPE;
     PL_copline = NOLINE;
     PL_expect = XSTATE;
+    PL_cop_seqmax++; /* Purely for B::*'s benefit */
 }
 
 /*
 }
 
 /*
@@ -2955,12 +2992,14 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args)
     }
     {
        line_t ocopline = PL_copline;
     }
     {
        line_t ocopline = PL_copline;
+       COP *ocurcop = PL_curcop;
        int oexpect = PL_expect;
 
        utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
                veop, modname, imop);
        PL_expect = oexpect;
        PL_copline = ocopline;
        int oexpect = PL_expect;
 
        utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
                veop, modname, imop);
        PL_expect = oexpect;
        PL_copline = ocopline;
+       PL_curcop = ocurcop;
     }
 }
 
     }
 }
 
@@ -3099,7 +3138,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                             curop->op_type == OP_PADANY)
                    {
                        if (PAD_COMPNAME_GEN(curop->op_targ)
                             curop->op_type == OP_PADANY)
                    {
                        if (PAD_COMPNAME_GEN(curop->op_targ)
-                                                   == PL_generation)
+                                                   == (STRLEN)PL_generation)
                            break;
                        PAD_COMPNAME_GEN(curop->op_targ)
                                                        = PL_generation;
                            break;
                        PAD_COMPNAME_GEN(curop->op_targ)
                                                        = PL_generation;
@@ -3313,7 +3352,9 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
            return first;
        }
     }
            return first;
        }
     }
-    else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS)) {
+    else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS) &&
+             type != OP_DOR) /* [#24076] Don't warn for <FH> err FOO. */
+    {
        OP *k1 = ((UNOP*)first)->op_first;
        OP *k2 = k1->op_sibling;
        OPCODE warnop = 0;
        OP *k1 = ((UNOP*)first)->op_first;
        OP *k2 = k1->op_sibling;
        OPCODE warnop = 0;
@@ -3371,6 +3412,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
     first->op_next = (OP*)logop;
     first->op_sibling = other;
 
     first->op_next = (OP*)logop;
     first->op_sibling = other;
 
+    CHECKOP(type,logop);
+
     o = newUNOP(OP_NULL, 0, (OP*)logop);
     other->op_next = o;
 
     o = newUNOP(OP_NULL, 0, (OP*)logop);
     other->op_next = o;
 
@@ -3415,6 +3458,8 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
     logop->op_other = LINKLIST(trueop);
     logop->op_next = LINKLIST(falseop);
 
     logop->op_other = LINKLIST(trueop);
     logop->op_next = LINKLIST(falseop);
 
+    CHECKOP(OP_COND_EXPR, /* that's logop->op_type */
+           logop);
 
     /* establish postfix order */
     start = LINKLIST(first);
 
     /* establish postfix order */
     start = LINKLIST(first);
@@ -3579,11 +3624,6 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
        if (!next)
            next = unstack;
        cont = append_elem(OP_LINESEQ, cont, unstack);
        if (!next)
            next = unstack;
        cont = append_elem(OP_LINESEQ, cont, unstack);
-       if ((line_t)whileline != NOLINE) {
-           PL_copline = (line_t)whileline;
-           cont = append_elem(OP_LINESEQ, cont,
-                              newSTATEOP(0, Nullch, Nullop));
-       }
     }
 
     listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
     }
 
     listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
@@ -3636,13 +3676,16 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
     OP *wop;
     PADOFFSET padoff = 0;
     I32 iterflags = 0;
     OP *wop;
     PADOFFSET padoff = 0;
     I32 iterflags = 0;
+    I32 iterpflags = 0;
 
     if (sv) {
        if (sv->op_type == OP_RV2SV) {  /* symbol table variable */
 
     if (sv) {
        if (sv->op_type == OP_RV2SV) {  /* symbol table variable */
+           iterpflags = sv->op_private & OPpOUR_INTRO; /* for our $x () */
            sv->op_type = OP_RV2GV;
            sv->op_ppaddr = PL_ppaddr[OP_RV2GV];
        }
        else if (sv->op_type == OP_PADSV) { /* private variable */
            sv->op_type = OP_RV2GV;
            sv->op_ppaddr = PL_ppaddr[OP_RV2GV];
        }
        else if (sv->op_type == OP_PADSV) { /* private variable */
+           iterpflags = sv->op_private & OPpLVAL_INTRO; /* for my $x () */
            padoff = sv->op_targ;
            sv->op_targ = 0;
            op_free(sv);
            padoff = sv->op_targ;
            sv->op_targ = 0;
            op_free(sv);
@@ -3701,6 +3744,9 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
     loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
                               append_elem(OP_LIST, expr, scalar(sv))));
     assert(!loop->op_next);
     loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
                               append_elem(OP_LIST, expr, scalar(sv))));
     assert(!loop->op_next);
+    /* for my  $x () sets OPpLVAL_INTRO;
+     * for our $x () sets OPpOUR_INTRO */
+    loop->op_private = (U8)iterpflags;
 #ifdef PL_OP_SLAB_ALLOC
     {
        LOOP *tmp;
 #ifdef PL_OP_SLAB_ALLOC
     {
        LOOP *tmp;
@@ -3736,7 +3782,9 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
        op_free(label);
     }
     else {
        op_free(label);
     }
     else {
-       if (label->op_type == OP_ENTERSUB)
+       /* Check whether it's going to be a goto &function */
+       if (label->op_type == OP_ENTERSUB
+               && !(label->op_flags & OPf_STACKED))
            label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
        o = newUNOP(type, OPf_STACKED, label);
     }
            label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
        o = newUNOP(type, OPf_STACKED, label);
     }
@@ -3744,12 +3792,20 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
     return o;
 }
 
     return o;
 }
 
+/*
+=for apidoc cv_undef
+
+Clear out all the active components of a CV. This can happen either
+by an explicit C<undef &foo>, or by the reference count going to zero.
+In the former case, we keep the CvOUTSIDE pointer, so that any anonymous
+children can still follow the full lexical scope chain.
+
+=cut
+*/
+
 void
 Perl_cv_undef(pTHX_ CV *cv)
 {
 void
 Perl_cv_undef(pTHX_ CV *cv)
 {
-    CV *outsidecv;
-    CV *freecv = Nullcv;
-
 #ifdef USE_ITHREADS
     if (CvFILE(cv) && !CvXSUB(cv)) {
        /* for XSUBs CvFILE point directly to static memory; __FILE__ */
 #ifdef USE_ITHREADS
     if (CvFILE(cv) && !CvXSUB(cv)) {
        /* for XSUBs CvFILE point directly to static memory; __FILE__ */
@@ -3771,26 +3827,24 @@ Perl_cv_undef(pTHX_ CV *cv)
     }
     SvPOK_off((SV*)cv);                /* forget prototype */
     CvGV(cv) = Nullgv;
     }
     SvPOK_off((SV*)cv);                /* forget prototype */
     CvGV(cv) = Nullgv;
-    outsidecv = CvOUTSIDE(cv);
-    /* Since closure prototypes have the same lifetime as the containing
-     * CV, they don't hold a refcount on the outside CV.  This avoids
-     * the refcount loop between the outer CV (which keeps a refcount to
-     * the closure prototype in the pad entry for pp_anoncode()) and the
-     * closure prototype, and the ensuing memory leak.  --GSAR */
-    if (!CvANON(cv) || CvCLONED(cv))
-        freecv = outsidecv;
-    CvOUTSIDE(cv) = Nullcv;
+
+    pad_undef(cv);
+
+    /* remove CvOUTSIDE unless this is an undef rather than a free */
+    if (!SvREFCNT(cv) && CvOUTSIDE(cv)) {
+       if (!CvWEAKOUTSIDE(cv))
+           SvREFCNT_dec(CvOUTSIDE(cv));
+       CvOUTSIDE(cv) = Nullcv;
+    }
     if (CvCONST(cv)) {
        SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
        CvCONST_off(cv);
     }
     if (CvCONST(cv)) {
        SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
        CvCONST_off(cv);
     }
-    pad_undef(cv, outsidecv);
-    if (freecv)
-       SvREFCNT_dec(freecv);
     if (CvXSUB(cv)) {
         CvXSUB(cv) = 0;
     }
     if (CvXSUB(cv)) {
         CvXSUB(cv) = 0;
     }
-    CvFLAGS(cv) = 0;
+    /* delete all flags except WEAKOUTSIDE */
+    CvFLAGS(cv) &= CVf_WEAKOUTSIDE;
 }
 
 void
 }
 
 void
@@ -3806,7 +3860,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
        if (name)
            Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, name);
        if (SvPOK(cv))
        if (name)
            Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, name);
        if (SvPOK(cv))
-           Perl_sv_catpvf(aTHX_ msg, " (%s)", SvPVX(cv));
+           Perl_sv_catpvf(aTHX_ msg, " (%"SVf")", (SV *)cv);
        sv_catpv(msg, " vs ");
        if (p)
            Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
        sv_catpv(msg, " vs ");
        if (p)
            Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
@@ -3840,6 +3894,26 @@ Perl_cv_const_sv(pTHX_ CV *cv)
     return (SV*)CvXSUBANY(cv).any_ptr;
 }
 
     return (SV*)CvXSUBANY(cv).any_ptr;
 }
 
+/* op_const_sv:  examine an optree to determine whether it's in-lineable.
+ * Can be called in 3 ways:
+ *
+ * !cv
+ *     look for a single OP_CONST with attached value: return the value
+ *
+ * cv && CvCLONE(cv) && !CvCONST(cv)
+ *
+ *     examine the clone prototype, and if contains only a single
+ *     OP_CONST referencing a pad const, or a single PADSV referencing
+ *     an outer lexical, return a non-zero value to indicate the CV is
+ *     a candidate for "constizing" at clone time
+ *
+ * cv && CvCONST(cv)
+ *
+ *     We have just cloned an anon prototype that was marked as a const
+ *     candidiate. Try to grab the current value, and in the case of
+ *     PADSV, ignore it if it has multiple references. Return the value.
+ */
+
 SV *
 Perl_op_const_sv(pTHX_ OP *o, CV *cv)
 {
 SV *
 Perl_op_const_sv(pTHX_ OP *o, CV *cv)
 {
@@ -3868,26 +3942,31 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv)
            return Nullsv;
        if (type == OP_CONST && cSVOPo->op_sv)
            sv = cSVOPo->op_sv;
            return Nullsv;
        if (type == OP_CONST && cSVOPo->op_sv)
            sv = cSVOPo->op_sv;
-       else if ((type == OP_PADSV || type == OP_CONST) && cv) {
+       else if (cv && type == OP_CONST) {
            sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ);
            if (!sv)
                return Nullsv;
            sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ);
            if (!sv)
                return Nullsv;
-           if (CvCONST(cv)) {
-               /* We get here only from cv_clone2() while creating a closure.
-                  Copy the const value here instead of in cv_clone2 so that
-                  SvREADONLY_on doesn't lead to problems when leaving
-                  scope.
-               */
+       }
+       else if (cv && type == OP_PADSV) {
+           if (CvCONST(cv)) { /* newly cloned anon */
+               sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ);
+               /* the candidate should have 1 ref from this pad and 1 ref
+                * from the parent */
+               if (!sv || SvREFCNT(sv) != 2)
+                   return Nullsv;
                sv = newSVsv(sv);
                sv = newSVsv(sv);
+               SvREADONLY_on(sv);
+               return sv;
+           }
+           else {
+               if (PAD_COMPNAME_FLAGS(o->op_targ) & SVf_FAKE)
+                   sv = &PL_sv_undef; /* an arbitrary non-null value */
            }
            }
-           if (!SvREADONLY(sv) && SvREFCNT(sv) > 1)
-               return Nullsv;
        }
        }
-       else
+       else {
            return Nullsv;
            return Nullsv;
+       }
     }
     }
-    if (sv)
-       SvREADONLY_on(sv);
     return sv;
 }
 
     return sv;
 }
 
@@ -4077,9 +4156,11 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            SAVEFREESV(PL_compcv);
            goto done;
        }
            SAVEFREESV(PL_compcv);
            goto done;
        }
+       /* transfer PL_compcv to cv */
        cv_undef(cv);
        CvFLAGS(cv) = CvFLAGS(PL_compcv);
        CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
        cv_undef(cv);
        CvFLAGS(cv) = CvFLAGS(PL_compcv);
        CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
+       CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(PL_compcv);
        CvOUTSIDE(PL_compcv) = 0;
        CvPADLIST(cv) = CvPADLIST(PL_compcv);
        CvPADLIST(PL_compcv) = 0;
        CvOUTSIDE(PL_compcv) = 0;
        CvPADLIST(cv) = CvPADLIST(PL_compcv);
        CvPADLIST(PL_compcv) = 0;
@@ -4087,6 +4168,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        pad_fixup_inner_anons(CvPADLIST(cv), PL_compcv, cv);
        /* ... before we throw it away */
        SvREFCNT_dec(PL_compcv);
        pad_fixup_inner_anons(CvPADLIST(cv), PL_compcv, cv);
        /* ... before we throw it away */
        SvREFCNT_dec(PL_compcv);
+       PL_compcv = cv;
        if (PERLDB_INTER)/* Advice debugger on the new sub. */
          ++PL_sub_generation;
     }
        if (PERLDB_INTER)/* Advice debugger on the new sub. */
          ++PL_sub_generation;
     }
@@ -4119,7 +4201,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                else {
                    /* force display of errors found but not reported */
                    sv_catpv(ERRSV, not_safe);
                else {
                    /* force display of errors found but not reported */
                    sv_catpv(ERRSV, not_safe);
-                   Perl_croak(aTHX_ "%s", SvPVx(ERRSV, n_a));
+                   Perl_croak(aTHX_ "%"SVf, ERRSV);
                }
            }
        }
                }
            }
        }
@@ -4132,6 +4214,11 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                             mod(scalarseq(block), OP_LEAVESUBLV));
     }
     else {
                             mod(scalarseq(block), OP_LEAVESUBLV));
     }
     else {
+       /* This makes sub {}; work as expected.  */
+       if (block->op_type == OP_STUB) {
+           op_free(block);
+           block = newSTATEOP(0, Nullch, 0);
+       }
        CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
     }
     CvROOT(cv)->op_private |= OPpREFCOUNTED;
        CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
     }
     CvROOT(cv)->op_private |= OPpREFCOUNTED;
@@ -4150,13 +4237,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            CvCONST_on(cv);
     }
 
            CvCONST_on(cv);
     }
 
-    /* If a potential closure prototype, don't keep a refcount on outer CV.
-     * This is okay as the lifetime of the prototype is tied to the
-     * lifetime of the outer CV.  Avoids memory leak due to reference
-     * loop. --GSAR */
-    if (!name)
-       SvREFCNT_dec(CvOUTSIDE(cv));
-
     if (name || aname) {
        char *s;
        char *tname = (name ? name : aname);
     if (name || aname) {
        char *s;
        char *tname = (name ? name : aname);
@@ -4193,7 +4273,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I')
            goto done;
 
        if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I')
            goto done;
 
-       if (strEQ(s, "BEGIN")) {
+       if (strEQ(s, "BEGIN") && !PL_error_count) {
            I32 oldscope = PL_scopestack_ix;
            ENTER;
            SAVECOPFILE(&PL_compiling);
            I32 oldscope = PL_scopestack_ix;
            ENTER;
            SAVECOPFILE(&PL_compiling);
@@ -4275,11 +4355,14 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
        CopSTASH_set(PL_curcop,stash);
     }
 
        CopSTASH_set(PL_curcop,stash);
     }
 
-    cv = newXS(name, const_sv_xsub, __FILE__);
+    cv = newXS(name, const_sv_xsub, savepv(CopFILE(PL_curcop)));
     CvXSUBANY(cv).any_ptr = sv;
     CvCONST_on(cv);
     sv_setpv((SV*)cv, "");  /* prototype is "" */
 
     CvXSUBANY(cv).any_ptr = sv;
     CvCONST_on(cv);
     sv_setpv((SV*)cv, "");  /* prototype is "" */
 
+    if (stash)
+       CopSTASH_free(PL_curcop);
+
     LEAVE;
 
     return cv;
     LEAVE;
 
     return cv;
@@ -4607,13 +4690,17 @@ Perl_ck_bitop(pTHX_ OP *o)
         (op) == OP_NE   || (op) == OP_I_NE || \
         (op) == OP_NCMP || (op) == OP_I_NCMP)
     o->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
         (op) == OP_NE   || (op) == OP_I_NE || \
         (op) == OP_NCMP || (op) == OP_I_NCMP)
     o->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
-    if (o->op_type == OP_BIT_OR
-           || o->op_type == OP_BIT_AND
-           || o->op_type == OP_BIT_XOR)
+    if (!(o->op_flags & OPf_STACKED) /* Not an assignment */
+           && (o->op_type == OP_BIT_OR
+            || o->op_type == OP_BIT_AND
+            || o->op_type == OP_BIT_XOR))
     {
     {
-       OPCODE typfirst = cBINOPo->op_first->op_type;
-       OPCODE typlast  = cBINOPo->op_first->op_sibling->op_type;
-       if (OP_IS_NUMCOMPARE(typfirst) || OP_IS_NUMCOMPARE(typlast))
+       OP * left = cBINOPo->op_first;
+       OP * right = left->op_sibling;
+       if ((OP_IS_NUMCOMPARE(left->op_type) &&
+               (left->op_flags & OPf_PARENS) == 0) ||
+           (OP_IS_NUMCOMPARE(right->op_type) &&
+               (right->op_flags & OPf_PARENS) == 0))
            if (ckWARN(WARN_PRECEDENCE))
                Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE),
                        "Possible precedence problem on bitwise %c operator",
            if (ckWARN(WARN_PRECEDENCE))
                Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE),
                        "Possible precedence problem on bitwise %c operator",
@@ -4627,8 +4714,10 @@ Perl_ck_bitop(pTHX_ OP *o)
 OP *
 Perl_ck_concat(pTHX_ OP *o)
 {
 OP *
 Perl_ck_concat(pTHX_ OP *o)
 {
-    if (cUNOPo->op_first->op_type == OP_CONCAT)
-       o->op_flags |= OPf_STACKED;
+    OP *kid = cUNOPo->op_first;
+    if (kid->op_type == OP_CONCAT && !(kid->op_private & OPpTARGET_MY) &&
+           !(kUNOP->op_first->op_flags & OPf_MOD))
+        o->op_flags |= OPf_STACKED;
     return o;
 }
 
     return o;
 }
 
@@ -4702,8 +4791,7 @@ Perl_ck_eof(pTHX_ OP *o)
     if (o->op_flags & OPf_KIDS) {
        if (cLISTOPo->op_first->op_type == OP_STUB) {
            op_free(o);
     if (o->op_flags & OPf_KIDS) {
        if (cLISTOPo->op_first->op_type == OP_STUB) {
            op_free(o);
-           o = newUNOP(type, OPf_SPECIAL,
-               newGVOP(OP_GV, 0, gv_fetchpv("main::ARGV", TRUE, SVt_PVAV)));
+           o = newUNOP(type, OPf_SPECIAL, newGVOP(OP_GV, 0, PL_argvgv));
        }
        return ck_fun(o);
     }
        }
        return ck_fun(o);
     }
@@ -4721,10 +4809,9 @@ Perl_ck_eval(pTHX_ OP *o)
            o->op_flags &= ~OPf_KIDS;
            op_null(o);
        }
            o->op_flags &= ~OPf_KIDS;
            op_null(o);
        }
-       else if (kid->op_type == OP_LINESEQ) {
+       else if (kid->op_type == OP_LINESEQ || kid->op_type == OP_STUB) {
            LOGOP *enter;
 
            LOGOP *enter;
 
-           kid->op_next = o->op_next;
            cUNOPo->op_first = 0;
            op_free(o);
 
            cUNOPo->op_first = 0;
            op_free(o);
 
@@ -4742,8 +4829,10 @@ Perl_ck_eval(pTHX_ OP *o)
            enter->op_other = o;
            return o;
        }
            enter->op_other = o;
            return o;
        }
-       else
+       else {
            scalar((OP*)kid);
            scalar((OP*)kid);
+           PL_cv_has_eval = 1;
+       }
     }
     else {
        op_free(o);
     }
     else {
        op_free(o);
@@ -4936,12 +5025,16 @@ Perl_ck_ftst(pTHX_ OP *o)
            op_free(o);
            o = newop;
        }
            op_free(o);
            o = newop;
        }
+       else {
+         if ((PL_hints & HINT_FILETEST_ACCESS) &&
+             OP_IS_FILETEST_ACCESS(o))
+           o->op_private |= OPpFT_ACCESS;
+       }
     }
     else {
        op_free(o);
        if (type == OP_FTTTY)
     }
     else {
        op_free(o);
        if (type == OP_FTTTY)
-           o =  newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
-                               SVt_PVIO));
+           o = newGVOP(type, OPf_REF, PL_stdingv);
        else
            o = newUNOP(type, 0, newDEFSVOP());
     }
        else
            o = newUNOP(type, 0, newDEFSVOP());
     }
@@ -5091,10 +5184,6 @@ Perl_ck_fun(pTHX_ OP *o)
                             */
                            priv = OPpDEREF;
                            if (kid->op_type == OP_PADSV) {
                             */
                            priv = OPpDEREF;
                            if (kid->op_type == OP_PADSV) {
-                               /*XXX DAPM 2002.08.25 tmp assert test */
-                               /*XXX*/ assert(av_fetch(PL_comppad_name, (kid->op_targ), FALSE));
-                               /*XXX*/ assert(*av_fetch(PL_comppad_name, (kid->op_targ), FALSE));
-
                                name = PAD_COMPNAME_PV(kid->op_targ);
                                /* SvCUR of a pad namesv can't be trusted
                                 * (see PL_generation), so calc its length
                                name = PAD_COMPNAME_PV(kid->op_targ);
                                /* SvCUR of a pad namesv can't be trusted
                                 * (see PL_generation), so calc its length
@@ -5113,9 +5202,50 @@ Perl_ck_fun(pTHX_ OP *o)
                            else if (kid->op_type == OP_AELEM
                                     || kid->op_type == OP_HELEM)
                            {
                            else if (kid->op_type == OP_AELEM
                                     || kid->op_type == OP_HELEM)
                            {
-                               name = "__ANONIO__";
-                               len = 10;
-                               mod(kid,type);
+                                OP *op;
+
+                                name = 0;
+                                if ((op = ((BINOP*)kid)->op_first)) {
+                                     SV *tmpstr = Nullsv;
+                                     char *a =
+                                          kid->op_type == OP_AELEM ?
+                                          "[]" : "{}";
+                                     if (((op->op_type == OP_RV2AV) ||
+                                          (op->op_type == OP_RV2HV)) &&
+                                         (op = ((UNOP*)op)->op_first) &&
+                                         (op->op_type == OP_GV)) {
+                                          /* packagevar $a[] or $h{} */
+                                          GV *gv = cGVOPx_gv(op);
+                                          if (gv)
+                                               tmpstr =
+                                                    Perl_newSVpvf(aTHX_
+                                                                  "%s%c...%c",
+                                                                  GvNAME(gv),
+                                                                  a[0], a[1]);
+                                     }
+                                     else if (op->op_type == OP_PADAV
+                                              || op->op_type == OP_PADHV) {
+                                          /* lexicalvar $a[] or $h{} */
+                                          char *padname =
+                                               PAD_COMPNAME_PV(op->op_targ);
+                                          if (padname)
+                                               tmpstr =
+                                                    Perl_newSVpvf(aTHX_
+                                                                  "%s%c...%c",
+                                                                  padname + 1,
+                                                                  a[0], a[1]);
+                                          
+                                     }
+                                     if (tmpstr) {
+                                          name = SvPV(tmpstr, len);
+                                          sv_2mortal(tmpstr);
+                                     }
+                                }
+                                if (!name) {
+                                     name = "__ANONIO__";
+                                     len = 10;
+                                }
+                                mod(kid, type);
                            }
                            if (name) {
                                SV *namesv;
                            }
                            if (name) {
                                SV *namesv;
@@ -5181,7 +5311,7 @@ Perl_ck_glob(pTHX_ OP *o)
 
 #if !defined(PERL_EXTERNAL_GLOB)
     /* XXX this can be tightened up and made more failsafe. */
 
 #if !defined(PERL_EXTERNAL_GLOB)
     /* XXX this can be tightened up and made more failsafe. */
-    if (!gv) {
+    if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) {
        GV *glob_gv;
        ENTER;
        Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
        GV *glob_gv;
        ENTER;
        Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
@@ -5202,6 +5332,7 @@ Perl_ck_glob(pTHX_ OP *o)
        o->op_ppaddr = PL_ppaddr[OP_LIST];
        cLISTOPo->op_first->op_type = OP_PUSHMARK;
        cLISTOPo->op_first->op_ppaddr = PL_ppaddr[OP_PUSHMARK];
        o->op_ppaddr = PL_ppaddr[OP_LIST];
        cLISTOPo->op_first->op_type = OP_PUSHMARK;
        cLISTOPo->op_first->op_ppaddr = PL_ppaddr[OP_PUSHMARK];
+       cLISTOPo->op_first->op_targ = 0;
        o = newUNOP(OP_ENTERSUB, OPf_STACKED,
                    append_elem(OP_LIST, o,
                                scalar(newUNOP(OP_RV2CV, 0,
        o = newUNOP(OP_ENTERSUB, OPf_STACKED,
                    append_elem(OP_LIST, o,
                                scalar(newUNOP(OP_RV2CV, 0,
@@ -5462,6 +5593,25 @@ Perl_ck_open(pTHX_ OP *o)
     }
     if (o->op_type == OP_BACKTICK)
        return o;
     }
     if (o->op_type == OP_BACKTICK)
        return o;
+    {
+        /* In case of three-arg dup open remove strictness
+         * from the last arg if it is a bareword. */
+        OP *first = cLISTOPx(o)->op_first; /* The pushmark. */
+        OP *last  = cLISTOPx(o)->op_last;  /* The bareword. */
+        OP *oa;
+        char *mode;
+
+        if ((last->op_type == OP_CONST) &&             /* The bareword. */
+            (last->op_private & OPpCONST_BARE) &&
+            (last->op_private & OPpCONST_STRICT) &&
+            (oa = first->op_sibling) &&                /* The fh. */
+            (oa = oa->op_sibling) &&                   /* The mode. */
+            SvPOK(((SVOP*)oa)->op_sv) &&
+            (mode = SvPVX(((SVOP*)oa)->op_sv)) &&
+            mode[0] == '>' && mode[1] == '&' &&        /* A dup open. */
+            (last == oa->op_sibling))                  /* The bareword. */
+             last->op_private &= ~OPpCONST_STRICT;
+    }
     return ck_fun(o);
 }
 
     return ck_fun(o);
 }
 
@@ -5574,8 +5724,7 @@ Perl_ck_shift(pTHX_ OP *o)
 
        op_free(o);
        argop = newUNOP(OP_RV2AV, 0,
 
        op_free(o);
        argop = newUNOP(OP_RV2AV, 0,
-           scalar(newGVOP(OP_GV, 0, !CvUNIQUE(PL_compcv) ?
-                          PL_defgv : gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
+           scalar(newGVOP(OP_GV, 0, CvUNIQUE(PL_compcv) ? PL_argvgv : PL_defgv)));
        return newUNOP(type, 0, scalar(argop));
     }
     return scalar(modkids(ck_fun(o), type));
        return newUNOP(type, 0, scalar(argop));
     }
     return scalar(modkids(ck_fun(o), type));
@@ -5795,6 +5944,7 @@ Perl_ck_subr(pTHX_ OP *o)
     I32 contextclass = 0;
     char *e = 0;
     STRLEN n_a;
     I32 contextclass = 0;
     char *e = 0;
     STRLEN n_a;
+    bool delete=0;
 
     o->op_private |= OPpENTERSUB_HASTARG;
     for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
 
     o->op_private |= OPpENTERSUB_HASTARG;
     for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
@@ -5808,9 +5958,24 @@ Perl_ck_subr(pTHX_ OP *o)
            cv = GvCVu(gv);
            if (!cv)
                tmpop->op_private |= OPpEARLY_CV;
            cv = GvCVu(gv);
            if (!cv)
                tmpop->op_private |= OPpEARLY_CV;
-           else if (SvPOK(cv)) {
-               namegv = CvANON(cv) ? gv : CvGV(cv);
-               proto = SvPV((SV*)cv, n_a);
+           else {
+               if (SvPOK(cv)) {
+                   namegv = CvANON(cv) ? gv : CvGV(cv);
+                   proto = SvPV((SV*)cv, n_a);
+               }
+               if (CvASSERTION(cv)) {
+                   if (PL_hints & HINT_ASSERTING) {
+                       if (PERLDB_ASSERTION && PL_curstash != PL_debstash)
+                           o->op_private |= OPpENTERSUB_DB;
+                   }
+                   else {
+                       delete=1;
+                       if (ckWARN(WARN_ASSERTIONS) && !(PL_hints & HINT_ASSERTIONSSEEN)) {
+                           Perl_warner(aTHX_ packWARN(WARN_ASSERTIONS),
+                                       "Impossible to activate assertion call");
+                       }
+                   }
+               }
            }
        }
     }
            }
        }
     }
@@ -5981,8 +6146,8 @@ Perl_ck_subr(pTHX_ OP *o)
                continue;
            default:
              oops:
                continue;
            default:
              oops:
-               Perl_croak(aTHX_ "Malformed prototype for %s: %s",
-                          gv_ename(namegv), SvPV((SV*)cv, n_a));
+               Perl_croak(aTHX_ "Malformed prototype for %s: %"SVf,
+                          gv_ename(namegv), cv);
            }
        }
        else
            }
        }
        else
@@ -5994,6 +6159,10 @@ Perl_ck_subr(pTHX_ OP *o)
     if (proto && !optional &&
          (*proto && *proto != '@' && *proto != '%' && *proto != ';'))
        return too_few_arguments(o, gv_ename(namegv));
     if (proto && !optional &&
          (*proto && *proto != '@' && *proto != '%' && *proto != ';'))
        return too_few_arguments(o, gv_ename(namegv));
+    if(delete) {
+       op_free(o);
+       o=newSVOP(OP_CONST, 0, newSViv(0));
+    }
     return o;
 }
 
     return o;
 }
 
@@ -6023,6 +6192,18 @@ Perl_ck_trunc(pTHX_ OP *o)
 }
 
 OP *
 }
 
 OP *
+Perl_ck_unpack(pTHX_ OP *o)
+{
+    OP *kid = cLISTOPo->op_first;
+    if (kid->op_sibling) {
+       kid = kid->op_sibling;
+       if (!kid->op_sibling)
+           kid->op_sibling = newDEFSVOP();
+    }
+    return ck_fun(o);
+}
+
+OP *
 Perl_ck_substr(pTHX_ OP *o)
 {
     o = ck_fun(o);
 Perl_ck_substr(pTHX_ OP *o)
 {
     o = ck_fun(o);
@@ -6053,8 +6234,10 @@ Perl_peep(pTHX_ register OP *o)
     for (; o; o = o->op_next) {
        if (o->op_seq)
            break;
     for (; o; o = o->op_next) {
        if (o->op_seq)
            break;
-       if (!PL_op_seqmax)
-           PL_op_seqmax++;
+        /* The special value -1 is used by the B::C compiler backend to indicate
+         * that an op is statically defined and should not be freed */
+       if (!PL_op_seqmax || PL_op_seqmax == (U16)-1)
+           PL_op_seqmax = 1;
        PL_op = o;
        switch (o->op_type) {
        case OP_SETSTATE:
        PL_op = o;
        switch (o->op_type) {
        case OP_SETSTATE:
@@ -6068,12 +6251,13 @@ 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_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) {
                PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP);
            /* 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) {
                PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP);
-               if (SvPADTMP(cSVOPo->op_sv)) {
+               if (o->op_type == OP_CONST && 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);
                    /* 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);
@@ -6187,8 +6371,8 @@ Perl_peep(pTHX_ register OP *o)
                    SV *sv = sv_newmortal();
                    gv_efullname3(sv, gv, Nullch);
                    Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE),
                    SV *sv = sv_newmortal();
                    gv_efullname3(sv, gv, Nullch);
                    Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE),
-                               "%s() called too early to check prototype",
-                               SvPV_nolen(sv));
+                               "%"SVf"() called too early to check prototype",
+                               sv);
                }
            }
            else if (o->op_next->op_type == OP_READLINE
                }
            }
            else if (o->op_next->op_type == OP_READLINE
Unnamed repository; edit this file 'description' to name the repository.