Update Module-CoreList Changes file for 5.20141002 release

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 7e7d667..08e6028 100644 (file)
--- a/op.c
+++ b/op.c
@@ -535,7 +535,7 @@ S_bad_type_pv(pTHX_ I32 n, const char *t, const char *name, U32 flags, const OP
 STATIC void
 S_bad_type_gv(pTHX_ I32 n, const char *t, GV *gv, U32 flags, const OP *kid)
 {
-    SV * const namesv = cv_name((CV *)gv, NULL);
+    SV * const namesv = cv_name((CV *)gv, NULL, 0);
     PERL_ARGS_ASSERT_BAD_TYPE_GV;
  
     yyerror_pv(Perl_form(aTHX_ "Type of arg %d to %"SVf" must be %s (not %s)",
@@ -1034,25 +1034,25 @@ Perl_op_refcnt_unlock(pTHX)
 =for apidoc op_sibling_splice
 
 A general function for editing the structure of an existing chain of
-op_sibling nodes. By analogy with the perl-level splice() function, allows
+op_sibling nodes.  By analogy with the perl-level splice() function, allows
 you to delete zero or more sequential nodes, replacing them with zero or
 more different nodes.  Performs the necessary op_first/op_last
 housekeeping on the parent node and op_sibling manipulation on the
-children. The last deleted node will be marked as as the last node by
+children.  The last deleted node will be marked as as the last node by
 updating the op_sibling or op_lastsib field as appropriate.
 
 Note that op_next is not manipulated, and nodes are not freed; that is the
-responsibility of the caller. It also won't create a new list op for an
+responsibility of the caller.  It also won't create a new list op for an
 empty list etc; use higher-level functions like op_append_elem() for that.
 
 parent is the parent node of the sibling chain.
 
-start is the node preceding the first node to be spliced. Node(s)
-following it will be deleted, and ops will be inserted after it. If it is
+start is the node preceding the first node to be spliced.  Node(s)
+following it will be deleted, and ops will be inserted after it.  If it is
 NULL, the first node onwards is deleted, and nodes are inserted at the
 beginning.
 
-del_count is the number of nodes to delete. If zero, no nodes are deleted.
+del_count is the number of nodes to delete.  If zero, no nodes are deleted.
 If -1 or greater than or equal to the number of remaining kids, all
 remaining kids are deleted.
 
@@ -1156,7 +1156,7 @@ Perl_op_sibling_splice(OP *parent, OP *start, int del_count, OP* insert)
 /*
 =for apidoc op_parent
 
-returns the parent OP of o, if it has a parent. Returns NULL otherwise.
+returns the parent OP of o, if it has a parent.  Returns NULL otherwise.
 (Currently perl must be built with C<-DPERL_OP_PARENT> for this feature to
 work.
 
@@ -6363,10 +6363,11 @@ Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right)
     left->op_next = flip;
     right->op_next = flop;
 
-    range->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
+    range->op_targ = pad_add_name_pvn("$", 1, padadd_NO_DUP_CHECK, 0, 0);
     sv_upgrade(PAD_SV(range->op_targ), SVt_PVNV);
-    flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
+    flip->op_targ = pad_add_name_pvn("$", 1, padadd_NO_DUP_CHECK, 0, 0);;
     sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
+    SvPADTMP_on(PAD_SV(flip->op_targ));
 
     flip->op_private =  left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
     flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
@@ -7413,7 +7414,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     }
     if (const_sv) {
        SvREFCNT_inc_simple_void_NN(const_sv);
-       SvFLAGS(const_sv) = (SvFLAGS(const_sv) & ~SVs_PADMY) | SVs_PADTMP;
+       SvFLAGS(const_sv) |= SVs_PADTMP;
        if (cv) {
            assert(!CvROOT(cv) && !CvCONST(cv));
            cv_forget_slab(cv);
@@ -7605,7 +7606,6 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        else *spot = cv_clone(clonee);
        SvREFCNT_dec_NN(clonee);
        cv = *spot;
-       SvPADMY_on(cv);
     }
     if (CvDEPTH(outcv) && !reusable && PadnameIsSTATE(name)) {
        PADOFFSET depth = CvDEPTH(outcv);
@@ -7835,7 +7835,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
     }
     if (const_sv) {
        SvREFCNT_inc_simple_void_NN(const_sv);
-       SvFLAGS(const_sv) = (SvFLAGS(const_sv) & ~SVs_PADMY) | SVs_PADTMP;
+       SvFLAGS(const_sv) |= SVs_PADTMP;
        if (cv) {
            assert(!CvROOT(cv) && !CvCONST(cv));
            cv_forget_slab(cv);
@@ -8025,7 +8025,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 
     if (block && has_name) {
        if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
-           SV * const tmpstr = cv_name(cv,NULL);
+           SV * const tmpstr = cv_name(cv,NULL,0);
            GV * const db_postponed = gv_fetchpvs("DB::postponed",
                                                  GV_ADDMULTI, SVt_PVHV);
            HV *hv;
@@ -9520,7 +9520,7 @@ Perl_ck_readline(pTHX_ OP *o)
     }
     else {
        OP * const newop
-           = newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, PL_argvgv));
+           = newUNOP(OP_READLINE, o->op_flags | OPf_SPECIAL, newGVOP(OP_GV, 0, PL_argvgv));
        op_free(o);
        return newop;
     }
@@ -10415,7 +10415,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 
        if (proto >= proto_end)
        {
-           SV * const namesv = cv_name((CV *)namegv, NULL);
+           SV * const namesv = cv_name((CV *)namegv, NULL, 0);
            yyerror_pv(Perl_form(aTHX_ "Too many arguments for %"SVf,
                                        SVfARG(namesv)), SvUTF8(namesv));
            return entersubop;
@@ -10570,7 +10570,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
            default:
            oops: {
                Perl_croak(aTHX_ "Malformed prototype for %"SVf": %"SVf,
-                                 SVfARG(cv_name((CV *)namegv, NULL)),
+                                 SVfARG(cv_name((CV *)namegv, NULL, 0)),
                                  SVfARG(protosv));
             }
        }
@@ -10586,7 +10586,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
     if (!optional && proto_end > proto &&
        (*proto != '@' && *proto != '%' && *proto != ';' && *proto != '_'))
     {
-       SV * const namesv = cv_name((CV *)namegv, NULL);
+       SV * const namesv = cv_name((CV *)namegv, NULL, 0);
        yyerror_pv(Perl_form(aTHX_ "Not enough arguments for %"SVf,
                                    SVfARG(namesv)), SvUTF8(namesv));
     }