!(is_our ||
isALPHA(name[1]) ||
((flags & SVf_UTF8) && isIDFIRST_utf8((U8 *)name+1)) ||
- (name[1] == '_' && (*name == '$' || len > 2))))
+ (name[1] == '_' && len > 2)))
{
if (!(flags & SVf_UTF8 && UTF8_IS_START(name[1]))
&& isASCII(name[1])
PL_parser->in_my == KEY_state ? "state" : "my"), flags & SVf_UTF8);
}
}
- else if (len == 2 && name[1] == '_' && !is_our)
- /* diag_listed_as: Use of my $_ is experimental */
- Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__LEXICAL_TOPIC),
- "Use of %s $_ is experimental",
- PL_parser->in_my == KEY_state
- ? "state"
- : "my");
/* allocate a spare slot and store the name in that slot */
type = o->op_type;
/* an op should only ever acquire op_private flags that we know about.
- * If this fails, you may need to fix something in regen/op_private */
- if (o->op_ppaddr == PL_ppaddr[o->op_type]) {
+ * If this fails, you may need to fix something in regen/op_private.
+ * Don't bother testing if:
+ * * the op_ppaddr doesn't match the op; someone may have
+ * overridden the op and be doing strange things with it;
+ * * we've errored, as op flags are often left in an
+ * inconsistent state then. Note that an error when
+ * compiling the main program leaves PL_parser NULL, so
+ * we can't spot faults in the main code, only
+ * evaled/required code */
+#ifdef DEBUGGING
+ if ( o->op_ppaddr == PL_ppaddr[o->op_type]
+ && PL_parser
+ && !PL_parser->error_count)
+ {
assert(!(o->op_private & ~PL_op_private_valid[type]));
}
+#endif
if (o->op_private & OPpREFCOUNTED) {
switch (type) {
void
Perl_op_refcnt_lock(pTHX)
+ PERL_TSA_ACQUIRE(PL_op_mutex)
{
#ifdef USE_ITHREADS
dVAR;
void
Perl_op_refcnt_unlock(pTHX)
+ PERL_TSA_RELEASE(PL_op_mutex)
{
#ifdef USE_ITHREADS
dVAR;
=for apidoc op_sibling_splice
A general function for editing the structure of an existing chain of
-op_sibling nodes. By analogy with the perl-level splice() function, allows
+op_sibling nodes. By analogy with the perl-level C<splice()> function, allows
you to delete zero or more sequential nodes, replacing them with zero or
more different nodes. Performs the necessary op_first/op_last
housekeeping on the parent node and op_sibling manipulation on the
responsibility of the caller. It also won't create a new list op for an
empty list etc; use higher-level functions like op_append_elem() for that.
-parent is the parent node of the sibling chain. It may passed as NULL if
+C<parent> is the parent node of the sibling chain. It may passed as C<NULL> if
the splicing doesn't affect the first or last op in the chain.
-start is the node preceding the first node to be spliced. Node(s)
+C<start> is the node preceding the first node to be spliced. Node(s)
following it will be deleted, and ops will be inserted after it. If it is
-NULL, the first node onwards is deleted, and nodes are inserted at the
+C<NULL>, the first node onwards is deleted, and nodes are inserted at the
beginning.
-del_count is the number of nodes to delete. If zero, no nodes are deleted.
+C<del_count> is the number of nodes to delete. If zero, no nodes are deleted.
If -1 or greater than or equal to the number of remaining kids, all
remaining kids are deleted.
-insert is the first of a chain of nodes to be inserted in place of the nodes.
-If NULL, no nodes are inserted.
+C<insert> is the first of a chain of nodes to be inserted in place of the nodes.
+If C<NULL>, no nodes are inserted.
-The head of the chain of deleted ops is returned, or NULL if no ops were
+The head of the chain of deleted ops is returned, or C<NULL> if no ops were
deleted.
For example:
For lower-level direct manipulation of C<op_sibparent> and C<op_moresib>,
-see C<OpMORESIB_set>, C<OpLASTSIB_set>, C<OpMAYBESIB_set>.
+see C<L</OpMORESIB_set>>, C<L</OpLASTSIB_set>>, C<L</OpMAYBESIB_set>>.
=cut
*/
/*
=for apidoc op_parent
-Returns the parent OP of o, if it has a parent. Returns NULL otherwise.
+Returns the parent OP of C<o>, if it has a parent. Returns C<NULL> otherwise.
This function is only available on perls built with C<-DPERL_OP_PARENT>.
=cut
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
+checking which can't be done in the normal C<ck_>xxx functions and makes
the tree thread-safe.
=cut
Propagate lvalue ("modifiable") context to an op and its children.
C<type> represents the context type, roughly based on the type of op that
-would do the modifying, although C<local()> is represented by OP_NULL,
+would do the modifying, although C<local()> is represented by C<OP_NULL>,
because it has no op type of its own (it is signalled by a flag on
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
-called with an op of type OP_ADD and a C<type> argument of OP_SASSIGN.
+called with an op of type C<OP_ADD> and a C<type> argument of C<OP_SASSIGN>.
It also flags things that need to behave specially in an lvalue context,
such as C<$$x = 5> which might have to vivify a reference in C<$x>.
OP *kid = cUNOPo->op_first;
CV *cv;
GV *gv;
+ SV *namesv;
if (kid->op_type != OP_PUSHMARK) {
if (kid->op_type != OP_NULL || kid->op_targ != OP_LIST)
break;
if (CvLVALUE(cv))
break;
+ if (flags & OP_LVALUE_NO_CROAK)
+ return NULL;
+
+ namesv = cv_name(cv, NULL, 0);
+ yyerror_pv(Perl_form(aTHX_ "Can't modify non-lvalue "
+ "subroutine call of &%"SVf" in %s",
+ SVfARG(namesv), PL_op_desc[type]),
+ SvUTF8(namesv));
+ return o;
}
}
/* FALLTHROUGH */
yyerror(Perl_form(aTHX_ "Can't modify %s in %s",
(o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)
? "do block"
- : (o->op_type == OP_ENTERSUB
- ? "non-lvalue subroutine call"
- : OP_DESC(o))),
+ : OP_DESC(o)),
type ? PL_op_desc[type] : "local"));
return o;
s++;
while (1) {
- if (*s && strchr("@$%*", *s) && *++s
+ if (*s && (strchr("@$%", *s) || (!lex && *s == '*'))
+ && *++s
&& (isWORDCHAR(*s) || UTF8_IS_CONTINUED(*s))) {
s++;
sigil = TRUE;
For most list operators, the check function expects all the kid ops to be
present already, so calling C<newLISTOP(OP_JOIN, ...)> (e.g.) is not
appropriate. What you want to do in that case is create an op of type
-OP_LIST, append more children to it, and then call L</op_convert_list>.
+C<OP_LIST>, append more children to it, and then call L</op_convert_list>.
See L</op_convert_list> for more information.
/*
=for apidoc newUNOP_AUX
-Similar to C<newUNOP>, but creates an UNOP_AUX struct instead, with op_aux
-initialised to aux
+Similar to C<newUNOP>, but creates an C<UNOP_AUX> struct instead, with C<op_aux>
+initialised to C<aux>
=cut
*/
the bit with value 1 is automatically set. C<dynamic_meth> supplies an
op which evaluates method name; it is consumed by this function and
become part of the constructed op tree.
-Supported optypes: OP_METHOD.
+Supported optypes: C<OP_METHOD>.
=cut
*/
C<op_flags>, and, shifted up eight bits, the eight bits of
C<op_private>. C<const_meth> supplies a constant method name;
it must be a shared COW string.
-Supported optypes: OP_METHOD_NAMED.
+Supported optypes: C<OP_METHOD_NAMED>.
=cut
*/
max = rfirst + diff;
if (!grows)
grows = (tfirst < rfirst &&
- UNISKIP(tfirst) < UNISKIP(rfirst + diff));
+ UVCHR_SKIP(tfirst) < UVCHR_SKIP(rfirst + diff));
rfirst += diff + 1;
}
tfirst += diff + 1;
/*
=for apidoc Am|OP *|newDEFSVOP|
-Constructs and returns an op to access C<$_>, either as a lexical
-variable (if declared as C<my $_>) in the current scope, or the
-global C<$_>.
+Constructs and returns an op to access C<$_>.
=cut
*/
OP *
Perl_newDEFSVOP(pTHX)
{
- const PADOFFSET offset = pad_findmy_pvs("$_", 0);
- if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
- }
- else {
- OP * const o = newOP(OP_PADSV, 0);
- o->op_targ = offset;
- return o;
- }
}
#ifdef USE_ITHREADS
Loads the module whose name is pointed to by the string part of name.
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
+C<PERL_LOADMOD_DENY>, C<PERL_LOADMOD_NOIMPORT>, or C<PERL_LOADMOD_IMPORT_OPS>
(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()
+arguments can be used to specify arguments to the module's C<import()>
method, similar to C<use Foo::Bar VERSION LIST>. They must be
-terminated with a final NULL pointer. Note that this list can only
-be omitted when the PERL_LOADMOD_NOIMPORT flag has been used.
-Otherwise at least a single NULL pointer to designate the default
+terminated with a final C<NULL> pointer. Note that this list can only
+be omitted when the C<PERL_LOADMOD_NOIMPORT> flag has been used.
+Otherwise at least a single C<NULL> pointer to designate the default
import list is required.
The reference count for each specified C<SV*> parameter is decremented.
with structure that allows exiting the loop by C<last> and suchlike.
C<sv> optionally supplies the variable that will be aliased to each
-item in turn; if null, it defaults to C<$_> (either lexical or global).
+item in turn; if null, it defaults to C<$_>.
C<expr> supplies the list of values to iterate over. C<block> supplies
the main body of the loop, and C<cont> optionally supplies a C<continue>
block that operates as a second half of the body. All of these optree
}
}
else {
- const PADOFFSET offset = pad_findmy_pvs("$_", 0);
- if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
- sv = newGVOP(OP_GV, 0, PL_defgv);
- }
- else {
- padoff = offset;
- }
+ sv = newGVOP(OP_GV, 0, PL_defgv);
iterpflags |= OPpITER_DEF;
}
OP *o;
PERL_ARGS_ASSERT_NEWGIVWHENOP;
+ PERL_UNUSED_ARG(entertarg); /* used to indicate targ of lexical $_ */
enterop = S_alloc_LOGOP(aTHX_ enter_opcode, block, NULL);
- enterop->op_targ = ((entertarg == NOT_IN_PAD) ? 0 : entertarg);
+ enterop->op_targ = 0;
enterop->op_private = 0;
o = newUNOP(leave_opcode, 0, (OP *) enterop);
C<cond> supplies the expression that will be locally assigned to a lexical
variable, and C<block> supplies the body of the C<given> construct; they
are consumed by this function and become part of the constructed op tree.
-C<defsv_off> is the pad offset of the scalar lexical variable that will
-be affected. If it is 0, the global $_ will be used.
+C<defsv_off> must be zero (it used to identity the pad slot of lexical $_).
=cut
*/
Perl_newGIVENOP(pTHX_ OP *cond, OP *block, PADOFFSET defsv_off)
{
PERL_ARGS_ASSERT_NEWGIVENOP;
+ PERL_UNUSED_ARG(defsv_off);
+
+ assert(!defsv_off);
return newGIVWHENOP(
ref_array_or_hash(cond),
block,
OP_ENTERGIVEN, OP_LEAVEGIVEN,
- defsv_off);
+ 0);
}
/*
=for apidoc cv_const_sv
If C<cv> is a constant sub eligible for inlining, returns the constant
-value returned by the sub. Otherwise, returns NULL.
+value returned by the sub. Otherwise, returns C<NULL>.
Constant subs can be created with C<newCONSTSUB> or as described in
L<perlsub/"Constant Functions">.
block->op_next = 0;
if (ps && !*ps && !attrs && !CvLVALUE(PL_compcv))
const_sv =
- S_op_const_sv(aTHX_ start, PL_compcv, CvCLONE(PL_compcv));
+ S_op_const_sv(aTHX_ start, PL_compcv,
+ cBOOL(CvCLONE(PL_compcv)));
else
const_sv = NULL;
}
/*
=for apidoc newCONSTSUB_flags
-Creates a constant sub equivalent to Perl C<sub FOO () { 123 }> which is
+Creates a constant sub equivalent to Perl S<C<sub FOO () { 123 }>> which is
eligible for inlining at compile-time.
-Currently, the only useful value for C<flags> is SVf_UTF8.
+Currently, the only useful value for C<flags> is C<SVf_UTF8>.
The newly created subroutine takes ownership of a reference to the passed in
SV.
-Passing NULL for SV creates a constant sub equivalent to C<sub BAR () {}>,
+Passing C<NULL> for SV creates a constant sub equivalent to S<C<sub BAR () {}>>,
which won't be called if used as a destructor, but will suppress the overhead
of a call to C<AUTOLOAD>. (This form, however, isn't eligible for inlining at
compile time.)
op_free(o);
return newop;
}
+ scalar((OP *) kid);
if ((PL_hints & HINT_FILETEST_ACCESS) && OP_IS_FILETEST_ACCESS(o->op_type))
o->op_private |= OPpFT_ACCESS;
if (type != OP_STAT && type != OP_LSTAT
LOGOP *gwop;
OP *kid;
const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
- PADOFFSET offset;
PERL_ARGS_ASSERT_CK_GREP;
gwop = S_alloc_LOGOP(aTHX_ type, o, LINKLIST(kid));
kid->op_next = (OP*)gwop;
- offset = pad_findmy_pvs("$_", 0);
- if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
- o->op_private = gwop->op_private = 0;
- gwop->op_targ = pad_alloc(type, SVs_PADTMP);
- }
- else {
- o->op_private = gwop->op_private = OPpGREP_LEX;
- gwop->op_targ = o->op_targ = offset;
- }
+ o->op_private = gwop->op_private = 0;
+ gwop->op_targ = pad_alloc(type, SVs_PADTMP);
kid = OpSIBLING(cLISTOPo->op_first);
for (kid = OpSIBLING(kid); kid; kid = OpSIBLING(kid))
OP *
Perl_ck_match(pTHX_ OP *o)
{
+ PERL_UNUSED_CONTEXT;
PERL_ARGS_ASSERT_CK_MATCH;
- if (o->op_type != OP_QR && PL_compcv) {
- const PADOFFSET offset = pad_findmy_pvs("$_", 0);
- if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS_isOUR(offset))) {
- o->op_targ = offset;
- o->op_private |= OPpTARGET_MY;
- }
- }
if (o->op_type == OP_MATCH || o->op_type == OP_QR)
o->op_private |= OPpRUNTIME;
return o;
Perl_ck_entersub_args_list(pTHX_ OP *entersubop)
{
OP *aop;
+
PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_LIST;
+
aop = cUNOPx(entersubop)->op_first;
if (!OpHAS_SIBLING(aop))
aop = cUNOPx(aop)->op_first;
for (aop = OpSIBLING(aop); OpHAS_SIBLING(aop); aop = OpSIBLING(aop)) {
+ /* skip the extra attributes->import() call implicitly added in
+ * something like foo(my $x : bar)
+ */
+ if ( aop->op_type == OP_ENTERSUB
+ && (aop->op_flags & OPf_WANT) == OPf_WANT_VOID
+ )
+ continue;
list(aop);
op_lvalue(aop, OP_ENTERSUB);
}
that's flagged OA_DANGEROUS */
AAS_SAFE_SCALAR = 0x100, /* produces at least one scalar SV that's
not in any of the categories above */
- AAS_DEFAV = 0x200, /* contains just a single '@_' on RHS */
+ AAS_DEFAV = 0x200 /* contains just a single '@_' on RHS */
};
break;
/* there's a biggest base we can fit into a
- * SAVEt_CLEARPADRANGE in pp_padrange */
- if (intro && base >
- (UV_MAX >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT)))
+ * SAVEt_CLEARPADRANGE in pp_padrange.
+ * (The sizeof() stuff will be constant-folded, and is
+ * intended to avoid getting "comparison is always false"
+ * compiler warnings)
+ */
+ if ( intro
+ && (8*sizeof(base) >
+ 8*sizeof(UV)-OPpPADRANGE_COUNTSHIFT-SAVE_TIGHT_SHIFT
+ ? base : 0) >
+ (UV_MAX >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT))
+ )
break;
/* Success! We've got another valid pad op to optimise away */
=for apidoc Ao||custom_op_xop
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.
+considered internal to C<OP_NAME> and the other access macros: use them instead.
This macro does call a function. Prior
to 5.19.6, this was implemented as a
function.
=for apidoc core_prototype
This function assigns the prototype of the named core function to C<sv>, or
-to a new mortal SV if C<sv> is NULL. It returns the modified C<sv>, or
-NULL if the core function has no prototype. C<code> is a code as returned
+to a new mortal SV if C<sv> is C<NULL>. It returns the modified C<sv>, or
+C<NULL> if the core function has no prototype. C<code> is a code as returned
by C<keyword()>. It must not be equal to 0.
=cut
https://perl5.git.perl.org / perl5.git / blobdiff