&& o2->op_private & OPpLVAL_INTRO
&& !(o2->op_private & OPpPAD_STATE))
{
- Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
- "Deprecated use of my() in false conditional");
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
+ "Deprecated use of my() in false conditional");
}
*otherp = NULL;
if (expr) {
if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
return block; /* do {} while 0 does once */
- if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
+ if (expr->op_type == OP_READLINE
+ || expr->op_type == OP_READDIR
+ || expr->op_type == OP_GLOB
|| (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
expr = newUNOP(OP_DEFINED, 0,
newASSIGNOP(0, newDEFSVOP(), 0, expr) );
const OP * const k2 = k1 ? k1->op_sibling : NULL;
switch (expr->op_type) {
case OP_NULL:
- if (k2 && k2->op_type == OP_READLINE
+ if (k2 && (k2->op_type == OP_READLINE || k2->op_type == OP_READDIR)
&& (k2->op_flags & OPf_STACKED)
&& ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
expr = newUNOP(OP_DEFINED, 0, expr);
PERL_UNUSED_ARG(debuggable);
if (expr) {
- if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
+ if (expr->op_type == OP_READLINE
+ || expr->op_type == OP_READDIR
+ || expr->op_type == OP_GLOB
|| (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
expr = newUNOP(OP_DEFINED, 0,
newASSIGNOP(0, newDEFSVOP(), 0, expr) );
const OP * const k2 = (k1) ? k1->op_sibling : NULL;
switch (expr->op_type) {
case OP_NULL:
- if (k2 && k2->op_type == OP_READLINE
+ if (k2 && (k2->op_type == OP_READLINE || k2->op_type == OP_READDIR)
&& (k2->op_flags & OPf_STACKED)
&& ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
expr = newUNOP(OP_DEFINED, 0, expr);
return o;
}
else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV)) {
- Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
"Using an array as a reference is deprecated");
}
return newUNOP(OP_RV2AV, 0, scalar(o));
return o;
}
else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV)) {
- Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
"Using a hash as a reference is deprecated");
}
return newUNOP(OP_RV2HV, 0, scalar(o));
{
OP * const newop = newAVREF(newGVOP(OP_GV, 0,
gv_fetchsv(((SVOP*)kid)->op_sv, GV_ADD, SVt_PVAV) ));
- Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
"Array @%"SVf" missing the @ in argument %"IVdf" of %s()",
SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]);
#ifdef PERL_MAD
{
OP * const newop = newHVREF(newGVOP(OP_GV, 0,
gv_fetchsv(((SVOP*)kid)->op_sv, GV_ADD, SVt_PVHV) ));
- Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
"Hash %%%"SVf" missing the %% in argument %"IVdf" of %s()",
SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]);
#ifdef PERL_MAD
break; /* Globals via GV can be undef */
case OP_PADAV:
case OP_AASSIGN: /* Is this a good idea? */
- Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
"defined(@array) is deprecated");
- Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
"\t(Maybe you should just omit the defined()?)\n");
break;
case OP_RV2HV:
*/
break; /* Globals via GV can be undef */
case OP_PADHV:
- Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
"defined(%%hash) is deprecated");
- Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
"\t(Maybe you should just omit the defined()?)\n");
break;
default:
return ck_fun(o);
}
+/* caller is supposed to assign the return to the
+ container of the rep_op var */
+OP *
+S_opt_scalarhv(pTHX_ OP *rep_op) {
+ UNOP *unop;
+
+ PERL_ARGS_ASSERT_OPT_SCALARHV;
+
+ NewOp(1101, unop, 1, UNOP);
+ unop->op_type = (OPCODE)OP_BOOLKEYS;
+ unop->op_ppaddr = PL_ppaddr[OP_BOOLKEYS];
+ unop->op_flags = (U8)(OPf_WANT_SCALAR | OPf_KIDS );
+ unop->op_private = (U8)(1 | ((OPf_WANT_SCALAR | OPf_KIDS) >> 8));
+ unop->op_first = rep_op;
+ unop->op_next = rep_op->op_next;
+ rep_op->op_next = (OP*)unop;
+ rep_op->op_flags|=(OPf_REF | OPf_MOD);
+ unop->op_sibling = rep_op->op_sibling;
+ rep_op->op_sibling = NULL;
+ /* unop->op_targ = pad_alloc(OP_BOOLKEYS, SVs_PADTMP); */
+ if (rep_op->op_type == OP_PADHV) {
+ rep_op->op_flags &= ~OPf_WANT_SCALAR;
+ rep_op->op_flags |= OPf_WANT_LIST;
+ }
+ return (OP*)unop;
+}
+
/* A peephole optimizer. We visit the ops in the order they're to execute.
* See the comments at the top of this file for more details about when
* peep() is called */
}
break;
+
+ {
+ OP *fop;
+ OP *sop;
+
+ case OP_NOT:
+ fop = cUNOP->op_first;
+ sop = NULL;
+ goto stitch_keys;
+ break;
- case OP_MAPWHILE:
- case OP_GREPWHILE:
- case OP_AND:
+ case OP_AND:
case OP_OR:
case OP_DOR:
+ fop = cLOGOP->op_first;
+ sop = fop->op_sibling;
+ while (cLOGOP->op_other->op_type == OP_NULL)
+ cLOGOP->op_other = cLOGOP->op_other->op_next;
+ peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
+
+ stitch_keys:
+ o->op_opt = 1;
+ if ((fop->op_type == OP_PADHV || fop->op_type == OP_RV2HV)
+ || ( sop &&
+ (sop->op_type == OP_PADHV || sop->op_type == OP_RV2HV)
+ )
+ ){
+ OP * nop = o;
+ OP * lop = o;
+ if (!(nop->op_flags && OPf_WANT_VOID)) {
+ while (nop && nop->op_next) {
+ switch (nop->op_next->op_type) {
+ case OP_NOT:
+ case OP_AND:
+ case OP_OR:
+ case OP_DOR:
+ lop = nop = nop->op_next;
+ break;
+ case OP_NULL:
+ nop = nop->op_next;
+ break;
+ default:
+ nop = NULL;
+ break;
+ }
+ }
+ }
+ if (lop->op_flags && OPf_WANT_VOID) {
+ if (fop->op_type == OP_PADHV || fop->op_type == OP_RV2HV)
+ cLOGOP->op_first = opt_scalarhv(fop);
+ if (sop && (sop->op_type == OP_PADHV || sop->op_type == OP_RV2HV))
+ cLOGOP->op_first->op_sibling = opt_scalarhv(sop);
+ }
+ }
+
+
+ break;
+ }
+
+ case OP_MAPWHILE:
+ case OP_GREPWHILE:
case OP_ANDASSIGN:
case OP_ORASSIGN:
case OP_DORASSIGN:
projects / p5sagit/p5-mst-13.2.git / blobdiff