X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=622621f081c11f154d30de02136fb29ab4cda52b;hb=5c68b2270fe472528f2ba515730ec96ad933c2c1;hp=4ca41bbab473e4b96d1c9e724a7a02b93649f2d5;hpb=dfe13c55d349c8cc782995becdedd62551082672;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_hot.c b/pp_hot.c
index 4ca41bb..622621f 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -202,7 +202,23 @@ PP(pp_padsv)
 
 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();
 }
 
@@ -220,7 +236,7 @@ PP(pp_preinc)
 {
     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)
     {
@@ -306,12 +322,13 @@ PP(pp_print)
     IO *io;
     register PerlIO *fp;
     MAGIC *mg;
+    STRLEN n_a;
 
     if (PL_op->op_flags & OPf_STACKED)
 	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 ...
@@ -322,7 +339,7 @@ PP(pp_print)
 	    ++SP;
 	}
 	PUSHMARK(MARK - 1);
-	*MARK = mg->mg_obj;
+	*MARK = SvTIED_obj((SV*)gv, mg);
 	PUTBACK;
 	ENTER;
 	perl_call_method("PRINT", G_SCALAR);
@@ -337,7 +354,7 @@ PP(pp_print)
 	if (ckWARN(WARN_UNOPENED)) {
 	    SV* sv = sv_newmortal();
             gv_fullname3(sv, gv, Nullch);
-            warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,PL_na));
+            warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,n_a));
         }
 
 	SETERRNO(EBADF,RMS$_IFI);
@@ -349,10 +366,10 @@ PP(pp_print)
             gv_fullname3(sv, gv, Nullch);
 	    if (IoIFP(io))
 		warner(WARN_IO, "Filehandle %s opened only for input", 
-				SvPV(sv,PL_na));
+				SvPV(sv,n_a));
 	    else if (ckWARN(WARN_CLOSED))
 		warner(WARN_CLOSED, "print on closed filehandle %s", 
-				SvPV(sv,PL_na));
+				SvPV(sv,n_a));
 	}
 	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
 	goto just_say_no;
@@ -403,16 +420,18 @@ PP(pp_print)
 
 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;
 	}
     }
@@ -420,7 +439,7 @@ PP(pp_rv2av)
 	if (SvTYPE(sv) == SVt_PVAV) {
 	    av = (AV*)sv;
 	    if (PL_op->op_flags & OPf_REF) {
-		PUSHs((SV*)av);
+		SETs((SV*)av);
 		RETURN;
 	    }
 	}
@@ -429,6 +448,7 @@ PP(pp_rv2av)
 	    
 	    if (SvTYPE(sv) != SVt_PVGV) {
 		char *sym;
+		STRLEN n_a;
 
 		if (SvGMAGICAL(sv)) {
 		    mg_get(sv);
@@ -438,16 +458,18 @@ PP(pp_rv2av)
 		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) {
+			(void)POPs;
 			RETURN;
-		    RETPUSHUNDEF;
+		    }
+		    RETSETUNDEF;
 		}
-		sym = SvPV(sv,PL_na);
+		sym = SvPV(sv,n_a);
 		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;
@@ -456,7 +478,7 @@ PP(pp_rv2av)
 	    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;
 	    }
 	}
@@ -464,6 +486,7 @@ PP(pp_rv2av)
 
     if (GIMME == G_ARRAY) {
 	I32 maxarg = AvFILL(av) + 1;
+	(void)POPs;			/* XXXX May be optimized away? */
 	EXTEND(SP, maxarg);          
 	if (SvRMAGICAL(av)) {
 	    U32 i; 
@@ -480,7 +503,7 @@ PP(pp_rv2av)
     else {
 	dTARGET;
 	I32 maxarg = AvFILL(av) + 1;
-	PUSHi(maxarg);
+	SETi(maxarg);
     }
     RETURN;
 }
@@ -492,6 +515,8 @@ PP(pp_rv2hv)
 
     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");
@@ -513,6 +538,7 @@ PP(pp_rv2hv)
 	    
 	    if (SvTYPE(sv) != SVt_PVGV) {
 		char *sym;
+		STRLEN n_a;
 
 		if (SvGMAGICAL(sv)) {
 		    mg_get(sv);
@@ -522,18 +548,18 @@ PP(pp_rv2hv)
 		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;
 		    }
 		    RETSETUNDEF;
 		}
-		sym = SvPV(sv,PL_na);
+		sym = SvPV(sv,n_a);
 		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;
@@ -593,6 +619,7 @@ PP(pp_aassign)
      * 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) {
@@ -689,7 +716,7 @@ PP(pp_aassign)
 	    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;
@@ -808,7 +835,7 @@ PP(pp_match)
     register char *s;
     char *strend;
     I32 global;
-    I32 safebase;
+    I32 r_flags;
     char *truebase;
     register REGEXP *rx = pm->op_pmregexp;
     bool rxtainted;
@@ -817,7 +844,6 @@ PP(pp_match)
     I32 minmatch = 0;
     I32 oldsave = PL_savestack_ix;
     I32 update_minmatch = 1;
-    SV *screamer;
 
     if (PL_op->op_flags & OPf_STACKED)
 	TARG = POPs;
@@ -847,25 +873,29 @@ PP(pp_match)
     }
     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;
+
+    /* XXXX What part of this is needed with true \G-support? */
     if (global = pm->op_pmflags & PMf_GLOBAL) {
 	rx->startp[0] = 0;
 	if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
 	    MAGIC* mg = mg_find(TARG, 'g');
 	    if (mg && mg->mg_len >= 0) {
-		rx->endp[0] = rx->startp[0] = s + mg->mg_len; 
+		if (!(rx->reganch & ROPT_GPOS_SEEN))
+		    rx->endp[0] = rx->startp[0] = s + mg->mg_len; 
 		minmatch = (mg->mg_flags & MGf_MINMATCH);
 		update_minmatch = 0;
 	    }
 	}
     }
-    safebase = (((gimme == G_ARRAY) || global || !rx->nparens)
-		&& !PL_sawampersand);
-    safebase = safebase ? 0  : REXEC_COPY_STR ;
+    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;
@@ -881,7 +911,7 @@ play_it_again:
     }
     if (rx->check_substr) {
 	if (!(rx->reganch & ROPT_NOSCAN)) { /* Floating checkstring. */
-	    if ( screamer ) {
+	    if (r_flags & REXEC_SCREAM) {
 		I32 p = -1;
 		char *b;
 		
@@ -926,8 +956,7 @@ play_it_again:
 	    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)
@@ -967,6 +996,7 @@ play_it_again:
 	    if (rx->startp[0] && rx->startp[0] == rx->endp[0])
 		++rx->endp[0];
 	    PUTBACK;			/* EVAL blocks may use stack */
+	    r_flags |= REXEC_IGNOREPOS;
 	    goto play_it_again;
 	}
 	else if (!iters)
@@ -1055,9 +1085,9 @@ do_readline(void)
     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);
@@ -1258,8 +1288,12 @@ do_readline(void)
 		IoFLAGS(io) |= IOf_START;
 	    }
 	    else if (type == OP_GLOB) {
-		if (!do_close(PL_last_in_gv, FALSE))
-		    warn("internal error: glob failed");
+		if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_CLOSED)) {
+		    warner(WARN_CLOSED,
+			   "glob failed (child exited with status %d%s)",
+			   STATUS_CURRENT >> 8,
+			   (STATUS_CURRENT & 0x80) ? ", core dumped" : "");
+		}
 	    }
 	    if (gimme == G_SCALAR) {
 		(void)SvOK_off(TARG);
@@ -1362,8 +1396,10 @@ PP(pp_helem)
 	if (!svp || *svp == &PL_sv_undef) {
 	    SV* lv;
 	    SV* key2;
-	    if (!defer)
-		DIE(no_helem, SvPV(keysv, PL_na));
+	    if (!defer) {
+		STRLEN n_a;
+		DIE(PL_no_helem, SvPV(keysv, n_a));
+	    }
 	    lv = sv_newmortal();
 	    sv_upgrade(lv, SVt_PVLV);
 	    LvTYPE(lv) = 'y';
@@ -1461,7 +1497,7 @@ PP(pp_iter)
 
     EXTEND(SP, 1);
     cx = &cxstack[cxstack_ix];
-    if (cx->cx_type != CXt_LOOP)
+    if (CxTYPE(cx) != CXt_LOOP)
 	DIE("panic: pp_iter");
 
     av = cx->blk_loop.iterary;
@@ -1574,13 +1610,12 @@ PP(pp_subst)
     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;
@@ -1593,7 +1628,7 @@ PP(pp_subst)
     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);
@@ -1618,11 +1653,12 @@ PP(pp_subst)
 	pm = PL_curpm;
 	rx = pm->op_pmregexp;
     }
