Croak on unimplemented already at import time

[perl5.git] / op.c

diff --git a/op.c b/op.c
index ce0d580..93205fe 100644 (file)
--- a/op.c
+++ b/op.c
@@ -109,6 +109,8 @@ recursive, but it's recursive on basic blocks, not on tree nodes.
 #define CALL_RPEEP(o) PL_rpeepp(aTHX_ o)
 #define CALL_OPFREEHOOK(o) if (PL_opfreehook) PL_opfreehook(aTHX_ o)
 
+static const char array_passed_to_stat[] = "Array passed to stat will be coerced to a scalar";
+
 /* Used to avoid recursion through the op tree in scalarvoid() and
    op_free()
 */
@@ -1548,7 +1550,7 @@ S_scalarboolean(pTHX_ OP *o)
 }
 
 static SV *
-S_op_varname(pTHX_ const OP *o)
+S_op_varname_subscript(pTHX_ const OP *o, int subscript_type)
 {
     assert(o);
     assert(o->op_type == OP_PADAV || o->op_type == OP_RV2AV ||
@@ -1561,13 +1563,19 @@ S_op_varname(pTHX_ const OP *o)
            if (cUNOPo->op_first->op_type != OP_GV
             || !(gv = cGVOPx_gv(cUNOPo->op_first)))
                return NULL;
-           return varname(gv, funny, 0, NULL, 0, 1);
+           return varname(gv, funny, 0, NULL, 0, subscript_type);
        }
        return
-           varname(MUTABLE_GV(PL_compcv), funny, o->op_targ, NULL, 0, 1);
+           varname(MUTABLE_GV(PL_compcv), funny, o->op_targ, NULL, 0, subscript_type);
     }
 }
 
+static SV *
+S_op_varname(pTHX_ const OP *o)
+{
+    return S_op_varname_subscript(aTHX_ o, 1);
+}
+
 static void
 S_op_pretty(pTHX_ const OP *o, SV **retsv, const char **retpv)
 { /* or not so pretty :-) */
@@ -2622,7 +2630,13 @@ S_mark_padname_lvalue(pTHX_ PADNAME *pn)
     PadnameLVALUE_on(pn);
     while (PadnameOUTER(pn) && PARENT_PAD_INDEX(pn)) {
        cv = CvOUTSIDE(cv);
-       assert(cv);
+        /* RT #127786: cv can be NULL due to an eval within the DB package
+         * called from an anon sub - anon subs don't have CvOUTSIDE() set
+         * unless they contain an eval, but calling eval within DB
+         * pretends the eval was done in the caller's scope.
+         */
+       if (!cv)
+            break;
        assert(CvPADLIST(cv));
        pn =
           PadlistNAMESARRAY(CvPADLIST(cv))[PARENT_PAD_INDEX(pn)];
@@ -9727,6 +9741,19 @@ Perl_ck_ftst(pTHX_ OP *o)
            op_free(o);
            return newop;
        }
+
+        if ((kidtype == OP_RV2AV || kidtype == OP_PADAV) && ckWARN(WARN_SYNTAX)) {
+            SV *name = S_op_varname_subscript(aTHX_ (OP*)kid, 2);
+            if (name) {
+                /* diag_listed_as: Array passed to stat will be coerced to a scalar%s */
+                Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%s (did you want stat %" SVf "?)",
+                            array_passed_to_stat, name);
+            }
+            else {
+                /* diag_listed_as: Array passed to stat will be coerced to a scalar%s */
+                Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%s", array_passed_to_stat);
+            }
+       }
        scalar((OP *) kid);
        if ((PL_hints & HINT_FILETEST_ACCESS) && OP_IS_FILETEST_ACCESS(o->op_type))
            o->op_private |= OPpFT_ACCESS;
@@ -10601,6 +10628,12 @@ Perl_ck_require(pTHX_ OP *o)
            s = SvPVX(sv);
            len = SvCUR(sv);
            end = s + len;
+            /* treat ::foo::bar as foo::bar */
+            if (len >= 2 && s[0] == ':' && s[1] == ':')
+                DIE(aTHX_ "Bareword in require must not start with a double-colon: \"%s\"\n", s);
+            if (s == end)
+                DIE(aTHX_ "Bareword in require maps to empty filename");
+
            for (; s < end; s++) {
                if (*s == ':' && s[1] == ':') {
                    *s = '/';
@@ -13657,7 +13690,7 @@ Perl_rpeep(pTHX_ OP *o)
                     /* Note that you'd normally  expect targs to be
                      * contiguous in my($a,$b,$c), but that's not the case
                      * when external modules start doing things, e.g.
-                     i* Function::Parameters */
+                     * Function::Parameters */
                     if (p->op_targ != base + count)
                         break;
                     assert(p->op_targ == base + count);
@@ -13713,10 +13746,10 @@ Perl_rpeep(pTHX_ OP *o)
              * optimise away would have exactly the same effect as the
              * padrange.
              * In particular in void context, we can only optimise to
-             * a padrange if see see the complete sequence
+             * a padrange if we see the complete sequence
              *     pushmark, pad*v, ...., list
-             * which has the net effect of of leaving the markstack as it
-             * was.  Not pushing on to the stack (whereas padsv does touch
+             * which has the net effect of leaving the markstack as it
+             * was.  Not pushing onto the stack (whereas padsv does touch
              * the stack) makes no difference in void context.
              */
             assert(followop);
@@ -13928,11 +13961,11 @@ Perl_rpeep(pTHX_ OP *o)
                                  || o->op_next->op_type == OP_NULL))
                o->op_next = o->op_next->op_next;
 
-           /* if we're an OR and our next is a AND in void context, we'll
-              follow it's op_other on short circuit, same for reverse.
+           /* If we're an OR and our next is an AND in void context, we'll
+              follow its op_other on short circuit, same for reverse.
               We can't do this with OP_DOR since if it's true, its return
               value is the underlying value which must be evaluated
-              by the next op */
+              by the next op. */
            if (o->op_next &&
                (
                    (IS_AND_OP(o) && IS_OR_OP(o->op_next))