o->op_ppaddr = PL_ppaddr[OP_I_PREDEC];
break;
+ case OP_SASSIGN: {
+ OP *rv2gv;
+ UNOP *refgen, *rv2cv;
+ LISTOP *exlist;
+
+ if ((o->op_private & ~OPpASSIGN_BACKWARDS) != 2)
+ break;
+
+ rv2gv = ((BINOP *)o)->op_last;
+ if (!rv2gv || rv2gv->op_type != OP_RV2GV)
+ break;
+
+ refgen = (UNOP *)((BINOP *)o)->op_first;
+
+ if (!refgen || refgen->op_type != OP_REFGEN)
+ break;
+
+ exlist = (LISTOP *)refgen->op_first;
+ if (!exlist || exlist->op_type != OP_NULL
+ || exlist->op_targ != OP_LIST)
+ break;
+
+ if (exlist->op_first->op_type != OP_PUSHMARK)
+ break;
+
+ rv2cv = (UNOP*)exlist->op_last;
+
+ if (rv2cv->op_type != OP_RV2CV)
+ break;
+
+ assert ((rv2gv->op_private & OPpDONT_INIT_GV) == 0);
+ assert ((o->op_private & OPpASSIGN_CV_TO_GV) == 0);
+ assert ((rv2cv->op_private & OPpMAY_RETURN_CONSTANT) == 0);
+
+ o->op_private |= OPpASSIGN_CV_TO_GV;
+ rv2gv->op_private |= OPpDONT_INIT_GV;
+ rv2cv->op_private |= OPpMAY_RETURN_CONSTANT;
+
+ break;
+ }
+
case OP_OR:
case OP_AND:
kid = cLOGOPo->op_first;
OP *prop_op = (OP *) mp->mad_val;
/* We only need "Relocate sv to the pad for thread safety.", but this
easiest way to make sure it traverses everything */
+ if (prop_op->op_type == OP_CONST)
+ cSVOPx(prop_op)->op_private &= ~OPpCONST_STRICT;
finalize_op(prop_op);
}
mp = mp->mad_next;
return o;
}
+ assert( (o->op_flags & OPf_WANT) != OPf_WANT_VOID );
+
switch (o->op_type) {
case OP_UNDEF:
localize = 0;
break;
goto nomod;
case OP_ENTERSUB:
- if ((type == OP_UNDEF || type == OP_REFGEN) &&
+ if ((type == OP_UNDEF || type == OP_REFGEN || type == OP_LOCK) &&
!(o->op_flags & OPf_STACKED)) {
o->op_type = OP_RV2CV; /* entersub => rv2cv */
/* Both ENTERSUB and RV2CV use this bit, but for different pur-
op_null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
break;
}
- else if (o->op_private & OPpENTERSUB_NOMOD)
- return o;
else { /* lvalue subroutine call */
o->op_private |= OPpLVAL_INTRO
|(OPpENTERSUB_INARGS * (type == OP_LEAVESUBLV));
case OP_LIST:
localize = 0;
for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
- op_lvalue(kid, type);
+ /* elements might be in void context because the list is
+ in scalar context or because they are attribute sub calls */
+ if ( (kid->op_flags & OPf_WANT) != OPf_WANT_VOID )
+ op_lvalue(kid, type);
break;
case OP_RETURN:
op_append_elem(OP_LIST,
op_prepend_elem(OP_LIST, pack, list(arg)),
newSVOP(OP_METHOD_NAMED, 0, meth)));
- imop->op_private |= OPpENTERSUB_NOMOD;
/* Combine the ops. */
*imopsp = op_append_elem(OP_LIST, *imopsp, imop);
{
PERL_ARGS_ASSERT_CV_CKPROTO_LEN;
- /* Can't just use a strcmp on the prototype, as CONSTSUBs "cheat" by
- relying on SvCUR, and doubling up the buffer to hold CvFILE(). */
if (((!p != !SvPOK(cv)) /* One has prototype, one has not. */
|| (p && (len != SvCUR(cv) /* Not the same length. */
|| memNE(p, SvPVX_const(cv), len))))
CvOUTSIDE(PL_compcv) = temp_cv;
CvPADLIST(PL_compcv) = temp_av;
-#ifdef USE_ITHREADS
- if (CvFILE(cv) && !CvISXSUB(cv)) {
- /* for XSUBs CvFILE point directly to static memory; __FILE__ */
+ if (CvFILE(cv) && CvDYNFILE(cv)) {
Safefree(CvFILE(cv));
}
-#endif
CvFILE_set_from_cop(cv, PL_curcop);
CvSTASH_set(cv, PL_curstash);
CopSTASH_set(PL_curcop,stash);
}
- /* file becomes the CvFILE. For an XS, it's supposed to be static storage,
+ /* file becomes the CvFILE. For an XS, it's usually static storage,
and so doesn't get free()d. (It's expected to be from the C pre-
processor __FILE__ directive). But we need a dynamically allocated one,
and we need it to get freed. */
PERL_ARGS_ASSERT_NEWXS_FLAGS;
if (flags & XS_DYNAMIC_FILENAME) {
- /* We need to "make arrangements" (ie cheat) to ensure that the
- filename lasts as long as the PVCV we just created, but also doesn't
- leak */
- STRLEN filename_len = strlen(filename);
- STRLEN proto_and_file_len = filename_len;
- char *proto_and_file;
- STRLEN proto_len;
-
- if (proto) {
- proto_len = strlen(proto);
- proto_and_file_len += proto_len;
-
- Newx(proto_and_file, proto_and_file_len + 1, char);
- Copy(proto, proto_and_file, proto_len, char);
- Copy(filename, proto_and_file + proto_len, filename_len + 1, char);
- } else {
- proto_len = 0;
- proto_and_file = savepvn(filename, filename_len);
- }
-
- /* This gets free()d. :-) */
- sv_usepvn_flags(MUTABLE_SV(cv), proto_and_file, proto_and_file_len,
- SV_HAS_TRAILING_NUL);
- if (proto) {
- /* This gives us the correct prototype, rather than one with the
- file name appended. */
- SvCUR_set(cv, proto_len);
- } else {
- SvPOK_off(cv);
- }
- CvFILE(cv) = proto_and_file + proto_len;
- } else {
- sv_setpv(MUTABLE_SV(cv), proto);
+ CvFILE(cv) = savepv(filename);
+ CvDYNFILE_on(cv);
}
+ sv_setpv(MUTABLE_SV(cv), proto);
return cv;
}
(void)gv_fetchfile(filename);
CvFILE(cv) = (char *)filename; /* NOTE: not copied, as it is expected to be
an external constant string */
+ assert(!CvDYNFILE(cv)); /* cv_undef should have turned it off */
CvISXSUB_on(cv);
CvXSUB(cv) = subaddr;
break;
}
- case OP_SASSIGN: {
- OP *rv2gv;
- UNOP *refgen, *rv2cv;
- LISTOP *exlist;
-
- if ((o->op_flags & OPf_WANT) != OPf_WANT_VOID)
- break;
-
- if ((o->op_private & ~OPpASSIGN_BACKWARDS) != 2)
- break;
-
- rv2gv = ((BINOP *)o)->op_last;
- if (!rv2gv || rv2gv->op_type != OP_RV2GV)
- break;
-
- refgen = (UNOP *)((BINOP *)o)->op_first;
-
- if (!refgen || refgen->op_type != OP_REFGEN)
- break;
-
- exlist = (LISTOP *)refgen->op_first;
- if (!exlist || exlist->op_type != OP_NULL
- || exlist->op_targ != OP_LIST)
- break;
-
- if (exlist->op_first->op_type != OP_PUSHMARK)
- break;
-
- rv2cv = (UNOP*)exlist->op_last;
-
- if (rv2cv->op_type != OP_RV2CV)
- break;
-
- assert ((rv2gv->op_private & OPpDONT_INIT_GV) == 0);
- assert ((o->op_private & OPpASSIGN_CV_TO_GV) == 0);
- assert ((rv2cv->op_private & OPpMAY_RETURN_CONSTANT) == 0);
-
- o->op_private |= OPpASSIGN_CV_TO_GV;
- rv2gv->op_private |= OPpDONT_INIT_GV;
- rv2cv->op_private |= OPpMAY_RETURN_CONSTANT;
-
- break;
- }
-
-
case OP_QR:
case OP_MATCH:
if (!(cPMOP->op_pmflags & PMf_ONCE)) {
=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.
-
-If the C<name> is not a Perl keyword, it croaks if C<croak> is true, or
-returns NULL if C<croak> is false.
+NULL if the core function has no prototype. C<code> is a code as returned
+by C<keyword()>. It must be negative and unequal to -KEY_CORE.
=cut
*/
str[n++] = '$';
str[n++] = '@';
str[n++] = '%';
+ if (i == OP_LOCK) str[n++] = '&';
str[n++] = '*';
str[n++] = ']';
}
}
if (defgv && str[0] == '$')
str[0] = '_';
+ if (code == -KEY_not || code == -KEY_getprotobynumber) str[n++] = ';';
str[n++] = '\0';
sv_setpvn(sv, str, n - 1);
if (opnum) *opnum = i;
https://perl5.git.perl.org / perl5.git / blobdiff