SV * const temp = left;
left = right; right = temp;
}
- else if (PL_op->op_private & OPpASSIGN_STATE) {
- if (SvPADSTALE(right))
- SvPADSTALE_off(right);
- else {
- (void)POPs;
- PUSHs(right);
- RETURN; /* ignore assignment */
- }
- }
if (PL_tainting && PL_tainted && !SvTAINTED(left))
TAINT_NOT;
if (PL_op->op_private & OPpASSIGN_CV_TO_GV) {
if (!got_coderef) {
/* We've been returned a constant rather than a full subroutine,
but they expect a subroutine reference to apply. */
- ENTER;
- SvREFCNT_inc_void(SvRV(cv));
- /* newCONSTSUB takes a reference count on the passed in SV
- from us. We set the name to NULL, otherwise we get into
- all sorts of fun as the reference to our new sub is
- donated to the GV that we're about to assign to.
- */
- SvRV_set(left, (SV *)newCONSTSUB(GvSTASH(right), NULL,
+ if (SvROK(cv)) {
+ ENTER;
+ SvREFCNT_inc_void(SvRV(cv));
+ /* newCONSTSUB takes a reference count on the passed in SV
+ from us. We set the name to NULL, otherwise we get into
+ all sorts of fun as the reference to our new sub is
+ donated to the GV that we're about to assign to.
+ */
+ SvRV_set(left, (SV *)newCONSTSUB(GvSTASH(right), NULL,
SvRV(cv)));
- SvREFCNT_dec(cv);
- LEAVE;
- }
+ SvREFCNT_dec(cv);
+ LEAVE;
+ } else {
+ /* What can happen for the corner case *{"BONK"} = \&{"BONK"};
+ is that
+ First: ops for \&{"BONK"}; return us the constant in the
+ symbol table
+ Second: ops for *{"BONK"} cause that symbol table entry
+ (and our reference to it) to be upgraded from RV
+ to typeblob)
+ Thirdly: We get here. cv is actually PVGV now, and its
+ GvCV() is actually the subroutine we're looking for
+
+ So change the reference so that it points to the subroutine
+ of that typeglob, as that's what they were after all along.
+ */
+ GV *const upgraded = (GV *) cv;
+ CV *const source = GvCV(upgraded);
+
+ assert(source);
+ assert(CvFLAGS(source) & CVf_CONST);
- if (strEQ(GvNAME(right),"isa")) {
- GvCVGEN(right) = 0;
- ++PL_sub_generation;
+ SvREFCNT_inc_void(source);
+ SvREFCNT_dec(upgraded);
+ SvRV_set(left, (SV *)source);
+ }
}
+
}
SvSetMagicSV(right, left);
SETs(right);
--SP;
RETURNOP(cLOGOP->op_other);
}
- } else if (op_type == OP_DEFINED) {
+ }
+ else {
+ /* OP_DEFINED */
sv = POPs;
if (!sv || !SvANY(sv))
RETPUSHNO;
- } else
- DIE(aTHX_ "panic: Invalid op (%s) in pp_defined()", OP_NAME(PL_op));
+ }
defined = FALSE;
switch (SvTYPE(sv)) {
int duplicates = 0;
SV **firsthashrelem = NULL; /* "= 0" keeps gcc 2.95 quiet */
- if (PL_op->op_private & OPpASSIGN_STATE) {
- if (SvPADSTALE(*firstlelem))
- SvPADSTALE_off(*firstlelem);
- else
- RETURN; /* ignore assignment */
- }
-
PL_delaymagic = DM_DELAY; /* catch simultaneous items */
gimme = GIMME_V;
}
TAINT_NOT;
}
+ if (PL_delaymagic & DM_ARRAY)
+ SvSETMAGIC((SV*)ary);
break;
case SVt_PVHV: { /* normal hash */
SV *tmpstr;
while (relem <= SP)
*relem++ = (lelem <= lastlelem) ? *lelem++ : &PL_sv_undef;
}
+
RETURN;
}
dVAR; dSP;
register PMOP * const pm = cPMOP;
REGEXP * rx = PM_GETRE(pm);
- SV * const pkg = CALLREG_QRPKG(rx);
+ SV * const pkg = CALLREG_PACKAGE(rx);
SV * const rv = sv_newmortal();
SV * const sv = newSVrv(rv, SvPV_nolen(pkg));
if (rx->extflags & RXf_TAINTED)
}
}
}
- /* remove comment to get faster /g but possibly unsafe $1 vars after a
- match. Test for the unsafe vars will fail as well*/
- if (( /* !global && */ rx->nparens)
+ /* XXX: comment out !global get safe $1 vars after a
+ match, BUT be aware that this leads to dramatic slowdowns on
+ /g matches against large strings. So far a solution to this problem
+ appears to be quite tricky.
+ Test for the unsafe vars are TODO for now. */
+ if (( !global && rx->nparens)
|| SvTEMP(TARG) || PL_sawampersand ||
(rx->extflags & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)))
r_flags |= REXEC_COPY_STR;
register PERL_CONTEXT *cx;
SPAGAIN;
PUSHSUBST(cx);
- RETURNOP(cPMOP->op_pmreplroot);
+ RETURNOP(cPMOP->op_pmreplrootu.op_pmreplroot);
}
r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
do {
gimme = GIMME_V;
if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv)) {
- if (CvASSERTION(cv) && PL_DBassertion)
- sv_setiv(PL_DBassertion, 1);
-
Perl_get_db_sub(aTHX_ &sv, cv);
if (CvISXSUB(cv))
PL_curcopdb = PL_curcop;
packsv = sv;
else {
SV* const ref = newSViv(PTR2IV(stash));
- hv_store(PL_stashcache, packname, packlen, ref, 0);
+ (void)hv_store(PL_stashcache, packname, packlen, ref, 0);
}
goto fetch;
}
if (he) {
gv = (GV*)HeVAL(he);
if (isGV(gv) && GvCV(gv) &&
- (!GvCVGEN(gv) || GvCVGEN(gv) == PL_sub_generation))
+ (!GvCVGEN(gv) || GvCVGEN(gv)
+ == (PL_sub_generation + HvMROMETA(stash)->cache_gen)))
return (SV*)GvCV(gv);
}
}
projects / p5sagit/p5-mst-13.2.git / blobdiff