PP(pp_gvsv)
{
djSP;
- EXTEND(sp,1);
+ EXTEND(SP,1);
if (op->op_private & OPpLVAL_INTRO)
PUSHs(save_scalar(cGVOP->op_gv));
else
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;
}
}
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:
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) {
}
}
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)) {
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");
s = SvPV(TARG, len);
if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
force_on_match = 1;
+ rxtainted = tainted << 1;
TAINT_NOT;
force_it:
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);
+ TAINT_IF(rxtainted);
if (SvSMAGICAL(TARG)) {
PUTBACK;
mg_set(TARG);
s = SvPV_force(TARG, len);
goto force_it;
}
- rxtainted = RX_MATCH_TAINTED(rx);
+ rxtainted |= RX_MATCH_TAINTED(rx);
dstr = NEWSV(25, len);
sv_setpvn(dstr, m, s-m);
curpm = pm;
} 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);
- SPAGAIN;
- PUSHs(sv_2mortal(newSViv((I32)iters)));
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;
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);
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))(THIS_ cv);
+ (void)(*CvXSUB(cv))(cv _PERL_OBJECT_THIS);
/* Enforce some sanity in scalar context. */
if (gimme == G_SCALAR && ++markix != stack_sp - stack_base ) {
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 ;
}
}
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