This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
revert "revert perl -h changes"
[perl5.git]
/
op.c
diff --git
a/op.c
b/op.c
index
ae7163d
..
76eb16f
100644
(file)
--- a/
op.c
+++ b/
op.c
@@
-562,6
+562,7
@@
Perl_op_clear(pTHX_ OP *o)
o->op_targ = 0;
goto retry;
}
o->op_targ = 0;
goto retry;
}
+ case OP_ENTERTRY:
case OP_ENTEREVAL: /* Was holding hints. */
o->op_targ = 0;
break;
case OP_ENTEREVAL: /* Was holding hints. */
o->op_targ = 0;
break;
@@
-985,7
+986,7
@@
Perl_scalarvoid(pTHX_ OP *o)
want = o->op_flags & OPf_WANT;
if ((want && want != OPf_WANT_SCALAR)
|| (PL_parser && PL_parser->error_count)
want = o->op_flags & OPf_WANT;
if ((want && want != OPf_WANT_SCALAR)
|| (PL_parser && PL_parser->error_count)
- || o->op_type == OP_RETURN)
+ || o->op_type == OP_RETURN
|| o->op_type == OP_REQUIRE
)
{
return o;
}
{
return o;
}
@@
-1086,6
+1087,17
@@
Perl_scalarvoid(pTHX_ OP *o)
useless = OP_DESC(o);
break;
useless = OP_DESC(o);
break;
+ case OP_SPLIT:
+ kid = cLISTOPo->op_first;
+ if (kid && kid->op_type == OP_PUSHRE
+#ifdef USE_ITHREADS
+ && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetoff)
+#else
+ && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetgv)
+#endif
+ useless = OP_DESC(o);
+ break;
+
case OP_NOT:
kid = cUNOPo->op_first;
if (kid->op_type != OP_MATCH && kid->op_type != OP_SUBST &&
case OP_NOT:
kid = cUNOPo->op_first;
if (kid->op_type != OP_MATCH && kid->op_type != OP_SUBST &&
@@
-1215,10
+1227,6
@@
Perl_scalarvoid(pTHX_ OP *o)
case OP_ENTEREVAL:
scalarkids(o);
break;
case OP_ENTEREVAL:
scalarkids(o);
break;
- case OP_REQUIRE:
- /* all requires must return a boolean value */
- o->op_flags &= ~OPf_WANT;
- /* FALL THROUGH */
case OP_SCALAR:
return scalar(o);
}
case OP_SCALAR:
return scalar(o);
}
@@
-1307,10
+1315,6
@@
Perl_list(pTHX_ OP *o)
}
PL_curcop = &PL_compiling;
break;
}
PL_curcop = &PL_compiling;
break;
- case OP_REQUIRE:
- /* all requires must return a boolean value */
- o->op_flags &= ~OPf_WANT;
- return scalar(o);
}
return o;
}
}
return o;
}
@@
-3020,6
+3024,8
@@
Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
dVAR;
LISTOP *listop;
dVAR;
LISTOP *listop;
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LISTOP);
+
NewOp(1101, listop, 1, LISTOP);
listop->op_type = (OPCODE)type;
NewOp(1101, listop, 1, LISTOP);
listop->op_type = (OPCODE)type;
@@
-3053,6
+3059,12
@@
Perl_newOP(pTHX_ I32 type, I32 flags)
{
dVAR;
OP *o;
{
dVAR;
OP *o;
+
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP_OR_UNOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
+
NewOp(1101, o, 1, OP);
o->op_type = (OPCODE)type;
o->op_ppaddr = PL_ppaddr[type];
NewOp(1101, o, 1, OP);
o->op_type = (OPCODE)type;
o->op_ppaddr = PL_ppaddr[type];
@@
-3076,6
+3088,14
@@
Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
dVAR;
UNOP *unop;
dVAR;
UNOP *unop;
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_UNOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP_OR_UNOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP
+ || type == OP_SASSIGN
+ || type == OP_ENTERTRY
+ || type == OP_NULL );
+
if (!first)
first = newOP(OP_STUB, 0);
if (PL_opargs[type] & OA_MARK)
if (!first)
first = newOP(OP_STUB, 0);
if (PL_opargs[type] & OA_MARK)
@@
-3099,6
+3119,10
@@
Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
{
dVAR;
BINOP *binop;
{
dVAR;
BINOP *binop;
+
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_BINOP
+ || type == OP_SASSIGN || type == OP_NULL );
+
NewOp(1101, binop, 1, BINOP);
if (!first)
NewOp(1101, binop, 1, BINOP);
if (!first)
@@
-3494,6
+3518,8
@@
Perl_newPMOP(pTHX_ I32 type, I32 flags)
dVAR;
PMOP *pmop;
dVAR;
PMOP *pmop;
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_PMOP);
+
NewOp(1101, pmop, 1, PMOP);
pmop->op_type = (OPCODE)type;
pmop->op_ppaddr = PL_ppaddr[type];
NewOp(1101, pmop, 1, PMOP);
pmop->op_type = (OPCODE)type;
pmop->op_ppaddr = PL_ppaddr[type];
@@
-3738,6
+3764,10
@@
Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
PERL_ARGS_ASSERT_NEWSVOP;
PERL_ARGS_ASSERT_NEWSVOP;
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_SVOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_PVOP_OR_SVOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP);
+
NewOp(1101, svop, 1, SVOP);
svop->op_type = (OPCODE)type;
svop->op_ppaddr = PL_ppaddr[type];
NewOp(1101, svop, 1, SVOP);
svop->op_type = (OPCODE)type;
svop->op_ppaddr = PL_ppaddr[type];
@@
-3760,6
+3790,10
@@
Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
PERL_ARGS_ASSERT_NEWPADOP;
PERL_ARGS_ASSERT_NEWPADOP;
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_SVOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_PVOP_OR_SVOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP);
+
NewOp(1101, padop, 1, PADOP);
padop->op_type = (OPCODE)type;
padop->op_ppaddr = PL_ppaddr[type];
NewOp(1101, padop, 1, PADOP);
padop->op_type = (OPCODE)type;
padop->op_ppaddr = PL_ppaddr[type];
@@
-3798,6
+3832,10
@@
Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
{
dVAR;
PVOP *pvop;
{
dVAR;
PVOP *pvop;
+
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_PVOP_OR_SVOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
+
NewOp(1101, pvop, 1, PVOP);
pvop->op_type = (OPCODE)type;
pvop->op_ppaddr = PL_ppaddr[type];
NewOp(1101, pvop, 1, PVOP);
pvop->op_type = (OPCODE)type;
pvop->op_ppaddr = PL_ppaddr[type];
@@
-4241,7
+4279,7
@@
Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
|| left->op_type == OP_PADHV
|| left->op_type == OP_PADANY))
{
|| left->op_type == OP_PADHV
|| left->op_type == OP_PADANY))
{
- maybe_common_vars = FALSE;
+
if (left->op_type == OP_PADSV)
maybe_common_vars = FALSE;
if (left->op_private & OPpPAD_STATE) {
/* All single variable list context state assignments, hence
state ($a) = ...
if (left->op_private & OPpPAD_STATE) {
/* All single variable list context state assignments, hence
state ($a) = ...
@@
-4555,6
+4593,8
@@
S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
if (type == OP_XOR) /* Not short circuit, but here by precedence. */
return newBINOP(type, flags, scalar(first), scalar(other));
if (type == OP_XOR) /* Not short circuit, but here by precedence. */
return newBINOP(type, flags, scalar(first), scalar(other));
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LOGOP);
+
scalarboolean(first);
/* optimize AND and OR ops that have NOTs as children */
if (first->op_type == OP_NOT
scalarboolean(first);
/* optimize AND and OR ops that have NOTs as children */
if (first->op_type == OP_NOT
@@
-5111,6
+5151,8
@@
Perl_newLOOPEX(pTHX_ I32 type, OP *label)
PERL_ARGS_ASSERT_NEWLOOPEX;
PERL_ARGS_ASSERT_NEWLOOPEX;
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
+
if (type != OP_GOTO || label->op_type == OP_CONST) {
/* "last()" means "last" */
if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
if (type != OP_GOTO || label->op_type == OP_CONST) {
/* "last()" means "last" */
if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
@@
-5240,14
+5282,11
@@
S_looks_like_bool(pTHX_ const OP *o)
&& looks_like_bool(cLOGOPo->op_first->op_sibling));
case OP_NULL:
&& looks_like_bool(cLOGOPo->op_first->op_sibling));
case OP_NULL:
+ case OP_SCALAR:
return (
o->op_flags & OPf_KIDS
&& looks_like_bool(cUNOPo->op_first));
return (
o->op_flags & OPf_KIDS
&& looks_like_bool(cUNOPo->op_first));
- case OP_SCALAR:
- return looks_like_bool(cUNOPo->op_first);
-
-
case OP_ENTERSUB:
case OP_NOT: case OP_XOR:
case OP_ENTERSUB:
case OP_NOT: case OP_XOR:
@@
-5673,7
+5712,9
@@
Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
)&& !attrs) {
if (CvFLAGS(PL_compcv)) {
/* might have had built-in attrs applied */
)&& !attrs) {
if (CvFLAGS(PL_compcv)) {
/* might have had built-in attrs applied */
- CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
+ if (CvLVALUE(PL_compcv) && ! CvLVALUE(cv) && ckWARN(WARN_MISC))
+ Perl_warner(aTHX_ packWARN(WARN_MISC), "lvalue attribute ignored after the subroutine has been defined");
+ CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS & ~CVf_LVALUE);
}
/* just a "sub foo;" when &foo is already defined */
SAVEFREESV(PL_compcv);
}
/* just a "sub foo;" when &foo is already defined */
SAVEFREESV(PL_compcv);
@@
-5742,8
+5783,9
@@
Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
&& block->op_type != OP_NULL
#endif
) {
&& block->op_type != OP_NULL
#endif
) {
+ cv_flags_t existing_builtin_attrs = CvFLAGS(cv) & CVf_BUILTIN_ATTRS;
cv_undef(cv);
cv_undef(cv);
- CvFLAGS(cv) = CvFLAGS(PL_compcv);
+ CvFLAGS(cv) = CvFLAGS(PL_compcv)
| existing_builtin_attrs
;
if (!CvWEAKOUTSIDE(cv))
SvREFCNT_dec(CvOUTSIDE(cv));
CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
if (!CvWEAKOUTSIDE(cv))
SvREFCNT_dec(CvOUTSIDE(cv));
CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
@@
-6560,8
+6602,6
@@
Perl_ck_eval(pTHX_ OP *o)
/* establish postfix order */
enter->op_next = (OP*)enter;
/* establish postfix order */
enter->op_next = (OP*)enter;
- CHECKOP(OP_ENTERTRY, enter);
-
o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
o->op_type = OP_LEAVETRY;
o->op_ppaddr = PL_ppaddr[OP_LEAVETRY];
o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
o->op_type = OP_LEAVETRY;
o->op_ppaddr = PL_ppaddr[OP_LEAVETRY];
@@
-7170,10
+7210,10
@@
Perl_ck_grep(pTHX_ OP *o)
if (o->op_flags & OPf_STACKED) {
OP* k;
o = ck_sort(o);
if (o->op_flags & OPf_STACKED) {
OP* k;
o = ck_sort(o);
- kid = c
LISTOPo->op_first->op_sibling
;
- if (
!cUNOPx(kid)->op_next
)
-
Perl_croak(aTHX_ "panic: ck_grep"
);
- for (k =
cUNOPx(kid)->op_first
; k; k = k->op_next) {
+ kid = c
UNOPx(cLISTOPo->op_first->op_sibling)->op_first
;
+ if (
kid->op_type != OP_SCOPE && kid->op_type != OP_LEAVE
)
+
return no_fh_allowed(o
);
+ for (k =
kid
; k; k = k->op_next) {
kid = k;
}
NewOp(1101, gwop, 1, LOGOP);
kid = k;
}
NewOp(1101, gwop, 1, LOGOP);
@@
-7640,7
+7680,7
@@
Perl_ck_require(pTHX_ OP *o)
return newop;
}
return newop;
}
- return
ck_fun(o
);
+ return
scalar(ck_fun(o)
);
}
OP *
}
OP *
@@
-8325,8
+8365,9
@@
Perl_ck_each(pTHX_ OP *o)
/* caller is supposed to assign the return to the
container of the rep_op var */
/* caller is supposed to assign the return to the
container of the rep_op var */
-OP *
+
STATIC
OP *
S_opt_scalarhv(pTHX_ OP *rep_op) {
S_opt_scalarhv(pTHX_ OP *rep_op) {
+ dVAR;
UNOP *unop;
PERL_ARGS_ASSERT_OPT_SCALARHV;
UNOP *unop;
PERL_ARGS_ASSERT_OPT_SCALARHV;
@@
-8354,7
+8395,7
@@
S_opt_scalarhv(pTHX_ OP *rep_op) {
* beginning of the right-hand side. Returns the left-hand side of the
* assignment if o acts in-place, or NULL otherwise. */
* beginning of the right-hand side. Returns the left-hand side of the
* assignment if o acts in-place, or NULL otherwise. */
-OP *
+
STATIC
OP *
S_is_inplace_av(pTHX_ OP *o, OP *oright) {
OP *o2;
OP *oleft = NULL;
S_is_inplace_av(pTHX_ OP *o, OP *oright) {
OP *o2;
OP *oleft = NULL;
@@
-8637,7
+8678,7
@@
Perl_peep(pTHX_ register OP *o)
){
OP * nop = o;
OP * lop = o;
){
OP * nop = o;
OP * lop = o;
- if (!(
nop->op_flags &&
OPf_WANT_VOID)) {
+ if (!(
(nop->op_flags & OPf_WANT) ==
OPf_WANT_VOID)) {
while (nop && nop->op_next) {
switch (nop->op_next->op_type) {
case OP_NOT:
while (nop && nop->op_next) {
switch (nop->op_next->op_type) {
case OP_NOT:
@@
-8655,7
+8696,7
@@
Perl_peep(pTHX_ register OP *o)
}
}
}
}
}
}
- if (
lop->op_flags &&
OPf_WANT_VOID) {
+ if (
(lop->op_flags & OPf_WANT) ==
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))
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))