/* pp_hot.c
*
- * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
+ * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
dVAR;
tryAMAGICunTARGET(iter, 0);
PL_last_in_gv = (GV*)(*PL_stack_sp--);
- if (SvTYPE(PL_last_in_gv) != SVt_PVGV) {
- if (SvROK(PL_last_in_gv) && SvTYPE(SvRV(PL_last_in_gv)) == SVt_PVGV)
+ if (!isGV_with_GP(PL_last_in_gv)) {
+ if (SvROK(PL_last_in_gv) && isGV_with_GP(SvRV(PL_last_in_gv)))
PL_last_in_gv = (GV*)SvRV(PL_last_in_gv);
else {
dSP;
PP(pp_preinc)
{
dVAR; dSP;
- if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
+ if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
DIE(aTHX_ PL_no_modify);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MAX)
else {
GV *gv;
- if (SvTYPE(sv) != SVt_PVGV) {
+ if (!isGV_with_GP(sv)) {
if (SvGMAGICAL(sv)) {
mg_get(sv);
if (SvROK(sv))
*(relem++) = sv;
didstore = av_store(ary,i++,sv);
if (magic) {
- if (SvSMAGICAL(sv))
+ if (SvSMAGICAL(sv)) {
+ /* More magic can happen in the mg_set callback, so we
+ * backup the delaymagic for now. */
+ U16 dmbak = PL_delaymagic;
+ PL_delaymagic = 0;
mg_set(sv);
+ PL_delaymagic = dmbak;
+ }
if (!didstore)
sv_2mortal(sv);
}
duplicates += 2;
didstore = hv_store_ent(hash,sv,tmpstr,0);
if (magic) {
- if (SvSMAGICAL(tmpstr))
+ if (SvSMAGICAL(tmpstr)) {
+ U16 dmbak = PL_delaymagic;
+ PL_delaymagic = 0;
mg_set(tmpstr);
+ PL_delaymagic = dmbak;
+ }
if (!didstore)
sv_2mortal(tmpstr);
}
}
else
sv_setsv(sv, &PL_sv_undef);
- SvSETMAGIC(sv);
+
+ if (SvSMAGICAL(sv)) {
+ U16 dmbak = PL_delaymagic;
+ PL_delaymagic = 0;
+ mg_set(sv);
+ PL_delaymagic = dmbak;
+ }
break;
}
}
if (pkg) {
HV* const stash = gv_stashpv(SvPV_nolen(pkg), GV_ADD);
+ SvREFCNT_dec(pkg);
(void)sv_bless(rv, stash);
}
switch (SvTYPE(sv)) {
/* This is overwhelming the most common case: */
case SVt_PVGV:
+ if (!isGV_with_GP(sv))
+ DIE(aTHX_ "Not a CODE reference");
if (!(cv = GvCVu((GV*)sv))) {
HV *stash;
cv = sv_2cv(sv, &stash, &gv, 0);
/* 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))
+ || (SvTYPE(ob) == SVt_PVGV
+ && isGV_with_GP(ob)
+ && (ob = (SV*)GvIO((GV*)ob))
&& SvOBJECT(ob))))
{
Perl_croak(aTHX_ "Can't call method \"%s\" on unblessed reference",
}
}
- gv = gv_fetchmethod(stash ? stash : (HV*)packsv, 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.
- */
- const char* leaf = name;
- const char* sep = NULL;
- const 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))) {
- /* the method name is unqualified or starts with SUPER:: */
-#ifndef USE_ITHREADS
- if (sep)
- stash = CopSTASH(PL_curcop);
-#else
- bool need_strlen = 1;
- if (sep) {
- packname = CopSTASHPV(PL_curcop);
- }
- else
-#endif
- if (stash) {
- HEK * const packhek = HvNAME_HEK(stash);
- if (packhek) {
- packname = HEK_KEY(packhek);
- packlen = HEK_LEN(packhek);
-#ifdef USE_ITHREADS
- need_strlen = 0;
-#endif
- } else {
- goto croak;
- }
- }
+ gv = gv_fetchmethod_flags(stash ? stash : (HV*)packsv, name,
+ GV_AUTOLOAD | GV_CROAK);
- if (!packname) {
- croak:
- Perl_croak(aTHX_
- "Can't use anonymous symbol table for method lookup");
- }
-#ifdef USE_ITHREADS
- if (need_strlen)
- packlen = strlen(packname);
-#endif
+ assert(gv);
- }
- else {
- /* the method name is qualified */
- packname = name;
- packlen = sep - name;
- }
-
- /* we're relying on gv_fetchmethod not autovivifying the stash */
- if (gv_stashpvn(packname, packlen, 0)) {
- Perl_croak(aTHX_
- "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, (int)packlen, packname, (int)packlen, packname);
- }
- }
return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff