PP(pp_const)
{
- djSP;
+ dSP;
XPUSHs(cSVOP_sv);
RETURN;
}
PP(pp_gvsv)
{
- djSP;
+ dSP;
EXTEND(SP,1);
if (PL_op->op_private & OPpLVAL_INTRO)
PUSHs(save_scalar(cGVOP_gv));
PP(pp_stringify)
{
- djSP; dTARGET;
+ dSP; dTARGET;
STRLEN len;
char *s;
s = SvPV(TOPs,len);
PP(pp_gv)
{
- djSP;
+ dSP;
XPUSHs((SV*)cGVOP_gv);
RETURN;
}
PP(pp_and)
{
- djSP;
+ dSP;
if (!SvTRUE(TOPs))
RETURN;
else {
PP(pp_sassign)
{
- djSP; dPOPTOPssrl;
+ dSP; dPOPTOPssrl;
if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
SV *temp;
PP(pp_cond_expr)
{
- djSP;
+ dSP;
if (SvTRUEx(POPs))
RETURNOP(cLOGOP->op_other);
else
PP(pp_concat)
{
- djSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
{
dPOPTOPssrl;
SV* rcopy = Nullsv;
if (TARG != left)
sv_setsv(TARG, left);
+#if defined(PERL_Y2KWARN)
+ if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_Y2K) && SvOK(TARG)) {
+ STRLEN n;
+ char *s = SvPV(TARG,n);
+ if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
+ && (n == 2 || !isDIGIT(s[n-3])))
+ {
+ Perl_warner(aTHX_ WARN_Y2K, "Possible Y2K bug: %s",
+ "about to append an integer to '19'");
+ }
+ }
+#endif
+
if (TARG == right) {
if (left == right) {
/* $right = $right . $right; */
sv_catsv(TARG, right);
}
-#if defined(PERL_Y2KWARN)
- if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_Y2K)) {
- STRLEN n;
- char *s = SvPV(TARG,n);
- if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
- && (n == 2 || !isDIGIT(s[n-3])))
- {
- Perl_warner(aTHX_ WARN_Y2K, "Possible Y2K bug: %s",
- "about to append an integer to '19'");
- }
- }
-#endif
-
SETTARG;
RETURN;
}
PP(pp_padsv)
{
- djSP; dTARGET;
+ dSP; dTARGET;
XPUSHs(TARG);
if (PL_op->op_flags & OPf_MOD) {
if (PL_op->op_private & OPpLVAL_INTRO)
PP(pp_eq)
{
- djSP; tryAMAGICbinSET(eq,0);
+ dSP; tryAMAGICbinSET(eq,0);
+#ifndef NV_PRESERVES_UV
+ if (SvROK(TOPs) && SvROK(TOPm1s)) {
+ SETs(boolSV(SvRV(TOPs) == SvRV(TOPm1s)));
+ RETURN;
+ }
+#endif
#ifdef PERL_PRESERVE_IVUV
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
- /* Unless the left argument is integer in range we are going to have to
- use NV maths. Hence only attempt to coerce the right argument if
- we know the left is integer. */
+ /* Unless the left argument is integer in range we are going
+ to have to use NV maths. Hence only attempt to coerce the
+ right argument if we know the left is integer. */
SvIV_please(TOPm1s);
if (SvIOK(TOPm1s)) {
bool auvok = SvUOK(TOPm1s);
PP(pp_preinc)
{
- djSP;
+ dSP;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
DIE(aTHX_ PL_no_modify);
if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
PP(pp_or)
{
- djSP;
+ dSP;
if (SvTRUE(TOPs))
RETURN;
else {
PP(pp_add)
{
- djSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN);
+ dSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN);
useleft = USE_LEFT(TOPm1s);
#ifdef PERL_PRESERVE_IVUV
/* We must see if we can perform the addition with integers if possible,
A side effect is that this also aggressively prefers integer maths over
fp maths for integer values.
- How to detect overflow?
+ How to detect overflow?
C 99 section 6.2.6.1 says
UV result;
register UV buv;
bool buvok = SvUOK(TOPs);
-
+
if (buvok)
buv = SvUVX(TOPs);
else {
PP(pp_aelemfast)
{
- djSP;
+ dSP;
AV *av = GvAV(cGVOP_gv);
U32 lval = PL_op->op_flags & OPf_MOD;
SV** svp = av_fetch(av, PL_op->op_private, lval);
PP(pp_join)
{
- djSP; dMARK; dTARGET;
+ dSP; dMARK; dTARGET;
MARK++;
do_join(TARG, *MARK, MARK, SP);
SP = MARK;
PP(pp_pushre)
{
- djSP;
+ dSP;
#ifdef DEBUGGING
/*
* We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
PP(pp_print)
{
- djSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
GV *gv;
IO *io;
register PerlIO *fp;
gv = (GV*)*++MARK;
else
gv = PL_defoutgv;
- if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
+ if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
had_magic:
if (MARK == ORIGMARK) {
/* If using default handle then we need to make space to
RETURN;
}
if (!(io = GvIO(gv))) {
- if ((GvEGV(gv)) && (mg = SvTIED_mg((SV*)GvEGV(gv),'q')))
+ if ((GvEGV(gv))
+ && (mg = SvTIED_mg((SV*)GvEGV(gv), PERL_MAGIC_tiedscalar)))
goto had_magic;
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
PP(pp_rv2av)
{
- djSP; dTOPss;
+ dSP; dTOPss;
AV *av;
if (SvROK(sv)) {
PP(pp_rv2hv)
{
- djSP; dTOPss;
+ dSP; dTOPss;
HV *hv;
if (SvROK(sv)) {
PP(pp_aassign)
{
- djSP;
+ dSP;
SV **lastlelem = PL_stack_sp;
SV **lastrelem = PL_stack_base + POPMARK;
SV **firstrelem = PL_stack_base + POPMARK + 1;
PP(pp_qr)
{
- djSP;
+ dSP;
register PMOP *pm = cPMOP;
SV *rv = sv_newmortal();
SV *sv = newSVrv(rv, "Regexp");
- sv_magic(sv,(SV*)ReREFCNT_inc(pm->op_pmregexp),'r',0,0);
+ sv_magic(sv,(SV*)ReREFCNT_inc(pm->op_pmregexp), PERL_MAGIC_qr,0,0);
RETURNX(PUSHs(rv));
}
PP(pp_match)
{
- djSP; dTARG;
+ dSP; dTARG;
register PMOP *pm = cPMOP;
register char *t;
register char *s;
if ((global = pm->op_pmflags & PMf_GLOBAL)) {
rx->startp[0] = -1;
if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
- MAGIC* mg = mg_find(TARG, 'g');
+ MAGIC* 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;
}
}
}
- if ((gimme != G_ARRAY && !global && rx->nparens)
+ if ((!global && rx->nparens)
|| SvTEMP(TARG) || PL_sawampersand)
r_flags |= REXEC_COPY_STR;
if (SvSCREAM(TARG))
}
if (rx->reganch & RE_USE_INTUIT &&
DO_UTF8(TARG) == ((rx->reganch & ROPT_UTF8) != 0)) {
+ PL_bostr = truebase;
s = CALLREG_INTUIT_START(aTHX_ rx, TARG, s, strend, r_flags, NULL);
if (!s)
if (global) {
MAGIC* mg = 0;
if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
- mg = mg_find(TARG, 'g');
+ mg = mg_find(TARG, PERL_MAGIC_regex_global);
if (!mg) {
- sv_magic(TARG, (SV*)0, 'g', Nullch, 0);
- mg = mg_find(TARG, 'g');
+ sv_magic(TARG, (SV*)0, PERL_MAGIC_regex_global, Nullch, 0);
+ mg = mg_find(TARG, PERL_MAGIC_regex_global);
}
if (rx->startp[0] != -1) {
mg->mg_len = rx->endp[0];
ret_no:
if (global && !(pm->op_pmflags & PMf_CONTINUE)) {
if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
- MAGIC* mg = mg_find(TARG, 'g');
+ MAGIC* mg = mg_find(TARG, PERL_MAGIC_regex_global);
if (mg)
mg->mg_len = -1;
}
I32 gimme = GIMME_V;
MAGIC *mg;
- if ((mg = SvTIED_mg((SV*)PL_last_in_gv, 'q'))) {
+ if ((mg = SvTIED_mg((SV*)PL_last_in_gv, PERL_MAGIC_tiedscalar))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)PL_last_in_gv, mg));
PUTBACK;
}
else if (type == OP_GLOB)
SP--;
- else if (ckWARN(WARN_IO) /* stdout/stderr or other write fh */
- && (IoTYPE(io) == IoTYPE_WRONLY || fp == PerlIO_stdout()
- || fp == PerlIO_stderr()))
+ else if (ckWARN(WARN_IO) && IoTYPE(io) == IoTYPE_WRONLY) {
report_evil_fh(PL_last_in_gv, io, OP_phoney_OUTPUT_ONLY);
+ }
}
if (!fp) {
if (ckWARN2(WARN_GLOB, WARN_CLOSED)
|| (IoFLAGS(io) & IOf_NOLINE) || !RsSNARF(rs))
for (;;) {
+ PUTBACK;
if (!sv_gets(sv, fp, offset)
&& (type == OP_GLOB || SNARF_EOF(gimme, PL_rs, io, sv)))
{
}
if (gimme == G_SCALAR) {
(void)SvOK_off(TARG);
+ SPAGAIN;
PUSHTARG;
}
MAYBE_TAINT_LINE(io, sv);
IoLINES(io)++;
IoFLAGS(io) |= IOf_NOLINE;
SvSETMAGIC(sv);
+ SPAGAIN;
XPUSHs(sv);
if (type == OP_GLOB) {
char *tmps;
PP(pp_enter)
{
- djSP;
+ dSP;
register PERL_CONTEXT *cx;
I32 gimme = OP_GIMME(PL_op, -1);
PP(pp_helem)
{
- djSP;
+ dSP;
HE* he;
SV **svp;
SV *keysv = POPs;
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
LvTYPE(lv) = 'y';
- sv_magic(lv, key2 = newSVsv(keysv), 'y', Nullch, 0);
+ sv_magic(lv, key2 = newSVsv(keysv), PERL_MAGIC_defelem, Nullch, 0);
SvREFCNT_dec(key2); /* sv_magic() increments refcount */
LvTARG(lv) = SvREFCNT_inc(hv);
LvTARGLEN(lv) = 1;
PP(pp_leave)
{
- djSP;
+ dSP;
register PERL_CONTEXT *cx;
register SV **mark;
SV **newsp;
PP(pp_iter)
{
- djSP;
+ dSP;
register PERL_CONTEXT *cx;
SV* sv;
AV* av;
SvREFCNT_dec(*itersvp);
- if ((sv = SvMAGICAL(av)
- ? *av_fetch(av, ++cx->blk_loop.iterix, FALSE)
- : AvARRAY(av)[++cx->blk_loop.iterix]))
+ if (SvMAGICAL(av) || AvREIFY(av)) {
+ SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
+ if (svp)
+ sv = *svp;
+ else
+ sv = Nullsv;
+ }
+ else {
+ sv = AvARRAY(av)[++cx->blk_loop.iterix];
+ }
+ if (sv)
SvTEMP_off(sv);
else
sv = &PL_sv_undef;
- if (av != PL_curstack && SvIMMORTAL(sv)) {
+ if (av != PL_curstack && sv == &PL_sv_undef) {
SV *lv = cx->blk_loop.iterlval;
if (lv && SvREFCNT(lv) > 1) {
SvREFCNT_dec(lv);
lv = cx->blk_loop.iterlval = NEWSV(26, 0);
sv_upgrade(lv, SVt_PVLV);
LvTYPE(lv) = 'y';
- sv_magic(lv, Nullsv, 'y', Nullch, 0);
+ sv_magic(lv, Nullsv, PERL_MAGIC_defelem, Nullch, 0);
}
LvTARG(lv) = SvREFCNT_inc(av);
LvTARGOFF(lv) = cx->blk_loop.iterix;
PP(pp_subst)
{
- djSP; dTARG;
+ dSP; dTARG;
register PMOP *pm = cPMOP;
PMOP *rpm = pm;
register SV *dstr;
}
orig = m = s;
if (rx->reganch & RE_USE_INTUIT) {
+ PL_bostr = orig;
s = CALLREG_INTUIT_START(aTHX_ rx, TARG, s, strend, r_flags, NULL);
if (!s)
PP(pp_grepwhile)
{
- djSP;
+ dSP;
if (SvTRUEx(POPs))
PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr];
PP(pp_leavesub)
{
- djSP;
+ dSP;
SV **mark;
SV **newsp;
PMOP *newpm;
* get any slower by more conditions */
PP(pp_leavesublv)
{
- djSP;
+ dSP;
SV **mark;
SV **newsp;
PMOP *newpm;
PP(pp_entersub)
{
- djSP; dPOPss;
+ dSP; dPOPss;
GV *gv;
HV *stash;
register CV *cv;
PP(pp_aelem)
{
- djSP;
+ dSP;
SV** svp;
SV* elemsv = POPs;
IV elem = SvIV(elemsv);
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
LvTYPE(lv) = 'y';
- sv_magic(lv, Nullsv, 'y', Nullch, 0);
+ sv_magic(lv, Nullsv, PERL_MAGIC_defelem, Nullch, 0);
LvTARG(lv) = SvREFCNT_inc(av);
LvTARGOFF(lv) = elem;
LvTARGLEN(lv) = 1;
PP(pp_method)
{
- djSP;
+ dSP;
SV* sv = TOPs;
if (SvROK(sv)) {
PP(pp_method_named)
{
- djSP;
+ dSP;
SV* sv = cSVOP->op_sv;
U32 hash = SvUVX(sv);
Perl_croak(aTHX_ "Can't call method \"%s\" on an undefined value", name);
if (SvGMAGICAL(sv))
- mg_get(sv);
+ mg_get(sv);
if (SvROK(sv))
ob = (SV*)SvRV(sv);
else {
GV* iogv;
+ /* this isn't a reference */
packname = Nullch;
if (!SvOK(sv) ||
!(packname = SvPV(sv, packlen)) ||
!(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
!(ob=(SV*)GvIO(iogv)))
{
+ /* this isn't the name of a filehandle either */
if (!packname ||
((UTF8_IS_START(*packname) && DO_UTF8(sv))
? !isIDFIRST_utf8((U8*)packname)
SvOK(sv) ? "without a package or object reference"
: "on an undefined value");
}
- stash = gv_stashpvn(packname, packlen, TRUE);
+ /* assume it's a package name */
+ stash = gv_stashpvn(packname, packlen, FALSE);
goto fetch;
}
+ /* it _is_ a filehandle name -- replace with a reference */
*(PL_stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv));
}
+ /* if we got here, ob should be a reference or a glob */
if (!ob || !(SvOBJECT(ob)
|| (SvTYPE(ob) == SVt_PVGV && (ob = (SV*)GvIO((GV*)ob))
&& SvOBJECT(ob))))
stash = SvSTASH(ob);
fetch:
+ /* NOTE: stash may be null, hope hv_fetch_ent and
+ gv_fetchmethod can cope (it seems they can) */
+
/* shortcut for simple names */
if (hashp) {
HE* he = hv_fetch_ent(stash, meth, 0, *hashp);
}
gv = gv_fetchmethod(stash, name);
+
if (!gv) {
+ /* This code tries to figure out just what went wrong with
+ gv_fetchmethod. It therefore needs to duplicate a lot of
+ the internals of that function. We can't move it inside
+ Perl_gv_fetchmethod_autoload(), however, since that would
+ cause UNIVERSAL->can("NoSuchPackage::foo") to croak, and we
+ don't want that.
+ */
char* leaf = name;
char* sep = Nullch;
char* p;
- GV* gv;
for (p = name; *p; p++) {
if (*p == '\'')
sep = p, leaf = p + 2;
}
if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
- packname = sep ? CopSTASHPV(PL_curcop) : HvNAME(stash);
+ /* the method name is unqualified or starts with SUPER:: */
+ packname = sep ? CopSTASHPV(PL_curcop) :
+ stash ? HvNAME(stash) : packname;
packlen = strlen(packname);
}
else {
+ /* the method name is qualified */
packname = name;
packlen = sep - name;
}
- gv = gv_fetchpv(packname, 0, SVt_PVHV);
- if (gv && isGV(gv)) {
+
+ /* we're relying on gv_fetchmethod not autovivifying the stash */
+ if (gv_stashpvn(packname, packlen, FALSE)) {
Perl_croak(aTHX_
- "Can't locate object method \"%s\" via package \"%s\"",
- leaf, packname);
+ "Can't locate object method \"%s\" via package \"%.*s\"",
+ leaf, (int)packlen, packname);
}
else {
Perl_croak(aTHX_
- "Can't locate object method \"%s\" via package \"%s\""
- " (perhaps you forgot to load \"%s\"?)",
- leaf, packname, packname);
+ "Can't locate object method \"%s\" via package \"%.*s\""
+ " (perhaps you forgot to load \"%.*s\"?)",
+ leaf, (int)packlen, packname, (int)packlen, packname);
}
}
return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv;
projects / p5sagit/p5-mst-13.2.git / blobdiff