This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Consistent indentation in AUTHORS
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 2e844bf..163b6a8 100644 (file)
--- a/op.c
+++ b/op.c
@@ -807,8 +807,6 @@ Perl_op_clear(pTHX_ OP *o)
                SvREFCNT_inc_simple_void(gv);
 #ifdef USE_ITHREADS
            if (cPADOPo->op_padix > 0) {
-               /* No GvIN_PAD_off(cGVOPo_gv) here, because other references
-                * may still exist on the pad */
                pad_swipe(cPADOPo->op_padix, TRUE);
                cPADOPo->op_padix = 0;
            }
@@ -875,8 +873,6 @@ Perl_op_clear(pTHX_ OP *o)
     case OP_PUSHRE:
 #ifdef USE_ITHREADS
         if (cPMOPo->op_pmreplrootu.op_pmtargetoff) {
-           /* No GvIN_PAD_off here, because other references may still
-            * exist on the pad */
            pad_swipe(cPMOPo->op_pmreplrootu.op_pmtargetoff, TRUE);
        }
 #else
@@ -5186,7 +5182,7 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
     padop->op_type = (OPCODE)type;
     padop->op_ppaddr = PL_ppaddr[type];
     padop->op_padix =
-       pad_alloc(type, IS_PADGV(sv) ? SVf_READONLY : SVs_PADTMP);
+       pad_alloc(type, isGV(sv) ? SVf_READONLY : SVs_PADTMP);
     SvREFCNT_dec(PAD_SVl(padop->op_padix));
     PAD_SETSV(padop->op_padix, sv);
     assert(sv);
@@ -5219,7 +5215,6 @@ Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
     PERL_ARGS_ASSERT_NEWGVOP;
 
 #ifdef USE_ITHREADS
-    GvIN_PAD_on(gv);
     return newPADOP(type, flags, SvREFCNT_inc_simple_NN(gv));
 #else
     return newSVOP(type, flags, SvREFCNT_inc_simple_NN(gv));
@@ -7658,8 +7653,8 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
     bool name_is_utf8 = o && !o_is_gv && SvUTF8(cSVOPo->op_sv);
 #ifdef PERL_DEBUG_READONLY_OPS
     OPSLAB *slab = NULL;
-#endif
     bool special = FALSE;
+#endif
 
     if (o_is_gv) {
        gv = (GV*)o;
@@ -7889,11 +7884,14 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
                assert(CvGV(cv) == gv);
            }
            else {
+               dVAR;
                U32 hash;
                PERL_HASH(hash, name, namlen);
                CvNAME_HEK_set(cv,
                               share_hek(name,
-                                        name_is_utf8 ? -namlen : namlen,
+                                        name_is_utf8
+                                           ? -(SSize_t)namlen
+                                           :  (SSize_t)namlen,
                                         hash));
            }
 
@@ -7951,10 +7949,13 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
     if (!CvHASGV(cv)) {
        if (isGV(gv)) CvGV_set(cv, gv);
        else {
+            dVAR;
            U32 hash;
            PERL_HASH(hash, name, namlen);
            CvNAME_HEK_set(cv, share_hek(name,
-                                        name_is_utf8 ? -namlen : namlen,
+                                        name_is_utf8
+                                           ? -(SSize_t)namlen
+                                           :  (SSize_t)namlen,
                                         hash));
        }
        CvFILE_set_from_cop(cv, PL_curcop);
@@ -8050,7 +8051,10 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
             if (PL_parser && PL_parser->error_count)
                 clear_special_blocks(name, gv, cv);
             else
-                special = process_special_blocks(floor, name, gv, cv);
+#ifdef PERL_DEBUG_READONLY_OPS
+                special =
+#endif
+                    process_special_blocks(floor, name, gv, cv);
         }
     }
 
@@ -9022,7 +9026,6 @@ Perl_ck_rvconst(pTHX_ OP *o)
            assert (sizeof(PADOP) <= sizeof(SVOP));
            kPADOP->op_padix = pad_alloc(OP_GV, SVf_READONLY);
            SvREFCNT_dec(PAD_SVl(kPADOP->op_padix));
-           if (isGV(gv)) GvIN_PAD_on(gv);
            PAD_SETSV(kPADOP->op_padix, MUTABLE_SV(SvREFCNT_inc_simple_NN(gv)));
 #else
            kid->op_sv = SvREFCNT_inc_simple_NN(gv);
@@ -9967,6 +9970,33 @@ Perl_ck_sort(pTHX_ OP *o)
            kid->op_next = kid;
            o->op_flags |= OPf_SPECIAL;
        }
+       else if (kid->op_type == OP_CONST
+             && kid->op_private & OPpCONST_BARE) {
+           char tmpbuf[256];
+           STRLEN len;
+           PADOFFSET off;
+           const char * const name = SvPV(kSVOP_sv, len);
+           *tmpbuf = '&';
+           assert (len < 256);
+           Copy(name, tmpbuf+1, len, char);
+           off = pad_findmy_pvn(tmpbuf, len+1, SvUTF8(kSVOP_sv));
+           if (off != NOT_IN_PAD) {
+               if (PAD_COMPNAME_FLAGS_isOUR(off)) {
+                   SV * const fq =
+                       newSVhek(HvNAME_HEK(PAD_COMPNAME_OURSTASH(off)));
+                   sv_catpvs(fq, "::");
+                   sv_catsv(fq, kSVOP_sv);
+                   SvREFCNT_dec_NN(kSVOP_sv);
+                   kSVOP->op_sv = fq;
+               }
+               else {
+                   OP * const padop = newOP(OP_PADCV, 0);
+                   padop->op_targ = off;
+                   cUNOPx(firstkid)->op_first = padop;
+                   op_free(kid);
+               }
+           }
+       }
 
        firstkid = OP_SIBLING(firstkid);
     }
@@ -10748,7 +10778,7 @@ Perl_cv_get_call_checker(pTHX_ CV *cv, Perl_call_checker *ckfun_p, SV **ckobj_p)
 {
     PERL_ARGS_ASSERT_CV_GET_CALL_CHECKER;
     PERL_UNUSED_CONTEXT;
-    return S_cv_get_call_checker(cv, ckfun_p, ckobj_p, NULL);
+    S_cv_get_call_checker(cv, ckfun_p, ckobj_p, NULL);
 }
 
 /*
@@ -10822,7 +10852,7 @@ Perl_cv_set_call_checker_flags(pTHX_ CV *cv, Perl_call_checker ckfun,
            callmg->mg_flags |= MGf_REFCOUNTED;
        }
        callmg->mg_flags = (callmg->mg_flags &~ MGf_REQUIRE_GV)
-                        | (flags & MGf_REQUIRE_GV) | MGf_COPY;
+                        | (U8)(flags & MGf_REQUIRE_GV) | MGf_COPY;
     }
 }