}
if (!rx->nparens && !global)
gimme = G_SCALAR; /* accidental array context? */
- safebase = (((gimme == G_ARRAY) || global) && !sawampersand);
+ safebase = (((gimme == G_ARRAY) || global || !rx->nparens)
+ && !sawampersand);
if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
SAVEINT(multiline);
multiline = pm->op_pmflags & PMf_MULTILINE;
play_it_again:
if (global && rx->startp[0]) {
t = s = rx->endp[0];
- if (s >= strend)
+ if ((s + rx->minlen) > strend)
goto nope;
if (update_minmatch++)
minmatch = (s == rx->startp[0]);
RETPUSHYES;
}
-static void
-leave_subst(p)
-void *p;
-{
- ((PMOP*)p)->op_private &= ~OPpLVAL_INTRO;
-}
-
PP(pp_subst)
{
dSP; dTARG;
force_on_match = 1;
TAINT_NOT;
- if (pm->op_private & OPpLVAL_INTRO)
- croak("Recursive substitution detected");
- if (!dstr) {
- SAVEDESTRUCTOR(leave_subst, pm);
- pm->op_private |= OPpLVAL_INTRO;
- }
-
force_it:
if (!pm || !s)
DIE("panic: do_subst");
c = dstr ? SvPV(dstr, clen) : Nullch;
/* can do inplace substitution? */
- if (c && clen <= rx->minlen) {
+ if (c && clen <= rx->minlen && safebase) {
if (! pregexec(rx, s, strend, orig, 0,
SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
PUSHs(&sv_no);
s = SvPV_force(TARG, len);
goto force_it;
}
- if (rx->subbase) /* oops, no we can't */
- goto long_way;
d = s;
curpm = pm;
SvSCREAM_off(TARG); /* disable possible screamer */
if (pregexec(rx, s, strend, orig, 0,
SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
- long_way:
if (force_on_match) {
force_on_match = 0;
s = SvPV_force(TARG, len);
SV* sv;
SV* ob;
GV* gv;
- SV* nm;
+ HV* stash;
+ char* name;
+ char* packname;
+ STRLEN packlen;
- nm = TOPs;
+ name = SvPV(TOPs, na);
sv = *(stack_base + TOPMARK + 1);
- gv = 0;
if (SvGMAGICAL(sv))
mg_get(sv);
if (SvROK(sv))
ob = (SV*)SvRV(sv);
else {
GV* iogv;
- char* packname = 0;
- STRLEN packlen;
+ packname = Nullch;
if (!SvOK(sv) ||
!(packname = SvPV(sv, packlen)) ||
!(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
!(ob=(SV*)GvIO(iogv)))
{
- char *name = SvPV(nm, na);
- HV *stash;
- if (!packname || !isALPHA(*packname))
-DIE("Can't call method \"%s\" without a package or object reference", name);
- if (!(stash = gv_stashpvn(packname, packlen, FALSE))) {
- if (gv_stashpvn("UNIVERSAL", 9, FALSE))
- stash = gv_stashpvn(packname, packlen, TRUE);
- else
- DIE("Can't call method \"%s\" in empty package \"%s\"",
- name, packname);
- }
- gv = gv_fetchmethod(stash,name);
- if (!gv)
- DIE("Can't locate object method \"%s\" via package \"%s\"",
- name, packname);
- SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv);
- RETURN;
+ if (!packname || !isIDFIRST(*packname))
+ DIE("Can't call method \"%s\" without a package or object reference", name);
+ stash = gv_stashpvn(packname, packlen, TRUE);
+ goto fetch;
}
*(stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv));
}
- if (!ob || !SvOBJECT(ob)) {
- char *name = SvPV(nm, na);
+ if (!ob || !SvOBJECT(ob))
DIE("Can't call method \"%s\" on unblessed reference", name);
- }
- if (!gv) { /* nothing cached */
- char *name = SvPV(nm, na);
- gv = gv_fetchmethod(SvSTASH(ob),name);
- if (!gv)
- DIE("Can't locate object method \"%s\" via package \"%s\"",
- name, HvNAME(SvSTASH(ob)));
- }
+ stash = SvSTASH(ob);
+
+ fetch:
+ gv = gv_fetchmethod(stash, name);
+ if (!gv) {
+ char* leaf = name;
+ char* sep = Nullch;
+ char* p;
+ for (p = name; *p; p++) {
+ if (*p == '\'')
+ sep = p, leaf = p + 1;
+ else if (*p == ':' && *(p + 1) == ':')
+ sep = p, leaf = p + 2;
+ }
+ if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
+ packname = HvNAME(sep ? curcop->cop_stash : stash);
+ packlen = strlen(packname);
+ }
+ else {
+ packname = name;
+ packlen = sep - name;
+ }
+ DIE("Can't locate object method \"%s\" via package \"%.*s\"",
+ leaf, (int)packlen, packname);
+ }
SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv);
RETURN;
}
-