S_pushav(pTHX_ AV* const av)
{
dSP;
- const I32 maxarg = AvFILL(av) + 1;
+ const SSize_t maxarg = AvFILL(av) + 1;
EXTEND(SP, maxarg);
if (SvRMAGICAL(av)) {
- U32 i;
- for (i=0; i < (U32)maxarg; i++) {
+ PADOFFSET i;
+ for (i=0; i < (PADOFFSET)maxarg; i++) {
SV ** const svp = av_fetch(av, i, FALSE);
/* See note in pp_helem, and bug id #27839 */
SP[i+1] = svp
}
}
else {
- Copy(AvARRAY(av), SP+1, maxarg, SV*);
+ PADOFFSET i;
+ for (i=0; i < (PADOFFSET)maxarg; i++) {
+ SV * const sv = AvARRAY(av)[i];
+ SP[i+1] = sv ? sv : &PL_sv_undef;
+ }
}
SP += maxarg;
PUTBACK;
}
else if (gimme == G_SCALAR) {
dTARGET;
- const I32 maxarg = AvFILL(av) + 1;
+ const SSize_t maxarg = AvFILL(av) + 1;
SETi(maxarg);
}
} else {
I32 gimme;
HV *hash;
- I32 i;
+ SSize_t i;
int magic;
U32 lval = 0;
i = 0;
while (relem <= lastrelem) { /* gobble up all the rest */
SV **didstore;
- assert(*relem);
- SvGETMAGIC(*relem); /* before newSV, in case it dies */
+ if (*relem)
+ SvGETMAGIC(*relem); /* before newSV, in case it dies */
sv = newSV(0);
sv_setsv_nomg(sv, *relem);
*(relem++) = sv;
PMOP *dynpm = pm;
const char *s;
const char *strend;
- I32 curpos = 0; /* initial pos() or current $+[0] */
+ SSize_t curpos = 0; /* initial pos() or current $+[0] */
I32 global;
U8 r_flags = 0;
const char *truebase; /* Start of string */
STRLEN len;
const I32 oldsave = PL_savestack_ix;
I32 had_zerolen = 0;
+ MAGIC *mg = NULL;
if (PL_op->op_flags & OPf_STACKED)
TARG = POPs;
rx = PM_GETRE(pm);
}
- if (RX_MINLEN(rx) > (I32)len) {
- DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match\n"));
+ if (RX_MINLEN(rx) >= 0 && (STRLEN)RX_MINLEN(rx) > len) {
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match (%"
+ UVuf" < %"IVdf")\n",
+ (UV)len, (IV)RX_MINLEN(rx)));
goto nope;
}
/* get pos() if //g */
if (global) {
- MAGIC * const mg = mg_find_mglob(TARG);
+ mg = mg_find_mglob(TARG);
if (mg && mg->mg_len >= 0) {
- curpos = mg->mg_len;
+ curpos = MgBYTEPOS(mg, TARG, truebase, len);
/* last time pos() was set, it was zero-length match */
if (mg->mg_flags & MGf_MINMATCH)
had_zerolen = 1;
s = truebase;
play_it_again:
- if (global) {
+ if (global)
s = truebase + curpos;
- }
if (!CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase,
had_zerolen, TARG, NULL, r_flags))
goto nope;
PL_curpm = pm;
- if (dynpm->op_pmflags & PMf_ONCE) {
+ if (dynpm->op_pmflags & PMf_ONCE)
#ifdef USE_ITHREADS
SvREADONLY_on(PL_regex_pad[dynpm->op_pmoffset]);
#else
dynpm->op_pmflags |= PMf_USED;
#endif
- }
if (rxtainted)
RX_MATCH_TAINTED_on(rx);
/* update pos */
if (global && (gimme != G_ARRAY || (dynpm->op_pmflags & PMf_CONTINUE))) {
- MAGIC *mg = mg_find_mglob(TARG);
- if (!mg) {
+ if (!mg)
mg = sv_magicext_mglob(TARG);
- }
- assert(RX_OFFS(rx)[0].start != -1); /* XXX get rid of next line? */
- if (RX_OFFS(rx)[0].start != -1) {
- mg->mg_len = RX_OFFS(rx)[0].end;
- if (RX_ZERO_LEN(rx))
- mg->mg_flags |= MGf_MINMATCH;
- else
- mg->mg_flags &= ~MGf_MINMATCH;
- }
+ MgBYTEPOS_set(mg, TARG, truebase, RX_OFFS(rx)[0].end);
+ if (RX_ZERO_LEN(rx))
+ mg->mg_flags |= MGf_MINMATCH;
+ else
+ mg->mg_flags &= ~MGf_MINMATCH;
}
if ((!RX_NPARENS(rx) && !global) || gimme != G_ARRAY) {
nope:
if (global && !(dynpm->op_pmflags & PMf_CONTINUE)) {
- MAGIC* const mg = mg_find_mglob(TARG);
- if (mg)
- mg->mg_len = -1;
+ if (!mg)
+ mg = mg_find_mglob(TARG);
+ if (mg)
+ mg->mg_len = -1;
}
LEAVE_SCOPE(oldsave);
if (gimme == G_ARRAY)
}
if (!fp) {
if ((!io || !(IoFLAGS(io) & IOf_START))
- && ckWARN2(WARN_GLOB, WARN_CLOSED))
+ && ckWARN(WARN_CLOSED)
+ && type != OP_GLOB)
{
- if (type == OP_GLOB)
- Perl_ck_warner_d(aTHX_ packWARN(WARN_GLOB),
- "glob failed (can't start child: %s)",
- Strerror(errno));
- else
- report_evil_fh(PL_last_in_gv);
+ report_evil_fh(PL_last_in_gv);
}
if (gimme == G_SCALAR) {
/* undef TARG, and push that undefined value */
SvREFCNT_inc_simple_void_NN(sv);
}
}
+ else if (!av_is_stack) {
+ sv = newSVavdefelem(av, ix, 0);
+ }
else
sv = &PL_sv_undef;
- if (!av_is_stack && sv == &PL_sv_undef) {
- SV *lv = newSV_type(SVt_PVLV);
- LvTYPE(lv) = 'y';
- sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
- LvTARG(lv) = SvREFCNT_inc_simple(av);
- LvTARGOFF(lv) = ix;
- LvTARGLEN(lv) = (STRLEN)UV_MAX;
- sv = lv;
- }
-
oldsv = *itersvp;
*itersvp = sv;
SvREFCNT_dec(oldsv);
sv_force_normal_flags(TARG,0);
#endif
if (!(rpm->op_pmflags & PMf_NONDESTRUCT)
-#ifdef PERL_ANY_COW
- && !is_cow
-#endif
&& (SvREADONLY(TARG)
|| ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
|| SvTYPE(TARG) > SVt_PVLV)
&& !is_cow
#endif
&& (I32)clen <= RX_MINLENRET(rx)
- && (once || !(r_flags & REXEC_COPY_STR))
+ && ( once
+ || !(r_flags & REXEC_COPY_STR)
+ || (!SvGMAGICAL(dstr) && !(RX_EXTFLAGS(rx) & RXf_EVAL_SEEN))
+ )
&& !(RX_EXTFLAGS(rx) & RXf_NO_INPLACE_SUBST)
&& (!doutf8 || SvUTF8(TARG))
&& !(rpm->op_pmflags & PMf_NONDESTRUCT))
d += clen;
}
s = RX_OFFS(rx)[0].end + orig;
- } while (CALLREGEXEC(rx, s, strend, orig, s == m,
+ } while (CALLREGEXEC(rx, s, strend, orig,
+ s == m, /* don't match same null twice */
TARG, NULL,
- /* don't match same null twice */
REXEC_NOT_FIRST|REXEC_IGNOREPOS|REXEC_FAIL_ON_UNDERFLOW));
if (s != d) {
I32 i = strend - s;
PUTBACK;
LEAVE;
- cxstack_ix--;
POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
+ cxstack_ix--;
PL_curpm = newpm; /* ... and pop $1 et al */
LEAVESUB(sv);
if (!(CvISXSUB(cv))) {
/* This path taken at least 75% of the time */
dMARK;
- I32 items = SP - MARK;
+ SSize_t items = SP - MARK;
PADLIST * const padlist = CvPADLIST(cv);
PUSHBLOCK(cx, CXt_SUB, MARK);
PUSHSUB(cx);
RETURNOP(CvSTART(cv));
}
else {
- I32 markix = TOPMARK;
+ SSize_t markix = TOPMARK;
SAVETMPS;
PUTBACK;
!CvLVALUE(cv))
DIE(aTHX_ "Can't modify non-lvalue subroutine call");
- if (!hasargs) {
+ if (!hasargs && GvAV(PL_defgv)) {
/* Need to copy @_ to stack. Alternative may be to
* switch stack to @_, and copy return values
* back. This would allow popping @_ in XSUB, e.g.. XXXX */
AV * const av = GvAV(PL_defgv);
- const I32 items = AvFILLp(av) + 1; /* @_ is not tieable */
+ const SSize_t items = AvFILL(av) + 1;
if (items) {
+ SSize_t i = 0;
+ const bool m = cBOOL(SvRMAGICAL(av));
/* Mark is at the end of the stack. */
EXTEND(SP, items);
- Copy(AvARRAY(av), SP + 1, items, SV*);
+ for (; i < items; ++i)
+ {
+ SV *sv;
+ if (m) {
+ SV ** const svp = av_fetch(av, i, 0);
+ sv = svp ? *svp : NULL;
+ }
+ else sv = AvARRAY(av)[i];
+ if (sv) SP[i+1] = sv;
+ else {
+ SP[i+1] = newSVavdefelem(av, i, 1);
+ }
+ }
SP += items;
PUTBACK ;
}
}
+ else {
+ SV **mark = PL_stack_base + markix;
+ SSize_t items = SP - mark;
+ while (items--) {
+ mark++;
+ if (*mark && SvPADTMP(*mark) && !IS_PADGV(*mark))
+ *mark = sv_mortalcopy(*mark);
+ }
+ }
/* We assume first XSUB in &DB::sub is the called one. */
if (PL_curcopdb) {
SAVEVPTR(PL_curcop);
IV elem = SvIV(elemsv);
AV *const av = MUTABLE_AV(POPs);
const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
- const U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > av_len(av));
+ const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
bool preeminent = TRUE;
SV *sv;
MEM_WRAP_CHECK_1(elem,SV*,oom_array_extend);
}
#endif
- if (!svp || *svp == &PL_sv_undef) {
- SV* lv;
+ if (!svp || !*svp) {
+ IV len;
if (!defer)
DIE(aTHX_ PL_no_aelem, elem);
- lv = sv_newmortal();
- sv_upgrade(lv, SVt_PVLV);
- LvTYPE(lv) = 'y';
- sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
- LvTARG(lv) = SvREFCNT_inc_simple(av);
- LvTARGOFF(lv) = elem;
- LvTARGLEN(lv) = 1;
- PUSHs(lv);
+ len = av_len(av);
+ mPUSHs(newSVavdefelem(av,
+ /* Resolve a negative index now, unless it points before the
+ beginning of the array, in which case record it for error
+ reporting in magic_setdefelem. */
+ elem < 0 && len + elem >= 0 ? len + elem : elem,
+ 1));
RETURN;
}
if (localizing) {
https://perl5.git.perl.org / perl5.git / blobdiff