}
/*
+=for apidoc sv_gmagical_2iv_please
+
+Used internally by C<SvIV_please_nomg>, this function sets the C<SvIVX>
+slot if C<sv_2iv> would have made the scalar C<SvIOK> had it not been
+magical. In that case it returns true.
+
+=cut
+*/
+
+bool
+Perl_sv_gmagical_2iv_please(pTHX_ register SV *sv)
+{
+ bool has_int;
+ PERL_ARGS_ASSERT_SV_GMAGICAL_2IV_PLEASE;
+ assert(SvGMAGICAL(sv) && !SvIOKp(sv) && (SvNOKp(sv) || SvPOKp(sv)));
+ if (S_sv_2iuv_common(aTHX_ sv)) { SvNIOK_off(sv); return 0; }
+ has_int = !!SvIOK(sv);
+ SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK);
+ return has_int;
+}
+
+/*
=for apidoc sv_2uv_flags
Return the unsigned integer value of an SV, doing any necessary string
|| amagic_is_enabled(string_amg)
)) {
REGEXP * const re = (REGEXP *)MUTABLE_PTR(referent);
- I32 seen_evals = 0;
assert(re);
else
SvUTF8_off(sv);
- if ((seen_evals = RX_SEEN_EVALS(re)))
- PL_reginterp_cnt += seen_evals;
-
if (lp)
*lp = RX_WRAPLEN(re);
}
*st = GvESTASH(gv);
if (lref & ~GV_ADDMG && !GvCVu(gv)) {
- SV *tmpsv;
- ENTER;
- tmpsv = newSV(0);
- gv_efullname3(tmpsv, gv, NULL);
/* XXX this is probably not what they think they're getting.
* It has the same effect as "sub name;", i.e. just a forward
* declaration! */
- newSUB(start_subparse(FALSE, 0),
- newSVOP(OP_CONST, 0, tmpsv),
- NULL, NULL);
- LEAVE;
- if (!GvCVu(gv))
- Perl_croak(aTHX_ "Unable to create sub named \"%"SVf"\"",
- SVfARG(SvOK(sv) ? sv : &PL_sv_no));
+ newSTUB(gv,0);
}
return GvCVu(gv);
}
Perl_croak(aTHX_ "Cloning substitution context is unimplemented");
}
else {
+ ncx->blk_oldcop = (COP*)any_dup(ncx->blk_oldcop, param->proto_perl);
switch (CxTYPE(ncx)) {
case CXt_SUB:
ncx->blk_sub.cv = (ncx->blk_sub.olddepth == 0
= pv_dup(old_state->re_state_reginput);
new_state->re_state_regeol
= pv_dup(old_state->re_state_regeol);
- new_state->re_state_regoffs
- = (regexp_paren_pair*)
- any_dup(old_state->re_state_regoffs, proto_perl);
- new_state->re_state_reglastparen
- = (U32*) any_dup(old_state->re_state_reglastparen,
- proto_perl);
- new_state->re_state_reglastcloseparen
- = (U32*)any_dup(old_state->re_state_reglastcloseparen,
- proto_perl);
- /* XXX This just has to be broken. The old save_re_context
- code did SAVEGENERICPV(PL_reg_start_tmp);
- PL_reg_start_tmp is char **.
- Look above to what the dup code does for
- SAVEt_GENERIC_PVREF
- It can never have worked.
- So this is merely a faithful copy of the exiting bug: */
- new_state->re_state_reg_start_tmp
- = (char **) pv_dup((char *)
- old_state->re_state_reg_start_tmp);
- /* I assume that it only ever "worked" because no-one called
- (pseudo)fork while the regexp engine had re-entered itself.
- */
#ifdef PERL_OLD_COPY_ON_WRITE
new_state->re_state_nrs
= sv_dup(old_state->re_state_nrs, param);
/* RE engine related */
Zero(&PL_reg_state, 1, struct re_save_state);
- PL_reginterp_cnt = 0;
PL_regmatch_slab = NULL;
PL_sub_generation = proto_perl->Isub_generation;