/* Destructor */
+/*
+=for apidoc Am|void|op_free|OP *o
+
+Free an op. Only use this when an op is no longer linked to from any optree.
+
+=cut
+*/
+
void
Perl_op_free(pTHX_ OP *o)
{
}
}
+/*
+=for apidoc Am|void|op_null|OP *o
+
+Neutralizes an op when it is no longer needed, but is still linked to from
+other ops.
+
+=cut
+*/
+
void
Perl_op_null(pTHX_ OP *o)
{
=head1 Optree Manipulation Functions
=for apidoc Am|OP*|op_linklist|OP *o
-This function is the implementation of the L</LINKLIST> macro. It should
+This function is the implementation of the L</LINKLIST> macro. It should
not be called directly.
=cut
/*
=for apidoc finalize_optree
-This function finalizes the optree. Should be called directly after
-the complete optree is built. It does some additional
+This function finalizes the optree. Should be called directly after
+the complete optree is built. It does some additional
checking which can't be done in the normal ck_xxx functions and makes
the tree thread-safe.
the lvalue op).
This function detects things that can't be modified, such as C<$x+1>, and
-generates errors for them. For example, C<$x+1 = 2> would cause it to be
+generates errors for them. For example, C<$x+1 = 2> would cause it to be
called with an op of type OP_ADD and a C<type> argument of OP_SASSIGN.
It also flags things that need to behave specially in an lvalue context,
=for apidoc Aox||blockhook_register
Register a set of hooks to be called when the Perl lexical scope changes
-at compile time. See L<perlguts/"Compile-time scope hooks">.
+at compile time.
See L<perlguts/"Compile-time scope hooks">.
=cut
*/
dVAR;
BINOP *binop;
- assert((PL_opargs[type] & OA_CLASS_MASK) == OA_BINOP
+ ASSUME((PL_opargs[type] & OA_CLASS_MASK) == OA_BINOP
|| type == OP_SASSIGN || type == OP_NULL );
NewOp(1101, binop, 1, BINOP);
Note that the actual module name, not its filename, should be given.
Eg, "Foo::Bar" instead of "Foo/Bar.pm". flags can be any of
PERL_LOADMOD_DENY, PERL_LOADMOD_NOIMPORT, or PERL_LOADMOD_IMPORT_OPS
-(or 0 for no flags). ver, if specified and not NULL, provides version semantics
+(or 0 for no flags). ver, if specified
+and not NULL, provides version semantics
similar to C<use Foo::Bar VERSION>. The optional trailing SV*
arguments can be used to specify arguments to the module's import()
method, similar to C<use Foo::Bar VERSION LIST>. They must be
OP* listop;
OP* o;
const bool once = block && block->op_flags & OPf_SPECIAL &&
- (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
+ block->op_type == OP_NULL;
PERL_UNUSED_ARG(debuggable);
=for apidoc cv_const_sv
-If C<cv> is a constant sub eligible for inlining. returns the constant
+If C<cv> is a constant sub eligible for inlining, returns the constant
value returned by the sub. Otherwise, returns NULL.
Constant subs can be created with C<newCONSTSUB> or as described in
return cv;
}
+/* _x = extended */
CV *
-Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
-{
- return newATTRSUB_flags(floor, o, proto, attrs, block, 0);
-}
-
-CV *
-Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
- OP *block, U32 flags)
+Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
+ OP *block, bool o_is_gv)
{
dVAR;
GV *gv;
|| PL_madskills)
? GV_ADDMULTI : GV_ADDMULTI | GV_NOINIT;
STRLEN namlen = 0;
- const bool o_is_gv = flags & 1;
const char * const name =
o ? SvPV_const(o_is_gv ? (SV *)o : cSVOPo->op_sv, namlen) : NULL;
bool has_name;
/* Defer checks to run-time if we have a scalar arg */
if (kid->op_type == OP_RV2AV || kid->op_type == OP_PADAV)
op_lvalue(kid, type);
- else scalar(kid);
+ else {
+ scalar(kid);
+ /* diag_listed_as: push on reference is experimental */
+ Perl_ck_warner_d(aTHX_
+ packWARN(WARN_EXPERIMENTAL__AUTODEREF),
+ "%s on reference is experimental",
+ PL_op_desc[type]);
+ }
break;
case OA_HVREF:
if (kid->op_type == OP_CONST &&
)
);
}
- assert(0);
+ NOT_REACHED;
}
else {
OP *prev, *cvop;
if (!SvREADONLY(sv) && !SvIsCOW(sv) && SvCANCOW(sv)) {
SvIsCOW_on(sv);
CowREFCNT(sv) = 0;
+# ifdef PERL_DEBUG_READONLY_COW
+ sv_buf_to_ro(sv);
+# endif
}
#endif
SvREADONLY_on(sv);
}
}
/* if treating as a reference, defer additional checks to runtime */
- return o->op_type == ref_type ? o : ck_fun(o);
+ if (o->op_type == ref_type) {
+ /* diag_listed_as: keys on reference is experimental */
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__AUTODEREF),
+ "%s is experimental", PL_op_desc[ref_type]);
+ return o;
+ }
+ return ck_fun(o);
}
OP *
}
}
+ /* Optimise 'my $x; my $y;' into 'my ($x, $y);'
+ *
+ * This latter form is then suitable for conversion into padrange
+ * later on. Convert:
+ *
+ * nextstate1 -> padop1 -> nextstate2 -> padop2 -> nextstate3
+ *
+ * into:
+ *
+ * nextstate1 -> listop -> nextstate3
+ * / \
+ * pushmark -> padop1 -> padop2
+ */
+ if (o->op_next && (
+ o->op_next->op_type == OP_PADSV
+ || o->op_next->op_type == OP_PADAV
+ || o->op_next->op_type == OP_PADHV
+ )
+ && !(o->op_next->op_private & ~OPpLVAL_INTRO)
+ && o->op_next->op_next && o->op_next->op_next->op_type == OP_NEXTSTATE
+ && o->op_next->op_next->op_next && (
+ o->op_next->op_next->op_next->op_type == OP_PADSV
+ || o->op_next->op_next->op_next->op_type == OP_PADAV
+ || o->op_next->op_next->op_next->op_type == OP_PADHV
+ )
+ && !(o->op_next->op_next->op_next->op_private & ~OPpLVAL_INTRO)
+ && o->op_next->op_next->op_next->op_next && o->op_next->op_next->op_next->op_next->op_type == OP_NEXTSTATE
+ && (!CopLABEL((COP*)o)) /* Don't mess with labels */
+ && (!CopLABEL((COP*)o->op_next->op_next)) /* ... */
+ ) {
+ OP *first;
+ OP *last;
+ OP *newop;
+
+ first = o->op_next;
+ last = o->op_next->op_next->op_next;
+
+ newop = newLISTOP(OP_LIST, 0, first, last);
+ newop->op_flags |= OPf_PARENS;
+ newop->op_flags = (newop->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
+
+ /* Kill nextstate2 between padop1/padop2 */
+ op_free(first->op_next);
+
+ first->op_next = last; /* padop2 */
+ first->op_sibling = last; /* ... */
+ o->op_next = cUNOPx(newop)->op_first; /* pushmark */
+ o->op_next->op_next = first; /* padop1 */
+ o->op_next->op_sibling = first; /* ... */
+ newop->op_next = last->op_next; /* nextstate3 */
+ newop->op_sibling = last->op_sibling;
+ last->op_next = newop; /* listop */
+ last->op_sibling = NULL;
+ o->op_sibling = newop; /* ... */
+
+ newop->op_flags = (newop->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
+
+ /* Ensure pushmark has this flag if padops do */
+ if (first->op_flags & OPf_MOD && last->op_flags & OPf_MOD) {
+ o->op_next->op_flags |= OPf_MOD;
+ }
+
+ break;
+ }
+
/* Two NEXTSTATEs in a row serve no purpose. Except if they happen
to carry two labels. For now, take the easier option, and skip
this optimisation if the first NEXTSTATE has a label. */
)
break;
- /* let $a[N] potentially be optimised into ALEMFAST_LEX
+ /* let $a[N] potentially be optimised into AELEMFAST_LEX
* instead */
if ( p->op_type == OP_PADAV
&& p->op_next
=head1 Custom Operators
=for apidoc Ao||custom_op_xop
-Return the XOP structure for a given custom op. This macro should be
+Return the XOP structure for a given custom op. This macro should be
considered internal to OP_NAME and the other access macros: use them instead.
-This macro does call a function. Prior to 5.19.8, this was implemented as a
+This macro does call a function. Prior
+to 5.19.9, this was implemented as a
function.
=cut
/*
=for apidoc Ao||custom_op_register
-Register a custom op. See L<perlguts/"Custom Operators">.
+Register a custom op.
See L<perlguts/"Custom Operators">.
=cut
*/
https://perl5.git.perl.org / perl5.git / blobdiff