if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs))
cx->sb_rxtainted |= 2;
sv_catsv(dstr, POPs);
- FREETMPS; /* Prevent excess tmp stack */
/* Are we done */
- if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
+ if (CxONCE(cx) || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
s == m, cx->sb_targ, NULL,
((cx->sb_rflags & REXEC_COPY_STR)
? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
{ /* Update the pos() information. */
SV * const sv = cx->sb_targ;
MAGIC *mg;
- I32 i;
SvUPGRADE(sv, SVt_PVMG);
if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
#ifdef PERL_OLD_COPY_ON_WRITE
mg = sv_magicext(sv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
NULL, 0);
}
- i = m - orig;
- if (DO_UTF8(sv))
- sv_pos_b2u(sv, &i);
- mg->mg_len = i;
+ mg->mg_len = m - orig;
}
if (old != rx)
(void)ReREFCNT_inc(rx);
{
UV *p = (UV*)*rsp;
U32 i;
+
+ PERL_ARGS_ASSERT_RXRES_SAVE;
PERL_UNUSED_CONTEXT;
if (!p || p[1] < RX_NPARENS(rx)) {
{
UV *p = (UV*)*rsp;
U32 i;
+
+ PERL_ARGS_ASSERT_RXRES_RESTORE;
PERL_UNUSED_CONTEXT;
RX_MATCH_COPY_FREE(rx);
Perl_rxres_free(pTHX_ void **rsp)
{
UV * const p = (UV*)*rsp;
+
+ PERL_ARGS_ASSERT_RXRES_FREE;
PERL_UNUSED_CONTEXT;
if (p) {
SV * nsv = NULL;
OP * parseres = NULL;
const char *fmt;
- bool oneline;
if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) {
if (SvREADONLY(tmpForm)) {
*t = '\0';
sv_catpvn_utf8_upgrade(PL_formtarget, f, arg, nsv);
t = SvEND(PL_formtarget);
+ f += arg;
break;
}
if (!targ_is_utf8 && DO_UTF8(tmpForm)) {
case FF_LINESNGL:
chopspace = 0;
- oneline = TRUE;
- goto ff_line;
case FF_LINEGLOB:
- oneline = FALSE;
- ff_line:
{
+ const bool oneline = fpc[-1] == FF_LINESNGL;
const char *s = item = SvPV_const(sv, len);
+ item_is_utf8 = DO_UTF8(sv);
itemsize = len;
- if ((item_is_utf8 = DO_UTF8(sv)))
- itemsize = sv_len_utf8(sv);
if (itemsize) {
- bool chopped = FALSE;
+ STRLEN to_copy = itemsize;
const char *const send = s + len;
+ const U8 *source = (const U8 *) s;
+ U8 *tmp = NULL;
+
gotsome = TRUE;
chophere = s + itemsize;
while (s < send) {
if (*s++ == '\n') {
if (oneline) {
- chopped = TRUE;
+ to_copy = s - SvPVX_const(sv) - 1;
chophere = s;
break;
} else {
if (s == send) {
itemsize--;
- chopped = TRUE;
+ to_copy--;
} else
lines++;
}
}
}
- SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
- if (targ_is_utf8)
- SvUTF8_on(PL_formtarget);
- if (oneline) {
- SvCUR_set(sv, chophere - item);
- sv_catsv(PL_formtarget, sv);
- SvCUR_set(sv, itemsize);
- } else
- sv_catsv(PL_formtarget, sv);
- if (chopped)
- SvCUR_set(PL_formtarget, SvCUR(PL_formtarget) - 1);
- SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1);
+ if (targ_is_utf8 && !item_is_utf8) {
+ source = tmp = bytes_to_utf8(source, &to_copy);
+ SvCUR_set(PL_formtarget,
+ t - SvPVX_const(PL_formtarget));
+ } else {
+ if (item_is_utf8 && !targ_is_utf8) {
+ /* Upgrade targ to UTF8, and then we reduce it to
+ a problem we have a simple solution for. */
+ SvCUR_set(PL_formtarget,
+ t - SvPVX_const(PL_formtarget));
+ targ_is_utf8 = TRUE;
+ /* Don't need get magic. */
+ sv_utf8_upgrade_flags(PL_formtarget, 0);
+ } else {
+ SvCUR_set(PL_formtarget,
+ t - SvPVX_const(PL_formtarget));
+ }
+
+ /* Easy. They agree. */
+ assert (item_is_utf8 == targ_is_utf8);
+ }
+ SvGROW(PL_formtarget,
+ SvCUR(PL_formtarget) + to_copy + fudge + 1);
t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget);
- if (item_is_utf8)
- targ_is_utf8 = TRUE;
+
+ Copy(source, t, to_copy, char);
+ t += to_copy;
+ SvCUR_set(PL_formtarget, SvCUR(PL_formtarget) + to_copy);
+ if (item_is_utf8) {
+ if (SvGMAGICAL(sv)) {
+ /* Mustn't call sv_pos_b2u() as it does a second
+ mg_get(). Is this a bug? Do we need a _flags()
+ variant? */
+ itemsize = utf8_length(source, source + itemsize);
+ } else {
+ sv_pos_b2u(sv, &itemsize);
+ }
+ assert(!tmp);
+ } else if (tmp) {
+ Safefree(tmp);
+ }
}
break;
}
static const char * const context_name[] = {
"pseudo-block",
+ "when",
+ NULL, /* CXt_BLOCK never actually needs "block" */
+ "given",
+ NULL, /* CXt_LOOP_FOR never actually needs "loop" */
+ NULL, /* CXt_LOOP_PLAIN never actually needs "loop" */
+ NULL, /* CXt_LOOP_LAZYSV never actually needs "loop" */
+ NULL, /* CXt_LOOP_LAZYIV never actually needs "loop" */
"subroutine",
+ "format",
"eval",
- "loop",
"substitution",
- "block",
- "format",
- "given",
- "when"
};
STATIC I32
dVAR;
register I32 i;
+ PERL_ARGS_ASSERT_DOPOPTOLABEL;
+
for (i = cxstack_ix; i >= 0; i--) {
register const PERL_CONTEXT * const cx = &cxstack[i];
switch (CxTYPE(cx)) {
if (CxTYPE(cx) == CXt_NULL)
return -1;
break;
- case CXt_LOOP:
+ case CXt_LOOP_LAZYIV:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_FOR:
+ case CXt_LOOP_PLAIN:
if ( !CxLABEL(cx) || strNE(label, CxLABEL(cx)) ) {
DEBUG_l(Perl_deb(aTHX_ "(Skipping label #%ld %s)\n",
(long)i, CxLABEL(cx)));
{
dVAR;
I32 i;
+
+ PERL_ARGS_ASSERT_DOPOPTOSUB_AT;
+
for (i = startingblock; i >= 0; i--) {
register const PERL_CONTEXT * const cx = &cxstk[i];
switch (CxTYPE(cx)) {
if ((CxTYPE(cx)) == CXt_NULL)
return -1;
break;
- case CXt_LOOP:
+ case CXt_LOOP_LAZYIV:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_FOR:
+ case CXt_LOOP_PLAIN:
DEBUG_l( Perl_deb(aTHX_ "(Found loop #%ld)\n", (long)i));
return i;
}
case CXt_GIVEN:
DEBUG_l( Perl_deb(aTHX_ "(Found given #%ld)\n", (long)i));
return i;
- case CXt_LOOP:
+ case CXt_LOOP_PLAIN:
+ assert(!CxFOREACHDEF(cx));
+ break;
+ case CXt_LOOP_LAZYIV:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_FOR:
if (CxFOREACHDEF(cx)) {
DEBUG_l( Perl_deb(aTHX_ "(Found foreach #%ld)\n", (long)i));
return i;
case CXt_EVAL:
POPEVAL(cx);
break;
- case CXt_LOOP:
+ case CXt_LOOP_LAZYIV:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_FOR:
+ case CXt_LOOP_PLAIN:
POPLOOP(cx);
break;
case CXt_NULL:
Perl_qerror(pTHX_ SV *err)
{
dVAR;
+
+ PERL_ARGS_ASSERT_QERROR;
+
if (PL_in_eval)
sv_catsv(ERRSV, err);
else if (PL_errors)
SV * const sv = newSV(0);
gv_efullname3(sv, cvgv, NULL);
mPUSHs(sv);
- mPUSHi((I32)CxHASARGS(cx));
+ PUSHs(boolSV(CxHASARGS(cx)));
}
else {
PUSHs(newSVpvs_flags("(unknown)", SVs_TEMP));
- mPUSHi((I32)CxHASARGS(cx));
+ PUSHs(boolSV(CxHASARGS(cx)));
}
}
else {
if (gimme == G_VOID)
PUSHs(&PL_sv_undef);
else
- mPUSHi(gimme & G_ARRAY);
+ PUSHs(boolSV((gimme & G_WANT) == G_ARRAY));
if (CxTYPE(cx) == CXt_EVAL) {
/* eval STRING */
- if (cx->blk_eval.old_op_type == OP_ENTEREVAL) {
+ if (CxOLD_OP_TYPE(cx) == OP_ENTEREVAL) {
PUSHs(cx->blk_eval.cur_text);
PUSHs(&PL_sv_no);
}
register PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;
SV **svp;
- U16 cxtype = CXt_LOOP | CXp_FOREACH;
+ U8 cxtype = CXt_LOOP_FOR;
#ifdef USE_ITHREADS
- void *iterdata;
+ PAD *iterdata;
#endif
ENTER;
SAVESETSVFLAGS(PAD_SVl(PL_op->op_targ),
SVs_PADSTALE, SVs_PADSTALE);
}
+ SAVEPADSVANDMORTALIZE(PL_op->op_targ);
#ifndef USE_ITHREADS
svp = &PAD_SVl(PL_op->op_targ); /* "my" variable */
- SAVESPTR(*svp);
#else
- SAVEPADSV(PL_op->op_targ);
- iterdata = INT2PTR(void*, PL_op->op_targ);
- cxtype |= CXp_PADVAR;
+ iterdata = NULL;
#endif
}
else {
SAVEGENERICSV(*svp);
*svp = newSV(0);
#ifdef USE_ITHREADS
- iterdata = (void*)gv;
+ iterdata = (PAD*)gv;
#endif
}
PUSHBLOCK(cx, cxtype, SP);
#ifdef USE_ITHREADS
- PUSHLOOP(cx, iterdata, MARK);
+ PUSHLOOP_FOR(cx, iterdata, MARK, PL_op->op_targ);
#else
- PUSHLOOP(cx, svp, MARK);
+ PUSHLOOP_FOR(cx, svp, MARK, 0);
#endif
if (PL_op->op_flags & OPf_STACKED) {
- cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
- if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
+ SV *maybe_ary = POPs;
+ if (SvTYPE(maybe_ary) != SVt_PVAV) {
dPOPss;
- SV * const right = (SV*)cx->blk_loop.iterary;
+ SV * const right = maybe_ary;
SvGETMAGIC(sv);
SvGETMAGIC(right);
if (RANGE_IS_NUMERIC(sv,right)) {
+ cx->cx_type &= ~CXTYPEMASK;
+ cx->cx_type |= CXt_LOOP_LAZYIV;
+ /* Make sure that no-one re-orders cop.h and breaks our
+ assumptions */
+ assert(CxTYPE(cx) == CXt_LOOP_LAZYIV);
#ifdef NV_PRESERVES_UV
if ((SvOK(sv) && ((SvNV(sv) < (NV)IV_MIN) ||
(SvNV(sv) > (NV)IV_MAX)))
(SvNV(right) > (NV)UV_MAX))))))
#endif
DIE(aTHX_ "Range iterator outside integer range");
- cx->blk_loop.iterix = SvIV(sv);
- cx->blk_loop.itermax = SvIV(right);
+ cx->blk_loop.state_u.lazyiv.cur = SvIV(sv);
+ cx->blk_loop.state_u.lazyiv.end = SvIV(right);
#ifdef DEBUGGING
/* for correct -Dstv display */
cx->blk_oldsp = sp - PL_stack_base;
#endif
}
else {
- cx->blk_loop.iterlval = newSVsv(sv);
- (void) SvPV_force_nolen(cx->blk_loop.iterlval);
+ cx->cx_type &= ~CXTYPEMASK;
+ cx->cx_type |= CXt_LOOP_LAZYSV;
+ /* Make sure that no-one re-orders cop.h and breaks our
+ assumptions */
+ assert(CxTYPE(cx) == CXt_LOOP_LAZYSV);
+ cx->blk_loop.state_u.lazysv.cur = newSVsv(sv);
+ cx->blk_loop.state_u.lazysv.end = right;
+ SvREFCNT_inc(right);
+ (void) SvPV_force_nolen(cx->blk_loop.state_u.lazysv.cur);
+ /* This will do the upgrade to SVt_PV, and warn if the value
+ is uninitialised. */
(void) SvPV_nolen_const(right);
+ /* Doing this avoids a check every time in pp_iter in pp_hot.c
+ to replace !SvOK() with a pointer to "". */
+ if (!SvOK(right)) {
+ SvREFCNT_dec(right);
+ cx->blk_loop.state_u.lazysv.end = &PL_sv_no;
+ }
}
}
- else if (PL_op->op_private & OPpITER_REVERSED) {
- cx->blk_loop.itermax = 0;
- cx->blk_loop.iterix = AvFILL(cx->blk_loop.iterary) + 1;
-
+ else /* SvTYPE(maybe_ary) == SVt_PVAV */ {
+ cx->blk_loop.state_u.ary.ary = (AV*)maybe_ary;
+ SvREFCNT_inc(maybe_ary);
+ cx->blk_loop.state_u.ary.ix =
+ (PL_op->op_private & OPpITER_REVERSED) ?
+ AvFILL(cx->blk_loop.state_u.ary.ary) + 1 :
+ -1;
}
}
- else {
- cx->blk_loop.iterary = PL_curstack;
- AvFILLp(PL_curstack) = SP - PL_stack_base;
+ else { /* iterating over items on the stack */
+ cx->blk_loop.state_u.ary.ary = NULL; /* means to use the stack */
if (PL_op->op_private & OPpITER_REVERSED) {
- cx->blk_loop.itermax = MARK - PL_stack_base + 1;
- cx->blk_loop.iterix = cx->blk_oldsp + 1;
+ cx->blk_loop.state_u.ary.ix = cx->blk_oldsp + 1;
}
else {
- cx->blk_loop.iterix = MARK - PL_stack_base;
+ cx->blk_loop.state_u.ary.ix = MARK - PL_stack_base;
}
}
SAVETMPS;
ENTER;
- PUSHBLOCK(cx, CXt_LOOP, SP);
- PUSHLOOP(cx, 0, SP);
+ PUSHBLOCK(cx, CXt_LOOP_PLAIN, SP);
+ PUSHLOOP_PLAIN(cx, SP);
RETURN;
}
SV **mark;
POPBLOCK(cx,newpm);
- assert(CxTYPE(cx) == CXt_LOOP);
+ assert(CxTYPE_is_LOOP(cx));
mark = newsp;
newsp = PL_stack_base + cx->blk_loop.resetsp;
PL_curpm = newpm; /* ... and pop $1 et al */
LEAVESUB(sv);
- if (clear_errsv)
- sv_setpvn(ERRSV,"",0);
+ if (clear_errsv) {
+ CLEAR_ERRSV();
+ }
return retop;
}
cxstack_ix++; /* temporarily protect top context */
mark = newsp;
switch (CxTYPE(cx)) {
- case CXt_LOOP:
- pop2 = CXt_LOOP;
+ case CXt_LOOP_LAZYIV:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_FOR:
+ case CXt_LOOP_PLAIN:
+ pop2 = CxTYPE(cx);
newsp = PL_stack_base + cx->blk_loop.resetsp;
nextop = cx->blk_loop.my_op->op_lastop->op_next;
break;
cxstack_ix--;
/* Stack values are safe: */
switch (pop2) {
- case CXt_LOOP:
+ case CXt_LOOP_LAZYIV:
+ case CXt_LOOP_PLAIN:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_FOR:
POPLOOP(cx); /* release loop vars ... */
LEAVE;
break;
OP **ops = opstack;
static const char too_deep[] = "Target of goto is too deeply nested";
+ PERL_ARGS_ASSERT_DOFINDLABEL;
+
if (ops >= oplimit)
Perl_croak(aTHX_ too_deep);
if (o->op_type == OP_LEAVE ||
/* First try all the kids at this level, since that's likeliest. */
for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
- kCOP->cop_label && strEQ(kCOP->cop_label, label))
+ CopLABEL(kCOP) && strEQ(CopLABEL(kCOP), label))
return kid;
}
for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
else {
AV* const padlist = CvPADLIST(cv);
if (CxTYPE(cx) == CXt_EVAL) {
- PL_in_eval = cx->blk_eval.old_in_eval;
+ PL_in_eval = CxOLD_IN_EVAL(cx);
PL_eval_root = cx->blk_eval.old_eval_root;
cx->cx_type = CXt_SUB;
- cx->blk_sub.hasargs = 0;
}
cx->blk_sub.cv = cv;
cx->blk_sub.olddepth = CvDEPTH(cv);
break;
}
/* else fall through */
- case CXt_LOOP:
+ case CXt_LOOP_LAZYIV:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_FOR:
+ case CXt_LOOP_PLAIN:
gotoprobe = cx->blk_oldcop->op_sibling;
break;
case CXt_SUBST:
const char * const send = SvPVX_const(sv) + SvCUR(sv);
I32 line = 1;
+ PERL_ARGS_ASSERT_SAVE_LINES;
+
while (s && s < send) {
const char *t;
SV * const tmpstr = newSV_type(SVt_PVMG);
CV* runcv = NULL; /* initialise to avoid compiler warnings */
STRLEN len;
+ PERL_ARGS_ASSERT_SV_COMPILE_2OP;
+
ENTER;
lex_start(sv, NULL, FALSE);
SAVETMPS;
PL_op->op_type = OP_ENTEREVAL;
PL_op->op_flags = 0; /* Avoid uninit warning. */
PUSHBLOCK(cx, CXt_EVAL|(IN_PERL_COMPILETIME ? 0 : CXp_REAL), SP);
- PUSHEVAL(cx, 0, NULL);
+ PUSHEVAL(cx, 0);
if (runtime)
(void) doeval(G_SCALAR, startop, runcv, PL_curcop->cop_seq);
if (saveop && (saveop->op_type != OP_REQUIRE) && (saveop->op_flags & OPf_SPECIAL))
PL_in_eval |= EVAL_KEEPERR;
else
- sv_setpvn(ERRSV,"",0);
+ CLEAR_ERRSV();
if (yyparse() || PL_parser->error_count || !PL_eval_root) {
SV **newsp; /* Used by POPBLOCK. */
PERL_CONTEXT *cx = &cxstack[cxstack_ix];
&& cLISTOPx(cUNOPx(PL_eval_root)->op_first)->op_last->op_type
== OP_REQUIRE)
scalar(PL_eval_root);
- else if (gimme & G_VOID)
+ else if ((gimme & G_WANT) == G_VOID)
scalarvoid(PL_eval_root);
- else if (gimme & G_ARRAY)
+ else if ((gimme & G_WANT) == G_ARRAY)
list(PL_eval_root);
else
scalar(PL_eval_root);
Stat_t st;
const int st_rc = PerlLIO_stat(name, &st);
+ PERL_ARGS_ASSERT_CHECK_TYPE_AND_OPEN;
+
if (st_rc < 0 || S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
return NULL;
}
{
PerlIO *fp;
+ PERL_ARGS_ASSERT_DOOPEN_PM;
+
if (namelen > 3 && memEQs(name + namelen - 3, 3, ".pm")) {
SV *const pmcsv = newSV(namelen + 2);
char *const pmc = SvPVX(pmcsv);
}
}
- if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVGV) {
+ if (SvROK(arg) && isGV_with_GP(SvRV(arg))) {
arg = SvRV(arg);
}
- if (SvTYPE(arg) == SVt_PVGV) {
+ if (isGV_with_GP(arg)) {
IO * const io = GvIO((GV *)arg);
++filter_has_file;
SAVEHINTS();
PL_hints = 0;
+ if (PL_compiling.cop_hints_hash) {
+ Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash);
+ PL_compiling.cop_hints_hash = NULL;
+ }
+
SAVECOMPILEWARNINGS();
if (PL_dowarn & G_WARN_ALL_ON)
PL_compiling.cop_warnings = pWARN_ALL ;
/* switch to eval mode */
PUSHBLOCK(cx, CXt_EVAL, SP);
- PUSHEVAL(cx, name, NULL);
+ PUSHEVAL(cx, name);
cx->blk_eval.retop = PL_op->op_next;
SAVECOPLINE(&PL_compiling);
return op;
}
+/* This is a op added to hold the hints hash for
+ pp_entereval. The hash can be modified by the code
+ being eval'ed, so we return a copy instead. */
+
+PP(pp_hintseval)
+{
+ dVAR;
+ dSP;
+ mXPUSHs((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv));
+ RETURN;
+}
+
+
PP(pp_entereval)
{
dVAR; dSP;
runcv = find_runcv(&seq);
PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
- PUSHEVAL(cx, 0, NULL);
+ PUSHEVAL(cx, 0);
cx->blk_eval.retop = PL_op->op_next;
/* prepare to compile string */
}
else {
LEAVE;
- if (!(save_flags & OPf_SPECIAL))
- sv_setpvn(ERRSV,"",0);
+ if (!(save_flags & OPf_SPECIAL)) {
+ CLEAR_ERRSV();
+ }
}
RETURNOP(retop);
SAVETMPS;
PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
- PUSHEVAL(cx, 0, 0);
+ PUSHEVAL(cx, 0);
PL_in_eval = EVAL_INEVAL;
if (flags & G_KEEPERR)
PL_in_eval |= EVAL_KEEPERR;
else
- sv_setpvn(ERRSV,"",0);
+ CLEAR_ERRSV();
if (flags & G_FAKINGEVAL) {
PL_eval_root = PL_op; /* Only needed so that goto works right. */
}
PL_curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
- sv_setpvn(ERRSV,"",0);
+ CLEAR_ERRSV();
RETURN;
}
{
dVAR;
PMOP *matcher = (PMOP *) newPMOP(OP_MATCH, OPf_WANT_SCALAR | OPf_STACKED);
+
+ PERL_ARGS_ASSERT_MAKE_MATCHER;
+
PM_SETRE(matcher, ReREFCNT_inc(re));
-
+
SAVEFREEOP((OP *) matcher);
ENTER; SAVETMPS;
SAVEOP();
{
dVAR;
dSP;
+
+ PERL_ARGS_ASSERT_MATCHER_MATCHES_SV;
PL_op = (OP *) matcher;
XPUSHs(sv);
S_destroy_matcher(pTHX_ PMOP *matcher)
{
dVAR;
+
+ PERL_ARGS_ASSERT_DESTROY_MATCHER;
PERL_UNUSED_ARG(matcher);
+
FREETMPS;
LEAVE;
}
&& (Other = d)) )
+# define SM_OBJECT ( \
+ (sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP)) \
+ || \
+ (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)) ) \
+
# define SM_OTHER_REF(type) \
(SvROK(Other) && SvTYPE(SvRV(Other)) == SVt_##type)
if (SvGMAGICAL(e))
e = sv_mortalcopy(e);
+ if (SM_OBJECT)
+ Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
+
if (SM_CV_NEP) {
I32 c;
bool unchopnum = FALSE;
int maxops = 12; /* FF_LINEMARK + FF_END + 10 (\0 without preceding \n) */
+ PERL_ARGS_ASSERT_DOPARSEFORM;
+
if (len == 0)
Perl_croak(aTHX_ "Null picture in formline");
bool read_from_cache = FALSE;
STRLEN umaxlen;
+ PERL_ARGS_ASSERT_RUN_USER_FILTER;
+
assert(maxlen >= 0);
umaxlen = maxlen;
static bool
S_path_is_absolute(const char *name)
{
+ PERL_ARGS_ASSERT_PATH_IS_ABSOLUTE;
+
if (PERL_FILE_IS_ABSOLUTE(name)
#ifdef MACOS_TRADITIONAL
|| (*name == ':')
https://perl5.git.perl.org / perl5.git / blobdiff