This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[patch] make op_{clear,null} public
[perl5.git] / op.c
diff --git a/op.c b/op.c
index aa0b1e7..77a6267 100644 (file)
--- a/op.c
+++ b/op.c
@@ -735,8 +735,8 @@ Perl_op_free(pTHX_ OP *o)
 #endif
 }
 
-STATIC void
-S_op_clear(pTHX_ OP *o)
+void
+Perl_op_clear(pTHX_ OP *o)
 {
     switch (o->op_type) {
     case OP_NULL:      /* Was holding old type, if any. */
@@ -871,8 +871,8 @@ S_cop_free(pTHX_ COP* cop)
        SvREFCNT_dec(cop->cop_io);
 }
 
-STATIC void
-S_null(pTHX_ OP *o)
+void
+Perl_op_null(pTHX_ OP *o)
 {
     if (o->op_type == OP_NULL)
        return;
@@ -1137,6 +1137,9 @@ Perl_scalarvoid(pTHX_ OP *o)
        else {
            if (ckWARN(WARN_VOID)) {
                useless = "a constant";
+               /* the constants 0 and 1 are permitted as they are
+                  conventionally used as dummies in constructs like
+                       1 while some_condition_with_side_effects;  */
                if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
                    useless = 0;
                else if (SvPOK(sv)) {
@@ -1153,7 +1156,7 @@ Perl_scalarvoid(pTHX_ OP *o)
                }
            }
        }
-       null(o);                /* don't execute or even remember it */
+       op_null(o);             /* don't execute or even remember it */
        break;
 
     case OP_POSTINC:
@@ -1358,31 +1361,6 @@ Perl_mod(pTHX_ OP *o, I32 type)
        PL_modcount++;
        return o;
     case OP_CONST:
-        if (o->op_private & (OPpCONST_BARE) &&
-                !(type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)) {
-            SV *sv = ((SVOP*)o)->op_sv;
-            GV *gv;
-
-            /* Could be a filehandle */
-            if ((gv = gv_fetchpv(SvPV_nolen(sv), FALSE, SVt_PVIO))) {
-                OP* gvio = newUNOP(OP_RV2GV, 0, newGVOP(OP_GV, 0, gv));
-                op_free(o);
-                o = gvio;
-            } else {
-                /* OK, it's a sub */
-                OP* enter;
-                gv = gv_fetchpv(SvPV_nolen(sv), TRUE, SVt_PVCV);
-
-                enter = newUNOP(OP_ENTERSUB,0,
-                        newUNOP(OP_RV2CV, 0,
-                            newGVOP(OP_GV, 0, gv)
-                        ));
-                enter->op_private |= OPpLVAL_INTRO;
-                op_free(o);
-                o = enter;
-            }
-            break;
-        }
        if (!(o->op_private & (OPpCONST_ARYBASE)))
            goto nomod;
        if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
@@ -1408,7 +1386,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
            o->op_type = OP_RV2CV;              /* entersub => rv2cv */
            o->op_ppaddr = PL_ppaddr[OP_RV2CV];
            assert(cUNOPo->op_first->op_type == OP_NULL);
-           null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
+           op_null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
            break;
        }
        else {                          /* lvalue subroutine call */
@@ -1780,7 +1758,7 @@ Perl_ref(pTHX_ OP *o, I32 type)
            o->op_type = OP_RV2CV;             /* entersub => rv2cv */
            o->op_ppaddr = PL_ppaddr[OP_RV2CV];
            assert(cUNOPo->op_first->op_type == OP_NULL);
-           null(((LISTOP*)cUNOPo->op_first)->op_first);        /* disable pushmark */
+           op_null(((LISTOP*)cUNOPo->op_first)->op_first);     /* disable pushmark */
            o->op_flags |= OPf_SPECIAL;
        }
        break;
@@ -2092,7 +2070,7 @@ Perl_scope(pTHX_ OP *o)
                o->op_ppaddr = PL_ppaddr[OP_SCOPE];
                kid = ((LISTOP*)o)->op_first;
                if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
-                   null(kid);
+                   op_null(kid);
            }
            else
                o = newLISTOP(OP_SCOPE, 0, o, Nullop);
@@ -2403,7 +2381,7 @@ Perl_convert(pTHX_ I32 type, I32 flags, OP *o)
        o->op_flags &= ~OPf_WANT;
 
     if (!(PL_opargs[type] & OA_MARK))
-       null(cLISTOPo->op_first);
+       op_null(cLISTOPo->op_first);
 
     o->op_type = type;
     o->op_ppaddr = PL_ppaddr[type];
@@ -2513,7 +2491,7 @@ Perl_force_list(pTHX_ OP *o)
 {
     if (!o || o->op_type != OP_LIST)
        o = newLISTOP(OP_LIST, 0, o, Nullop);
-    null(o);
+    op_null(o);
     return o;
 }
 
@@ -3616,7 +3594,7 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
        cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ];
     }
     cop->op_flags = flags;
-    cop->op_private = (PL_hints & HINT_BYTE);
+    cop->op_private = (PL_hints & HINT_PRIVATE_MASK);
 #ifdef NATIVE_HINTS
     cop->op_private |= NATIVE_HINTS;
 #endif
@@ -4122,7 +4100,7 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
 
        op_free(expr);
        expr = (OP*)(listop);