-    screamer = ( (SvSCREAM(TARG) && rx->check_substr
+    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)) 
-		? TARG : Nullsv);
-    safebase = (!rx->nparens && !PL_sawampersand) ? 0 : REXEC_COPY_STR;
+		  && 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;
@@ -1630,7 +1666,7 @@ PP(pp_subst)
     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;
 		
@@ -1677,9 +1713,9 @@ PP(pp_subst)
     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);
@@ -1779,7 +1815,7 @@ PP(pp_subst)
 	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);
@@ -1795,6 +1831,7 @@ PP(pp_subst)
 	    PUSHSUBST(cx);
 	    RETURNOP(cPMOP->op_pmreplroot);
 	}
+	r_flags |= REXEC_IGNOREPOS;
 	do {
 	    if (iters++ > maxiters)
 		DIE("Substitution loop");
@@ -1813,7 +1850,7 @@ PP(pp_subst)
 		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, TARG, NULL, r_flags));
 	sv_catpvn(dstr, s, strend - s);
 
 	(void)SvOOK_off(TARG);
@@ -1991,6 +2028,7 @@ PP(pp_entersub)
     default:
 	if (!SvROK(sv)) {
 	    char *sym;
+	    STRLEN n_a;
 
 	    if (sv == &PL_sv_yes) {		/* unfound import, ignore */
 		if (hasargs)
@@ -2002,14 +2040,18 @@ PP(pp_entersub)
 		sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
 	    }
 	    else
-		sym = SvPV(sv, PL_na);
+		sym = SvPV(sv, n_a);
 	    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;
@@ -2105,7 +2147,6 @@ PP(pp_entersub)
 	    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));
@@ -2140,8 +2181,7 @@ PP(pp_entersub)
      	 * (3) instead of (2) so we'd have to clone. Would the fact
      	 * that we released the mutex more quickly make up for this?
      	 */
-	if (PL_threadnum &&
-	    (svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE)))
+	if ((svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE)))
 	{
 	    /* We already have a clone to use */
 	    MUTEX_UNLOCK(CvMUTEXP(cv));
@@ -2268,12 +2308,14 @@ PP(pp_entersub)
 	PUSHBLOCK(cx, CXt_SUB, MARK);
 	PUSHSUB(cx);
 	CvDEPTH(cv)++;
+	/* XXX This would be a natural place to set C<PL_compcv = cv> so
+	 * that eval'' ops within this sub know the correct lexical space.
+	 * Owing the speed considerations, we choose to search for the cv
+	 * in doeval() instead.
+	 */
 	if (CvDEPTH(cv) < 2)
 	    (void)SvREFCNT_inc(cv);
 	else {	/* save temporaries on recursion? */
-	    if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION)
-		  && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
-		sub_crush_depth(cv);
 	    if (CvDEPTH(cv) > AvFILLp(padlist)) {
 		AV *av;
 		AV *newpad = newAV();
@@ -2373,6 +2415,13 @@ PP(pp_entersub)
 		MARK++;
 	    }
 	}
+	/* warning must come *after* we fully set up the context
+	 * stuff so that __WARN__ handlers can safely dounwind()
+	 * if they want to
+	 */
+	if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION)
+	    && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
+	    sub_crush_depth(cv);
 #if 0
 	DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 			      "%p entersub returning %p\n", thr, CvSTART(cv)));
@@ -2413,7 +2462,7 @@ PP(pp_aelem)
 	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';
@@ -2443,7 +2492,7 @@ vivify_ref(SV *sv, U32 to_what)
 	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) {
@@ -2486,7 +2535,7 @@ PP(pp_method)
 	}
     }
 
-    name = SvPV(TOPs, PL_na);
+    name = SvPV(TOPs, packlen);
     sv = *(PL_stack_base + TOPMARK + 1);
     
     if (SvGMAGICAL(sv))
@@ -2502,10 +2551,16 @@ PP(pp_method)
 	    !(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;
 	}