static void bad_type _((I32 n, char *t, char *name, OP *kid));
static OP *modkids _((OP *o, I32 type));
static OP *no_fh_allowed _((OP *o));
+static void no_bareword_allowed _((OP *o));
static OP *scalarboolean _((OP *o));
static OP *too_few_arguments _((OP *o, char* name));
static OP *too_many_arguments _((OP *o, char* name));
(int)n, name, t, PL_op_desc[kid->op_type]));
}
+STATIC void
+no_bareword_allowed(OP *o)
+{
+ warn("Bareword \"%s\" not allowed while \"strict subs\" in use",
+ SvPV_nolen(cSVOPo->op_sv));
+ ++PL_error_count;
+}
+
void
assertref(OP *o)
{
SV *msg = sv_2mortal(
newSVpvf("(Did you mean $ or @ instead of %c?)\n",
type == OP_ENTERSUB ? '&' : '%'));
- if (PL_in_eval & 2)
+ if (PL_in_eval & EVAL_WARNONLY)
warn("%_", msg);
else if (PL_in_eval)
sv_catsv(GvSV(PL_errgv), msg);
OP *kid;
char* useless = 0;
SV* sv;
+ U8 want;
+
+ if (o->op_type == OP_NEXTSTATE || o->op_type == OP_DBSTATE ||
+ (o->op_type == OP_NULL &&
+ (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)))
+ {
+ dTHR;
+ PL_curcop = (COP*)o; /* for warning below */
+ }
/* assumes no premature commitment */
- U8 want = o->op_flags & OPf_WANT;
- if (!o || (want && want != OPf_WANT_SCALAR) || PL_error_count
+ want = o->op_flags & OPf_WANT;
+ if ((want && want != OPf_WANT_SCALAR) || PL_error_count
|| o->op_type == OP_RETURN)
return o;
useless = "a variable";
break;
- case OP_NEXTSTATE:
- case OP_DBSTATE:
- WITH_THR(PL_curcop = ((COP*)o)); /* for warning below */
- break;
-
case OP_CONST:
sv = cSVOPo->op_sv;
- {
+ if (cSVOPo->op_private & OPpCONST_STRICT)
+ no_bareword_allowed(o);
+ else {
dTHR;
if (ckWARN(WARN_VOID)) {
useless = "a constant";
break;
case OP_NULL:
- if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
- WITH_THR(PL_curcop = ((COP*)o)); /* for warning below */
if (o->op_flags & OPf_STACKED)
break;
/* FALL THROUGH */
+ case OP_NEXTSTATE:
+ case OP_DBSTATE:
case OP_ENTERTRY:
case OP_ENTER:
case OP_SCALAR:
if (PL_in_eval) {
if (PL_eval_root)
return;
- PL_eval_root = newUNOP(OP_LEAVEEVAL, ((PL_in_eval & 4) ? OPf_SPECIAL : 0), o);
+ PL_eval_root = newUNOP(OP_LEAVEEVAL,
+ ((PL_in_eval & EVAL_KEEPERR)
+ ? OPf_SPECIAL : 0), o);
PL_eval_start = linklist(PL_eval_root);
PL_eval_root->op_next = 0;
peep(PL_eval_start);
goto nope;
switch (type) {
+ case OP_NEGATE:
+ /* XXX might want a ck_negate() for this */
+ cUNOPo->op_first->op_private &= ~OPpCONST_STRICT;
+ break;
case OP_SPRINTF:
case OP_UCFIRST:
case OP_LCFIRST:
for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
if (curop->op_type != OP_CONST &&
- curop->op_type != OP_LIST &&
- curop->op_type != OP_SCALAR &&
- curop->op_type != OP_NULL &&
- curop->op_type != OP_PUSHMARK) {
+ curop->op_type != OP_LIST &&
+ curop->op_type != OP_SCALAR &&
+ curop->op_type != OP_NULL &&
+ curop->op_type != OP_PUSHMARK)
+ {
goto nope;
}
}
if (strEQ(s, "BEGIN")) {
char *not_safe =
"BEGIN not safe after errors--compilation aborted";
- if (PL_in_eval & 4)
+ if (PL_in_eval & EVAL_KEEPERR)
croak(not_safe);
else {
/* force display of errors found but not reported */
}
OP *
+ck_defined(OP *o) /* 19990527 MJD */
+{
+ if (ckWARN(WARN_DEPRECATED)) {
+ switch (cUNOPo->op_first->op_type) {
+ case OP_RV2AV:
+ case OP_PADAV:
+ case OP_AASSIGN: /* Is this a good idea? */
+ warner(WARN_DEPRECATED, "defined(@array) is deprecated (and not really meaningful)");
+ warner(WARN_DEPRECATED, "(Maybe you should just omit the defined()?)\n");
+ break;
+ case OP_RV2HV:
+ case OP_PADHV:
+ warner(WARN_DEPRECATED, "defined(%hash) is deprecated (and not really meaningful)");
+ warner(WARN_DEPRECATED, "(Maybe you should just omit the defined()?)\n");
+ break;
+ default:
+ /* no warning */
+ break;
+ }
+ }
+ return ck_rfun(o);
+}
+
+OP *
ck_rfun(OP *o)
{
OPCODE type = o->op_type;
}
}
}
+ else if (cvop->op_type == OP_METHOD) {
+ if (o2->op_type == OP_CONST)
+ o2->op_private &= ~OPpCONST_STRICT;
+ }
o->op_private |= (PL_hints & HINT_STRICT_REFS);
if (PERLDB_SUB && PL_curstash != PL_debstash)
o->op_private |= OPpENTERSUB_DB;
arg++;
if (o2->op_type == OP_RV2GV)
goto wrapref; /* autoconvert GLOB -> GLOBref */
+ else if (o2->op_type == OP_CONST)
+ o2->op_private &= ~OPpCONST_STRICT;
+ else if (o2->op_type == OP_ENTERSUB) {
+ /* accidental subroutine, revert to bareword */
+ OP *gvop = ((UNOP*)o2)->op_first;
+ if (gvop && gvop->op_type == OP_NULL) {
+ gvop = ((UNOP*)gvop)->op_first;
+ if (gvop) {
+ for (; gvop->op_sibling; gvop = gvop->op_sibling)
+ ;
+ if (gvop &&
+ (gvop->op_private & OPpENTERSUB_NOPAREN) &&
+ (gvop = ((UNOP*)gvop)->op_first) &&
+ gvop->op_type == OP_GV)
+ {
+ GV *gv = (GV*)((SVOP*)gvop)->op_sv;
+ OP *sibling = o2->op_sibling;
+ op_free(o2);
+ o2 = newSVOP(OP_CONST, 0,
+ newSVpvn(GvNAME(gv),
+ GvNAMELEN(gv)));
+ prev->op_sibling = o2;
+ o2->op_sibling = sibling;
+ }
+ }
+ }
+ }
scalar(o2);
break;
case '\\':
o->op_seq = PL_op_seqmax++;
break;
- case OP_CONCAT:
case OP_CONST:
+ if (cSVOPo->op_private & OPpCONST_STRICT)
+ no_bareword_allowed(o);
+ /* FALL THROUGH */
+ case OP_CONCAT:
case OP_JOIN:
case OP_UC:
case OP_UCFIRST: