PP(pp_gvsv)
{
djSP;
- EXTEND(sp,1);
+ EXTEND(SP,1);
if (op->op_private & OPpLVAL_INTRO)
PUSHs(save_scalar(cGVOP->op_gv));
else
if (op->op_flags & OPf_MOD) {
if (op->op_private & OPpLVAL_INTRO)
SAVECLEARSV(curpad[op->op_targ]);
- else if (op->op_private & OPpDEREF)
+ else if (op->op_private & OPpDEREF) {
+ PUTBACK;
vivify_ref(curpad[op->op_targ], op->op_private & OPpDEREF);
+ SPAGAIN;
+ }
}
RETURN;
}
djSP;
AV *av = GvAV((GV*)cSVOP->op_sv);
SV** svp = av_fetch(av, op->op_private, op->op_flags & OPf_MOD);
+ EXTEND(SP, 1);
PUSHs(svp ? *svp : &sv_undef);
RETURN;
}
gv = (GV*)*++MARK;
else
gv = defoutgv;
- if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+ if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
if (MARK == ORIGMARK) {
+ /* If using default handle then we need to make space to
+ * pass object as 1st arg, so move other args up ...
+ */
MEXTEND(SP, 1);
++MARK;
Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
if (GIMME == G_ARRAY) {
I32 maxarg = AvFILL(av) + 1;
- EXTEND(SP, maxarg);
- Copy(AvARRAY(av), SP+1, maxarg, SV*);
+ EXTEND(SP, maxarg);
+ if (SvRMAGICAL(av)) {
+ U32 i;
+ for (i=0; i < maxarg; i++) {
+ SV **svp = av_fetch(av, i, FALSE);
+ SP[i+1] = (svp) ? *svp : &sv_undef;
+ }
+ }
+ else {
+ Copy(AvARRAY(av), SP+1, maxarg, SV*);
+ }
SP += maxarg;
}
else {
}
TAINT_NOT;
}
- if (relem == lastrelem && dowarn)
- warn("Odd number of elements in hash list");
+ if (relem == lastrelem && dowarn) {
+ if (relem == firstrelem &&
+ SvROK(*relem) &&
+ ( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
+ SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
+ warn("Reference found where even-sized list expected");
+ else
+ warn("Odd number of elements in hash assignment");
+ }
}
break;
default:
if (delaymagic & DM_UID) {
if (uid != euid)
DIE("No setreuid available");
- (void)setuid(uid);
+ (void)PerlProc_setuid(uid);
}
# endif /* HAS_SETREUID */
#endif /* HAS_SETRESUID */
- uid = (int)getuid();
- euid = (int)geteuid();
+ uid = (int)PerlProc_getuid();
+ euid = (int)PerlProc_geteuid();
}
if (delaymagic & DM_GID) {
#ifdef HAS_SETRESGID
if (delaymagic & DM_GID) {
if (gid != egid)
DIE("No setregid available");
- (void)setgid(gid);
+ (void)PerlProc_setgid(gid);
}
# endif /* HAS_SETREGID */
#endif /* HAS_SETRESGID */
- gid = (int)getgid();
- egid = (int)getegid();
+ gid = (int)PerlProc_getgid();
+ egid = (int)PerlProc_getegid();
}
tainting |= (uid && (euid != uid || egid != gid));
}
DIE("panic: do_match");
TAINT_NOT;
- if (pm->op_pmflags & PMf_USED) {
+ if (pm->op_pmdynflags & PMdf_USED) {
failure:
if (gimme == G_ARRAY)
RETURN;
{
curpm = pm;
if (pm->op_pmflags & PMf_ONCE)
- pm->op_pmflags |= PMf_USED;
+ pm->op_pmdynflags |= PMdf_USED;
goto gotcha;
}
else
++BmUSEFUL(rx->check_substr);
curpm = pm;
if (pm->op_pmflags & PMf_ONCE)
- pm->op_pmflags |= PMf_USED;
+ pm->op_pmdynflags |= PMdf_USED;
Safefree(rx->subbase);
rx->subbase = Nullch;
if (global) {
I32 gimme = GIMME_V;
MAGIC *mg;
- if (SvMAGICAL(last_in_gv) && (mg = mg_find((SV*)last_in_gv, 'q'))) {
+ if (SvRMAGICAL(last_in_gv) && (mg = mg_find((SV*)last_in_gv, 'q'))) {
PUSHMARK(SP);
XPUSHs(mg->mg_obj);
PUTBACK;
}
}
if ((tmpfp = PerlIO_open(tmpfnam,"w+","fop=dlt")) != NULL) {
- ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
+ Stat_t st;
+ if (!PerlLIO_stat(SvPVX(tmpglob),&st) && S_ISDIR(st.st_mode))
+ ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX(tmpglob),vmsspec)) != NULL);
+ else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
&dfltdsc,NULL,NULL,NULL))&1)) {
if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
break;
- if (*tmps && Stat(SvPVX(sv), &statbuf) < 0) {
+ if (*tmps && PerlLIO_stat(SvPVX(sv), &statbuf) < 0) {
(void)POPs; /* Unmatched wildcard? Chuck it... */
continue;
}
ENTER;
SAVETMPS;
- PUSHBLOCK(cx, CXt_BLOCK, sp);
+ PUSHBLOCK(cx, CXt_BLOCK, SP);
RETURN;
}
if (HvNAME(hv) && isGV(*svp))
save_gp((GV*)*svp, !(op->op_flags & OPf_SPECIAL));
else
- save_svref(svp);
+ save_helem(hv, keysv, svp);
}
else if (op->op_private & OPpDEREF)
vivify_ref(*svp, op->op_private & OPpDEREF);
SV* sv;
AV* av;
- EXTEND(sp, 1);
+ EXTEND(SP, 1);
cx = &cxstack[cxstack_ix];
if (cx->cx_type != CXt_LOOP)
DIE("panic: pp_iter");
SvREFCNT_dec(*cx->blk_loop.itervar);
- if (sv = AvARRAY(av)[++cx->blk_loop.iterix])
+ if (sv = (SvMAGICAL(av))
+ ? *av_fetch(av, ++cx->blk_loop.iterix, FALSE)
+ : AvARRAY(av)[++cx->blk_loop.iterix])
SvTEMP_off(sv);
else
sv = &sv_undef;
else {
TARG = DEFSV;
EXTEND(SP,1);
- }
+ }
if (SvREADONLY(TARG)
|| (SvTYPE(TARG) > SVt_PVLV
&& !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))
croak(no_modify);
+ PUTBACK;
+
s = SvPV(TARG, len);
if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
force_on_match = 1;
+ rxtainted = tainted << 1;
TAINT_NOT;
force_it:
if (c && clen <= rx->minlen && (once || !(safebase & REXEC_COPY_STR))
&& !(rx->reganch & ROPT_LOOKBEHIND_SEEN)) {
if (!regexec_flags(rx, s, strend, orig, 0, screamer, NULL, safebase)) {
+ SPAGAIN;
PUSHs(&sv_no);
LEAVE_SCOPE(oldsave);
RETURN;
curpm = pm;
SvSCREAM_off(TARG); /* disable possible screamer */
if (once) {
- rxtainted = RX_MATCH_TAINTED(rx);
+ rxtainted |= RX_MATCH_TAINTED(rx);
if (rx->subbase) {
m = orig + (rx->startp[0] - rx->subbase);
d = orig + (rx->endp[0] - rx->subbase);
else {
sv_chop(TARG, d);
}
- TAINT_IF(rxtainted);
+ TAINT_IF(rxtainted & 1);
+ SPAGAIN;
PUSHs(&sv_yes);
}
else {
- rxtainted = 0;
do {
if (iters++ > maxiters)
DIE("Substitution loop");
SvCUR_set(TARG, d - SvPVX(TARG) + i);
Move(s, d, i+1, char); /* include the NUL */
}
- TAINT_IF(rxtainted);
+ TAINT_IF(rxtainted & 1);
+ SPAGAIN;
PUSHs(sv_2mortal(newSViv((I32)iters)));
}
(void)SvPOK_only(TARG);
- SvSETMAGIC(TARG);
+ TAINT_IF(rxtainted);
+ if (SvSMAGICAL(TARG)) {
+ PUTBACK;
+ mg_set(TARG);
+ SPAGAIN;
+ }
SvTAINT(TARG);
LEAVE_SCOPE(oldsave);
RETURN;
s = SvPV_force(TARG, len);
goto force_it;
}
- rxtainted = RX_MATCH_TAINTED(rx);
- dstr = NEWSV(25, sv_len(TARG));
+ rxtainted |= RX_MATCH_TAINTED(rx);
+ dstr = NEWSV(25, len);
sv_setpvn(dstr, m, s-m);
curpm = pm;
if (!c) {
register PERL_CONTEXT *cx;
+ SPAGAIN;
PUSHSUBST(cx);
RETURNOP(cPMOP->op_pmreplroot);
}
} while (regexec_flags(rx, s, strend, orig, s == m, Nullsv, NULL, safebase));
sv_catpvn(dstr, s, strend - s);
- TAINT_IF(rxtainted);
-
(void)SvOOK_off(TARG);
Safefree(SvPVX(TARG));
SvPVX(TARG) = SvPVX(dstr);
SvPVX(dstr) = 0;
sv_free(dstr);
+ TAINT_IF(rxtainted & 1);
+ SPAGAIN;
+ PUSHs(sv_2mortal(newSViv((I32)iters)));
+
(void)SvPOK_only(TARG);
+ TAINT_IF(rxtainted);
SvSETMAGIC(TARG);
SvTAINT(TARG);
- PUSHs(sv_2mortal(newSViv((I32)iters)));
LEAVE_SCOPE(oldsave);
RETURN;
}
nope:
++BmUSEFUL(rx->check_substr);
-ret_no:
+ret_no:
+ SPAGAIN;
PUSHs(&sv_no);
LEAVE_SCOPE(oldsave);
RETURN;
LEAVE; /* exit inner scope */
/* All done yet? */
- if (stack_base + *markstack_ptr > sp) {
+ if (stack_base + *markstack_ptr > SP) {
I32 items;
I32 gimme = GIMME_V;
return pop_return();
}
-static CV *
+STATIC CV *
get_db_sub(SV **svp, CV *cv)
{
dTHR;
- SV *oldsv = *svp;
- GV *gv;
+ SV *dbsv = GvSV(DBsub);
+
+ if (!PERLDB_SUB_NN) {
+ GV *gv = CvGV(cv);
- *svp = GvSV(DBsub);
- save_item(*svp);
- gv = CvGV(cv);
- if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
- || strEQ(GvNAME(gv), "END")
- || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
- !( (SvTYPE(oldsv) == SVt_PVGV) && (GvCV((GV*)oldsv) == cv)
- && (gv = (GV*)oldsv) ))) {
- /* Use GV from the stack as a fallback. */
- /* GV is potentially non-unique, or contain different CV. */
- sv_setsv(*svp, newRV((SV*)cv));
+ save_item(dbsv);
+ if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
+ || strEQ(GvNAME(gv), "END")
+ || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
+ !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv)
+ && (gv = (GV*)*svp) ))) {
+ /* Use GV from the stack as a fallback. */
+ /* GV is potentially non-unique, or contain different CV. */
+ sv_setsv(dbsv, newRV((SV*)cv));
+ }
+ else {
+ gv_efullname3(dbsv, gv, Nullch);
+ }
}
else {
- gv_efullname3(*svp, gv, Nullch);
+ SvUPGRADE(dbsv, SVt_PVIV);
+ SvIOK_on(dbsv);
+ SAVEIV(SvIVX(dbsv));
+ SvIVX(dbsv) = (IV)cv; /* Do it the quickest way */
}
- cv = GvCV(DBsub);
+
if (CvXSUB(cv))
curcopdb = curcop;
+ cv = GvCV(DBsub);
return cv;
}
* (3) instead of (2) so we'd have to clone. Would the fact
* that we released the mutex more quickly make up for this?
*/
- svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE);
- if (svp) {
+ if (threadnum &&
+ (svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE)))
+ {
/* We already have a clone to use */
MUTEX_UNLOCK(CvMUTEXP(cv));
cv = *(CV**)svp;
}
#endif /* USE_THREADS */
- gimme = GIMME;
-
if (CvXSUB(cv)) {
if (CvOLDSTYLE(cv)) {
I32 (*fp3)_((int,int,int));
dMARK;
register I32 items = SP - MARK;
/* We dont worry to copy from @_. */
- while (sp > mark) {
- sp[1] = sp[0];
- sp--;
+ while (SP > mark) {
+ SP[1] = SP[0];
+ SP--;
}
stack_sp = mark + 1;
fp3 = (I32(*)_((int,int,int)))CvXSUB(cv);
#else
av = GvAV(defgv);
#endif /* USE_THREADS */
- items = AvFILL(av) + 1;
+ items = AvFILLp(av) + 1; /* @_ is not tieable */
if (items) {
/* Mark is at the end of the stack. */
- EXTEND(sp, items);
- Copy(AvARRAY(av), sp + 1, items, SV*);
- sp += items;
+ EXTEND(SP, items);
+ Copy(AvARRAY(av), SP + 1, items, SV*);
+ SP += items;
PUTBACK ;
}
}
curcopdb = NULL;
}
/* Do we need to open block here? XXXX */
- (void)(*CvXSUB(cv))(cv);
+ (void)(*CvXSUB(cv))(cv _PERL_OBJECT_THIS);
/* Enforce some sanity in scalar context. */
if (gimme == G_SCALAR && ++markix != stack_sp - stack_base ) {
if (CvDEPTH(cv) == 100 && dowarn
&& !(PERLDB_SUB && cv == GvCV(DBsub)))
sub_crush_depth(cv);
- if (CvDEPTH(cv) > AvFILL(padlist)) {
+ if (CvDEPTH(cv) > AvFILLp(padlist)) {
AV *av;
AV *newpad = newAV();
SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
- I32 ix = AvFILL((AV*)svp[1]);
+ I32 ix = AvFILLp((AV*)svp[1]);
svp = AvARRAY(svp[0]);
for ( ;ix > 0; ix--) {
if (svp[ix] != &sv_undef) {
av_store(newpad, 0, (SV*)av);
AvFLAGS(av) = AVf_REIFY;
av_store(padlist, CvDEPTH(cv), (SV*)newpad);
- AvFILL(padlist) = CvDEPTH(cv);
+ AvFILLp(padlist) = CvDEPTH(cv);
svp = AvARRAY(padlist);
}
}
if (!hasargs) {
AV* av = (AV*)curpad[0];
- items = AvFILL(av) + 1;
+ items = AvFILLp(av) + 1;
if (items) {
/* Mark is at the end of the stack. */
- EXTEND(sp, items);
- Copy(AvARRAY(av), sp + 1, items, SV*);
- sp += items;
+ EXTEND(SP, items);
+ Copy(AvARRAY(av), SP + 1, items, SV*);
+ SP += items;
PUTBACK ;
}
}
}
}
Copy(MARK,AvARRAY(av),items,SV*);
- AvFILL(av) = items - 1;
+ AvFILLp(av) = items - 1;
while (items--) {
if (*MARK)
RETURN;
}
if (op->op_private & OPpLVAL_INTRO)
- save_svref(svp);
+ save_aelem(av, elem, svp);
else if (op->op_private & OPpDEREF)
vivify_ref(*svp, op->op_private & OPpDEREF);
}
}
switch (to_what) {
case OPpDEREF_SV:
- SvRV(sv) = newSV(0);
+ SvRV(sv) = NEWSV(355,0);
break;
case OPpDEREF_AV:
SvRV(sv) = (SV*)newAV();
https://perl5.git.perl.org / perl5.git / blobdiff