#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()
*/
/* S_op_clear_gv(): free a GV attached to an OP */
+STATIC
#ifdef USE_ITHREADS
void S_op_clear_gv(pTHX_ OP *o, PADOFFSET *ixp)
#else
* Returns the new UNOP.
*/
-OP *
+STATIC OP *
S_op_sibling_newUNOP(pTHX_ OP *parent, OP *start, I32 type, I32 flags)
{
OP *kid, *newop;
* being spread throughout this file.
*/
-LOGOP *
+STATIC LOGOP *
S_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other)
{
dVAR;
}
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 ||
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 :-) */
* key_op is the first key
*/
-void
+STATIC void
S_check_hash_fields_and_hekify(pTHX_ UNOP *rop, SVOP *key_op)
{
PADNAME *lexname;
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)];
((PL_in_eval & EVAL_KEEPERR)
? OPf_SPECIAL : 0), o);
- cx = &cxstack[cxstack_ix];
+ cx = CX_CUR();
assert(CxTYPE(cx) == CXt_EVAL);
if ((cx->blk_gimme & G_WANT) == G_VOID)
bool is_stringify;
SV * VOL sv = NULL;
int ret = 0;
- I32 oldscope;
OP *old_next;
SV * const oldwarnhook = PL_warnhook;
SV * const olddiehook = PL_diehook;
COP not_compiling;
U8 oldwarn = PL_dowarn;
+ I32 old_cxix;
dJMPENV;
PERL_ARGS_ASSERT_FOLD_CONSTANTS;
o->op_next = 0;
PL_op = curop;
- oldscope = PL_scopestack_ix;
- create_eval_scope(G_FAKINGEVAL);
+ old_cxix = cxstack_ix;
+ create_eval_scope(NULL, G_FAKINGEVAL);
/* Verify that we don't need to save it: */
assert(PL_curcop == &PL_compiling);
PL_diehook = olddiehook;
PL_curcop = &PL_compiling;
- if (PL_scopestack_ix > oldscope)
- delete_eval_scope();
-
+ /* if we croaked, depending on how we croaked the eval scope
+ * may or may not have already been popped */
+ if (cxstack_ix > old_cxix) {
+ assert(cxstack_ix == old_cxix + 1);
+ assert(CxTYPE(CX_CUR()) == CXt_EVAL);
+ delete_eval_scope();
+ }
if (ret)
goto nope;
o->op_flags |= flags;
o = op_scope(o);
- o->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/
+ o->op_flags |= OPf_SPECIAL; /* suppress cx_popblock() curpm restoration*/
return o;
}
: NULL;
if (block) {
+ assert(PL_parser);
/* This makes sub {}; work as expected. */
if (block->op_type == OP_STUB) {
const line_t l = PL_parser->copline;
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;
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 = '/';
* OPpHINT_STRICT_REFS) as found in any rv2av/hv skipped by the caller.
*/
-void
+STATIC void
S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
{
dVAR;
/* 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);
* SAVEt_CLEARPADRANGE in pp_padrange.
* (The sizeof() stuff will be constant-folded, and is
* intended to avoid getting "comparison is always false"
- * compiler warnings)
+ * compiler warnings. See the comments above
+ * MEM_WRAP_CHECK for more explanation on why we do this
+ * in a weird way to avoid compiler warnings.)
*/
if ( intro
&& (8*sizeof(base) >
8*sizeof(UV)-OPpPADRANGE_COUNTSHIFT-SAVE_TIGHT_SHIFT
- ? base : 0) >
+ ? base
+ : (UV_MAX >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT))
+ ) >
(UV_MAX >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT))
)
break;
* 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);
|| 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))
}
}
}
- /* Some gcc releases emit a warning for this function:
+ /* On some platforms (HP-UX, IA64) gcc emits a warning for this function:
* op.c: In function 'Perl_custom_op_get_field':
* op.c:...: warning: 'any.xop_name' may be used uninitialized in this function [-Wmaybe-uninitialized]
- * Whether this is true, is currently unknown. */
+ * This is because on those platforms (with -DEBUGGING) NOT_REACHED
+ * expands to assert(0), which expands to ((0) ? (void)0 :
+ * __assert(...)), and gcc doesn't know that __assert can never return. */
return any;
}
}
https://perl5.git.perl.org / perl5.git / blobdiff