-        null(expr);
+        op_null(expr);
        iterflags |= OPf_STACKED;
     }
     else {
@@ -5232,6 +5210,11 @@ Perl_newAVREF(pTHX_ OP *o)
        o->op_ppaddr = PL_ppaddr[OP_PADAV];
        return o;
     }
+    else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV)
+               && ckWARN(WARN_DEPRECATED)) {
+       Perl_warner(aTHX_ WARN_DEPRECATED,
+               "Using an array as a reference is deprecated");
+    }
     return newUNOP(OP_RV2AV, 0, scalar(o));
 }
 
@@ -5251,6 +5234,11 @@ Perl_newHVREF(pTHX_ OP *o)
        o->op_ppaddr = PL_ppaddr[OP_PADHV];
        return o;
     }
+    else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV)
+               && ckWARN(WARN_DEPRECATED)) {
+       Perl_warner(aTHX_ WARN_DEPRECATED,
+               "Using a hash as a reference is deprecated");
+    }
     return newUNOP(OP_RV2HV, 0, scalar(o));
 }
 
@@ -5368,7 +5356,7 @@ Perl_ck_delete(pTHX_ OP *o)
            Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or slice",
                  PL_op_desc[o->op_type]);
        }
-       null(kid);
+       op_null(kid);
     }
     return o;
 }
@@ -5398,7 +5386,7 @@ Perl_ck_eval(pTHX_ OP *o)
 
        if (!kid) {
            o->op_flags &= ~OPf_KIDS;
-           null(o);
+           op_null(o);
        }
        else if (kid->op_type == OP_LINESEQ) {
            LOGOP *enter;
@@ -5454,7 +5442,7 @@ Perl_ck_exec(pTHX_ OP *o)
        o = ck_fun(o);
        kid = cUNOPo->op_first->op_sibling;
        if (kid->op_type == OP_RV2GV)
-           null(kid);
+           op_null(kid);
     }
     else
        o = listkids(o);
@@ -5479,7 +5467,7 @@ Perl_ck_exists(pTHX_ OP *o)
        else if (kid->op_type != OP_HELEM)
            Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element",
                       PL_op_desc[o->op_type]);
-       null(kid);
+       op_null(kid);
     }
     return o;
 }
@@ -5870,6 +5858,7 @@ Perl_ck_glob(pTHX_ OP *o)
        gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
        glob_gv = gv_fetchpv("File::Glob::csh_glob", FALSE, SVt_PVCV);
        GvCV(gv) = GvCV(glob_gv);
+       SvREFCNT_inc((SV*)GvCV(gv));
        GvIMPORTED_CV_on(gv);
        LEAVE;
     }
@@ -6313,7 +6302,7 @@ Perl_ck_sort(pTHX_ OP *o)
            }
            else if (kid->op_type == OP_LEAVE) {
                if (o->op_type == OP_SORT) {
-                   null(kid);                  /* wipe out leave */
+                   op_null(kid);                       /* wipe out leave */
                    kid->op_next = kid;
 
                    for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
@@ -6344,7 +6333,7 @@ Perl_ck_sort(pTHX_ OP *o)
            o->op_flags |= OPf_SPECIAL;
        }
        else if (kid->op_type == OP_RV2SV || kid->op_type == OP_PADSV)
-           null(firstkid);
+           op_null(firstkid);
 
        firstkid = firstkid->op_sibling;
     }
@@ -6507,7 +6496,7 @@ Perl_ck_subr(pTHX_ OP *o)
     if (cvop->op_type == OP_RV2CV) {
        SVOP* tmpop;
        o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
-       null(cvop);             /* disable rv2cv */
+       op_null(cvop);          /* disable rv2cv */
        tmpop = (SVOP*)((UNOP*)cvop)->op_first;
        if (tmpop->op_type == OP_GV && !(o->op_private & OPpENTERSUB_AMPER)) {
            GV *gv = cGVOPx_gv(tmpop);
@@ -6769,7 +6758,7 @@ Perl_peep(pTHX_ register OP *o)
                        o->op_private |= OPpTARGET_MY;
                    }
                }
-               null(o->op_next);
+               op_null(o->op_next);
            }
          ignore_optimization:
            o->op_seq = PL_op_seqmax++;
@@ -6802,7 +6791,7 @@ Perl_peep(pTHX_ register OP *o)
        case OP_GV:
            if (o->op_next->op_type == OP_RV2SV) {
                if (!(o->op_next->op_private & OPpDEREF)) {
-                   null(o->op_next);
+                   op_null(o->op_next);
                    o->op_private |= o->op_next->op_private & (OPpLVAL_INTRO
                                                               | OPpOUR_INTRO);
                    o->op_next = o->op_next->op_next;
@@ -6823,9 +6812,9 @@ Perl_peep(pTHX_ register OP *o)
                    i >= 0)
                {
                    GV *gv;
-                   null(o->op_next);
-                   null(pop->op_next);
-                   null(pop);
+                   op_null(o->op_next);
+                   op_null(pop->op_next);
+                   op_null(pop);
                    o->op_flags |= pop->op_next->op_flags & OPf_MOD;
                    o->op_next = pop->op_next->op_next;
                    o->op_type = OP_AELEMFAST;