dSP; dPOPTOPssrl;
if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
- SV *temp;
- temp = left; left = right; right = temp;
+ SV * const temp = left;
+ left = right; right = temp;
}
if (PL_tainting && PL_tainted && !SvTAINTED(left))
TAINT_NOT;
+ if (PL_op->op_private & OPpASSIGN_CV_TO_GV) {
+ SV *cv = SvRV(left);
+ const U32 cv_type = SvTYPE(cv);
+ const U32 gv_type = SvTYPE(right);
+ bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM;
+
+ if (!got_coderef) {
+ assert(SvROK(cv));
+ }
+
+ /* Can do the optimisation if right (LVAUE) is not a typeglob,
+ left (RVALUE) is a reference to something, and we're in void
+ context. */
+ if (!got_coderef && gv_type != SVt_PVGV && GIMME_V == G_VOID) {
+ /* Is the target symbol table currently empty? */
+ GV *gv = gv_fetchsv(right, GV_NOINIT, SVt_PVGV);
+ if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) {
+ /* Good. Create a new proxy constant subroutine in the target.
+ The gv becomes a(nother) reference to the constant. */
+ SV *const value = SvRV(cv);
+
+ SvUPGRADE((SV *)gv, SVt_RV);
+ SvROK_on(gv);
+ SvRV_set(gv, value);
+ SvREFCNT_inc(value);
+ SETs(right);
+ RETURN;
+ }
+ }
+
+ /* Need to fix things up. */
+ if (gv_type != SVt_PVGV) {
+ /* Need to fix GV. */
+ right = (SV*)gv_fetchsv(right, GV_ADD, SVt_PVGV);
+ }
+
+ 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(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;
+ }
+
+ }
SvSetMagicSV(right, left);
SETs(right);
RETURN;
right argument if we know the left is integer. */
SvIV_please(TOPm1s);
if (SvIOK(TOPm1s)) {
- bool auvok = SvUOK(TOPm1s);
- bool buvok = SvUOK(TOPs);
+ const bool auvok = SvUOK(TOPm1s);
+ const bool buvok = SvUOK(TOPs);
if (auvok == buvok) { /* ## IV == IV or UV == UV ## */
/* Casting IV to UV before comparison isn't going to matter
differ from normal zero. As I understand it. (Need to
check - is negative zero implementation defined behaviour
anyway?). NWC */
- UV buv = SvUVX(POPs);
- UV auv = SvUVX(TOPs);
+ const UV buv = SvUVX(POPs);
+ const UV auv = SvUVX(TOPs);
SETs(boolSV(auv == buv));
RETURN;
PP(pp_aelemfast)
{
dSP;
- AV *av = PL_op->op_flags & OPf_SPECIAL ?
+ AV * const av = PL_op->op_flags & OPf_SPECIAL ?
(AV*)PAD_SV(PL_op->op_targ) : GvAV(cGVOP_gv);
const U32 lval = PL_op->op_flags & OPf_MOD;
- SV** svp = av_fetch(av, PL_op->op_private, lval);
+ SV** const svp = av_fetch(av, PL_op->op_private, lval);
SV *sv = (svp ? *svp : &PL_sv_undef);
EXTEND(SP, 1);
if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */
PP(pp_print)
{
dVAR; dSP; dMARK; dORIGMARK;
- GV *gv;
IO *io;
register PerlIO *fp;
MAGIC *mg;
-
- if (PL_op->op_flags & OPf_STACKED)
- gv = (GV*)*++MARK;
- else
- gv = PL_defoutgv;
+ GV * const gv = (PL_op->op_flags & OPf_STACKED) ? (GV*)*++MARK : PL_defoutgv;
if (gv && (io = GvIO(gv))
&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
if ((PL_op->op_flags & OPf_SPECIAL) &&
!(PL_op->op_flags & OPf_MOD))
{
- gv = (GV*)gv_fetchsv(sv, FALSE, SVt_PVAV);
+ gv = (GV*)gv_fetchsv(sv, 0, SVt_PVAV);
if (!gv
&& (!is_gv_magical_sv(sv,0)
- || !(gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PVAV))))
+ || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVAV))))
{
RETSETUNDEF;
}
else {
if (PL_op->op_private & HINT_STRICT_REFS)
DIE(aTHX_ PL_no_symref_sv, sv, "an ARRAY");
- gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PVAV);
+ gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVAV);
}
}
else {
if ((PL_op->op_flags & OPf_SPECIAL) &&
!(PL_op->op_flags & OPf_MOD))
{
- gv = (GV*)gv_fetchsv(sv, FALSE, SVt_PVHV);
+ gv = (GV*)gv_fetchsv(sv, 0, SVt_PVHV);
if (!gv
&& (!is_gv_magical_sv(sv,0)
- || !(gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PVHV))))
+ || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVHV))))
{
RETSETUNDEF;
}
else {
if (PL_op->op_private & HINT_STRICT_REFS)
DIE(aTHX_ PL_no_symref_sv, sv, "a HASH");
- gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PVHV);
+ gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVHV);
}
}
else {
if ((global = dynpm->op_pmflags & PMf_GLOBAL)) {
rx->startp[0] = -1;
if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
- MAGIC* mg = mg_find(TARG, PERL_MAGIC_regex_global);
+ MAGIC* const mg = mg_find(TARG, PERL_MAGIC_regex_global);
if (mg && mg->mg_len >= 0) {
if (!(rx->reganch & ROPT_GPOS_SEEN))
rx->endp[0] = rx->startp[0] = mg->mg_len;
continue;
}
} else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */
- const U8 *s = (const U8*)SvPVX_const(sv) + offset;
+ const U8 * const s = (const U8*)SvPVX_const(sv) + offset;
const STRLEN len = SvCUR(sv) - offset;
const U8 *f;
dSP;
HE* he;
SV **svp;
- SV *keysv = POPs;
- HV *hv = (HV*)POPs;
+ SV * const keysv = POPs;
+ HV * const hv = (HV*)POPs;
const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
SV *sv;
RETPUSHNO;
if (SvMAGICAL(av) || AvREIFY(av)) {
- SV ** const svp = av_fetch(av, cx->blk_loop.iterix--, FALSE);
+ SV * const * const svp = av_fetch(av, --cx->blk_loop.iterix, FALSE);
sv = svp ? *svp : Nullsv;
}
else {
- sv = AvARRAY(av)[cx->blk_loop.iterix--];
+ sv = AvARRAY(av)[--cx->blk_loop.iterix];
}
}
else {
RETPUSHNO;
if (SvMAGICAL(av) || AvREIFY(av)) {
- SV ** const svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
+ SV * const * const svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
sv = svp ? *svp : Nullsv;
}
else {
{
dVAR; dSP; dPOPss;
GV *gv;
- HV *stash;
register CV *cv;
register PERL_CONTEXT *cx;
I32 gimme;
switch (SvTYPE(sv)) {
/* This is overwhelming the most common case: */
case SVt_PVGV:
- if (!(cv = GvCVu((GV*)sv)))
- cv = sv_2cv(sv, &stash, &gv, FALSE);
+ if (!(cv = GvCVu((GV*)sv))) {
+ HV *stash;
+ cv = sv_2cv(sv, &stash, &gv, 0);
+ }
if (!cv) {
ENTER;
SAVETMPS;
retry:
if (!CvROOT(cv) && !CvXSUB(cv)) {
- goto fooey;
+ GV* autogv;
+ SV* sub_name;
+
+ /* anonymous or undef'd function leaves us no recourse */
+ if (CvANON(cv) || !(gv = CvGV(cv)))
+ DIE(aTHX_ "Undefined subroutine called");
+
+ /* autoloaded stub? */
+ if (cv != GvCV(gv)) {
+ cv = GvCV(gv);
+ }
+ /* should call AUTOLOAD now? */
+ else {
+try_autoload:
+ if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
+ FALSE)))
+ {
+ cv = GvCV(autogv);
+ }
+ /* sorry */
+ else {
+ sub_name = sv_newmortal();
+ gv_efullname3(sub_name, gv, Nullch);
+ DIE(aTHX_ "Undefined subroutine &%"SVf" called", sub_name);
+ }
+ }
+ if (!cv)
+ DIE(aTHX_ "Not a CODE reference");
+ goto retry;
}
gimme = GIMME_V;
LEAVE;
return NORMAL;
}
-
- /*NOTREACHED*/
- assert (0); /* Cannot get here. */
- /* This is deliberately moved here as spaghetti code to keep it out of the
- hot path. */
- {
- GV* autogv;
- SV* sub_name;
-
- fooey:
- /* anonymous or undef'd function leaves us no recourse */
- if (CvANON(cv) || !(gv = CvGV(cv)))
- DIE(aTHX_ "Undefined subroutine called");
-
- /* autoloaded stub? */
- if (cv != GvCV(gv)) {
- cv = GvCV(gv);
- }
- /* should call AUTOLOAD now? */
- else {
-try_autoload:
- if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
- FALSE)))
- {
- cv = GvCV(autogv);
- }
- /* sorry */
- else {
- sub_name = sv_newmortal();
- gv_efullname3(sub_name, gv, Nullch);
- DIE(aTHX_ "Undefined subroutine &%"SVf" called", sub_name);
- }
- }
- if (!cv)
- DIE(aTHX_ "Not a CODE reference");
- goto retry;
- }
}
void
if (!SvOK(sv) ||
!(packname) ||
- !(iogv = gv_fetchsv(sv, FALSE, SVt_PVIO)) ||
+ !(iogv = gv_fetchsv(sv, 0, SVt_PVIO)) ||
!(ob=(SV*)GvIO(iogv)))
{
/* this isn't the name of a filehandle either */
projects / p5sagit/p5-mst-13.2.git / blobdiff