PP(pp_readline)
{
+ tryAMAGICunTARGET(iter, 0);
PL_last_in_gv = (GV*)(*PL_stack_sp--);
+ if (PL_op->op_flags & OPf_SPECIAL) { /* Are called as <$var> */
+ if (SvROK(PL_last_in_gv)) {
+ if (SvTYPE(SvRV(PL_last_in_gv)) != SVt_PVGV)
+ goto hard_way;
+ PL_last_in_gv = (GV*)SvRV(PL_last_in_gv);
+ } else if (SvTYPE(PL_last_in_gv) != SVt_PVGV) {
+ hard_way: {
+ dSP;
+ XPUSHs((SV*)PL_last_in_gv);
+ PUTBACK;
+ pp_rv2gv(ARGS);
+ PL_last_in_gv = (GV*)(*PL_stack_sp--);
+ }
+ }
+ }
return do_readline();
}
{
djSP;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
- croak(no_modify);
+ croak(PL_no_modify);
if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
SvIVX(TOPs) != IV_MAX)
{
gv = (GV*)*++MARK;
else
gv = PL_defoutgv;
- if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+ if (mg = SvTIED_mg((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 ...
++SP;
}
PUSHMARK(MARK - 1);
- *MARK = mg->mg_obj;
+ *MARK = SvTIED_obj((SV*)gv, mg);
PUTBACK;
ENTER;
perl_call_method("PRINT", G_SCALAR);
PP(pp_rv2av)
{
- djSP; dPOPss;
+ djSP; dTOPss;
AV *av;
if (SvROK(sv)) {
wasref:
+ tryAMAGICunDEREF(to_av);
+
av = (AV*)SvRV(sv);
if (SvTYPE(av) != SVt_PVAV)
DIE("Not an ARRAY reference");
if (PL_op->op_flags & OPf_REF) {
- PUSHs((SV*)av);
+ SETs((SV*)av);
RETURN;
}
}
if (SvTYPE(sv) == SVt_PVAV) {
av = (AV*)sv;
if (PL_op->op_flags & OPf_REF) {
- PUSHs((SV*)av);
+ SETs((SV*)av);
RETURN;
}
}
if (!SvOK(sv)) {
if (PL_op->op_flags & OPf_REF ||
PL_op->op_private & HINT_STRICT_REFS)
- DIE(no_usym, "an ARRAY");
+ DIE(PL_no_usym, "an ARRAY");
if (ckWARN(WARN_UNINITIALIZED))
- warner(WARN_UNINITIALIZED, warn_uninit);
- if (GIMME == G_ARRAY)
+ warner(WARN_UNINITIALIZED, PL_warn_uninit);
+ if (GIMME == G_ARRAY) {
+ POPs;
RETURN;
- RETPUSHUNDEF;
+ }
+ RETSETUNDEF;
}
sym = SvPV(sv,PL_na);
if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(no_symref, sym, "an ARRAY");
+ DIE(PL_no_symref, sym, "an ARRAY");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
} else {
gv = (GV*)sv;
if (PL_op->op_private & OPpLVAL_INTRO)
av = save_ary(gv);
if (PL_op->op_flags & OPf_REF) {
- PUSHs((SV*)av);
+ SETs((SV*)av);
RETURN;
}
}
if (GIMME == G_ARRAY) {
I32 maxarg = AvFILL(av) + 1;
+ POPs; /* XXXX May be optimized away? */
EXTEND(SP, maxarg);
if (SvRMAGICAL(av)) {
U32 i;
else {
dTARGET;
I32 maxarg = AvFILL(av) + 1;
- PUSHi(maxarg);
+ SETi(maxarg);
}
RETURN;
}
if (SvROK(sv)) {
wasref:
+ tryAMAGICunDEREF(to_hv);
+
hv = (HV*)SvRV(sv);
if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV)
DIE("Not a HASH reference");
if (!SvOK(sv)) {
if (PL_op->op_flags & OPf_REF ||
PL_op->op_private & HINT_STRICT_REFS)
- DIE(no_usym, "a HASH");
+ DIE(PL_no_usym, "a HASH");
if (ckWARN(WARN_UNINITIALIZED))
- warner(WARN_UNINITIALIZED, warn_uninit);
+ warner(WARN_UNINITIALIZED, PL_warn_uninit);
if (GIMME == G_ARRAY) {
SP--;
RETURN;
}
sym = SvPV(sv,PL_na);
if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(no_symref, sym, "a HASH");
+ DIE(PL_no_symref, sym, "a HASH");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
} else {
gv = (GV*)sv;
* clobber a value on the right that's used later in the list.
*/
if (PL_op->op_private & OPpASSIGN_COMMON) {
+ EXTEND_MORTAL(lastrelem - firstrelem + 1);
for (relem = firstrelem; relem <= lastrelem; relem++) {
/*SUPPRESS 560*/
if (sv = *relem) {
if (SvTHINKFIRST(sv)) {
if (SvREADONLY(sv) && PL_curcop != &PL_compiling) {
if (!SvIMMORTAL(sv))
- DIE(no_modify);
+ DIE(PL_no_modify);
if (relem <= lastrelem)
relem++;
break;
djSP;
register PMOP *pm = cPMOP;
SV *rv = sv_newmortal();
- SV *sv = newSVrv(rv, "Regexp");
+ SV *sv = newSVrv(rv, "re");
sv_magic(sv,(SV*)ReREFCNT_inc(pm->op_pmregexp),'r',0,0);
RETURNX(PUSHs(rv));
}
register char *s;
char *strend;
I32 global;
- I32 safebase;
+ I32 r_flags;
char *truebase;
register REGEXP *rx = pm->op_pmregexp;
bool rxtainted;
I32 minmatch = 0;
I32 oldsave = PL_savestack_ix;
I32 update_minmatch = 1;
- SV *screamer;
if (PL_op->op_flags & OPf_STACKED)
TARG = POPs;
}
if (rx->minlen > len) goto failure;
- screamer = ( (SvSCREAM(TARG) && rx->check_substr
- && SvTYPE(rx->check_substr) == SVt_PVBM
- && SvVALID(rx->check_substr))
- ? TARG : Nullsv);
truebase = t = s;
if (global = pm->op_pmflags & PMf_GLOBAL) {
rx->startp[0] = 0;
}
}
}
- safebase = ((gimme != G_ARRAY && !global && rx->nparens)
+ r_flags = ((gimme != G_ARRAY && !global && rx->nparens)
|| SvTEMP(TARG) || PL_sawampersand)
? REXEC_COPY_STR : 0;
+ if (SvSCREAM(TARG) && rx->check_substr
+ && SvTYPE(rx->check_substr) == SVt_PVBM
+ && SvVALID(rx->check_substr))
+ r_flags |= REXEC_SCREAM;
+
if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
SAVEINT(PL_multiline);
PL_multiline = pm->op_pmflags & PMf_MULTILINE;
}
if (rx->check_substr) {
if (!(rx->reganch & ROPT_NOSCAN)) { /* Floating checkstring. */
- if ( screamer ) {
+ if (r_flags & REXEC_SCREAM) {
I32 p = -1;
char *b;
rx->float_substr = Nullsv;
}
}
- if (CALLREGEXEC(rx, s, strend, truebase, minmatch,
- screamer, NULL, safebase))
+ if (CALLREGEXEC(rx, s, strend, truebase, minmatch, TARG, NULL, r_flags))
{
PL_curpm = pm;
if (pm->op_pmflags & PMf_ONCE)
I32 gimme = GIMME_V;
MAGIC *mg;
- if (SvRMAGICAL(PL_last_in_gv) && (mg = mg_find((SV*)PL_last_in_gv, 'q'))) {
+ if (mg = SvTIED_mg((SV*)PL_last_in_gv, 'q')) {
PUSHMARK(SP);
- XPUSHs(mg->mg_obj);
+ XPUSHs(SvTIED_obj((SV*)PL_last_in_gv, mg));
PUTBACK;
ENTER;
perl_call_method("READLINE", gimme);
SV* lv;
SV* key2;
if (!defer)
- DIE(no_helem, SvPV(keysv, PL_na));
+ DIE(PL_no_helem, SvPV(keysv, PL_na));
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
LvTYPE(lv) = 'y';
bool once;
bool rxtainted;
char *orig;
- I32 safebase;
+ I32 r_flags;
register REGEXP *rx = pm->op_pmregexp;
STRLEN len;
int force_on_match = 0;
I32 oldsave = PL_savestack_ix;
I32 update_minmatch = 1;
- SV *screamer;
/* known replacement string? */
dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
if (SvREADONLY(TARG)
|| (SvTYPE(TARG) > SVt_PVLV
&& !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))
- croak(no_modify);
+ croak(PL_no_modify);
PUTBACK;
s = SvPV(TARG, len);
pm = PL_curpm;
rx = pm->op_pmregexp;
}
- screamer = ( (SvSCREAM(TARG) && rx->check_substr
- && SvTYPE(rx->check_substr) == SVt_PVBM
- && SvVALID(rx->check_substr))
- ? TARG : Nullsv);
- safebase = (rx->nparens || SvTEMP(TARG) || PL_sawampersand)
+ r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand)
? REXEC_COPY_STR : 0;
+ if (SvSCREAM(TARG) && rx->check_substr
+ && SvTYPE(rx->check_substr) == SVt_PVBM
+ && SvVALID(rx->check_substr))
+ r_flags |= REXEC_SCREAM;
if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
SAVEINT(PL_multiline);
PL_multiline = pm->op_pmflags & PMf_MULTILINE;
orig = m = s;
if (rx->check_substr) {
if (!(rx->reganch & ROPT_NOSCAN)) { /* It floats. */
- if (screamer) {
+ if (r_flags & REXEC_SCREAM) {
I32 p = -1;
char *b;
c = dstr ? SvPV(dstr, clen) : Nullch;
/* can do inplace substitution? */
- if (c && clen <= rx->minlen && (once || !(safebase & REXEC_COPY_STR))
+ if (c && clen <= rx->minlen && (once || !(r_flags & REXEC_COPY_STR))
&& !(rx->reganch & ROPT_LOOKBEHIND_SEEN)) {
- if (!CALLREGEXEC(rx, s, strend, orig, 0, screamer, NULL, safebase)) {
+ if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL, r_flags)) {
SPAGAIN;
PUSHs(&PL_sv_no);
LEAVE_SCOPE(oldsave);
RETURN;
}
- if (CALLREGEXEC(rx, s, strend, orig, 0, screamer, NULL, safebase)) {
+ if (CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL, r_flags)) {
if (force_on_match) {
force_on_match = 0;
s = SvPV_force(TARG, len);
sv_catpvn(dstr, c, clen);
if (once)
break;
- } while (CALLREGEXEC(rx, s, strend, orig, s == m, Nullsv, NULL, safebase));
+ } while (CALLREGEXEC(rx, s, strend, orig, s == m, Nullsv, NULL, r_flags));
sv_catpvn(dstr, s, strend - s);
(void)SvOOK_off(TARG);
else
sym = SvPV(sv, PL_na);
if (!sym)
- DIE(no_usym, "a subroutine");
+ DIE(PL_no_usym, "a subroutine");
if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(no_symref, sym, "a subroutine");
+ DIE(PL_no_symref, sym, "a subroutine");
cv = perl_get_cv(sym, TRUE);
break;
}
+ {
+ SV **sp = &sv; /* Used in tryAMAGICunDEREF macro. */
+ tryAMAGICunDEREF(to_cv);
+ }
cv = (CV*)SvRV(sv);
if (SvTYPE(cv) == SVt_PVCV)
break;
DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: pp_entersub lock %p\n",
thr, sv);)
MUTEX_UNLOCK(MgMUTEXP(mg));
- SvREFCNT_inc(sv); /* Keep alive until magic_mutexfree */
save_destructor(unlock_condpair, sv);
}
MUTEX_LOCK(CvMUTEXP(cv));
if (!svp || *svp == &PL_sv_undef) {
SV* lv;
if (!defer)
- DIE(no_aelem, elem);
+ DIE(PL_no_aelem, elem);
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
LvTYPE(lv) = 'y';
mg_get(sv);
if (!SvOK(sv)) {
if (SvREADONLY(sv))
- croak(no_modify);
+ croak(PL_no_modify);
if (SvTYPE(sv) < SVt_RV)
sv_upgrade(sv, SVt_RV);
else if (SvTYPE(sv) >= SVt_PV) {
!(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
!(ob=(SV*)GvIO(iogv)))
{
- if (!packname || !isIDFIRST(*packname))
+ if (!packname ||
+ ((*(U8*)packname >= 0xc0 && IN_UTF8)
+ ? !isIDFIRST_utf8((U8*)packname)
+ : !isIDFIRST(*packname)
+ ))
+ {
DIE("Can't call method \"%s\" %s", name,
SvOK(sv)? "without a package or object reference"
: "on an undefined value");
+ }
stash = gv_stashpvn(packname, packlen, TRUE);
goto fetch;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff