X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=78f07a17f30ba4186ae0f8ec8b0bb725ba33288d;hb=6dd159d1401b9b9973dd00c1235374efbcb27144;hp=30b44064ef4b70f44f8317549a9503ff42761436;hpb=7399586d384137f7ae66bcc82a83b0df7dd429e5;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_hot.c b/pp_hot.c
index 30b4406..78f07a1 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -588,9 +588,15 @@ PP(pp_rv2hv)
 	dTARGET;
 	if (SvTYPE(hv) == SVt_PVAV)
 	    hv = avhv_keys((AV*)hv);
+#ifdef IV_IS_QUAD
 	if (HvFILL(hv))
-	    Perl_sv_setpvf(aTHX_ TARG, "%ld/%ld",
-		      (long)HvFILL(hv), (long)HvMAX(hv) + 1);
+            Perl_sv_setpvf(aTHX_ TARG, "%" PERL_PRId64 "/%" PERL_PRId64,
+                      (Quad_t)HvFILL(hv), (Quad_t)HvMAX(hv) + 1);
+#else
+	if (HvFILL(hv))
+            Perl_sv_setpvf(aTHX_ TARG, "%ld/%ld",
+                      (long)HvFILL(hv), (long)HvMAX(hv) + 1);
+#endif
 	else
 	    sv_setiv(TARG, 0);
 	
@@ -761,8 +767,8 @@ PP(pp_aassign)
 	    }
 #  endif /* HAS_SETREUID */
 #endif /* HAS_SETRESUID */
-	    PL_uid = (int)PerlProc_getuid();
-	    PL_euid = (int)PerlProc_geteuid();
+	    PL_uid = PerlProc_getuid();
+	    PL_euid = PerlProc_geteuid();
 	}
 	if (PL_delaymagic & DM_GID) {
 #ifdef HAS_SETRESGID
@@ -790,8 +796,8 @@ PP(pp_aassign)
 	    }
 #  endif /* HAS_SETREGID */
 #endif /* HAS_SETRESGID */
-	    PL_gid = (int)PerlProc_getgid();
-	    PL_egid = (int)PerlProc_getegid();
+	    PL_gid = PerlProc_getgid();
+	    PL_egid = PerlProc_getegid();
 	}
 	PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
     }
@@ -2504,25 +2510,46 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
 PP(pp_method)
 {
     djSP;
+    SV* sv = TOPs;
+
+    if (SvROK(sv)) {
+	SV* rsv = SvRV(sv);
+	if (SvTYPE(rsv) == SVt_PVCV) {
+	    SETs(rsv);
+	    RETURN;
+	}
+    }
+
+    SETs(method_common(sv, Null(U32*)));
+    RETURN;
+}
+
+PP(pp_method_named)
+{
+    djSP;
+    SV* sv = cSVOP->op_sv;
+    U32 hash = SvUVX(sv);
+
+    XPUSHs(method_common(sv, &hash));
+    RETURN;
+}
+
+STATIC SV *
+S_method_common(pTHX_ SV* meth, U32* hashp)
+{
+    djSP;
     SV* sv;
     SV* ob;
     GV* gv;
     HV* stash;
     char* name;
+    STRLEN namelen;
     char* packname;
     STRLEN packlen;
 
-    if (SvROK(TOPs)) {
-	sv = SvRV(TOPs);
-	if (SvTYPE(sv) == SVt_PVCV) {
-	    SETs(sv);
-	    RETURN;
-	}
-    }
-
-    name = SvPV(TOPs, packlen);
+    name = SvPV(meth, namelen);
     sv = *(PL_stack_base + TOPMARK + 1);
-    
+
     if (SvGMAGICAL(sv))
         mg_get(sv);
     if (SvROK(sv))
@@ -2542,9 +2569,9 @@ PP(pp_method)
 		    : !isIDFIRST(*packname)
 		))
 	    {
-		DIE(aTHX_ "Can't call method \"%s\" %s", name,
-		    SvOK(sv)? "without a package or object reference"
-			    : "on an undefined value");
+		Perl_croak(aTHX_ "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;
@@ -2553,11 +2580,23 @@ PP(pp_method)
     }
 
     if (!ob || !SvOBJECT(ob))
-	DIE(aTHX_ "Can't call method \"%s\" on unblessed reference", name);
+	Perl_croak(aTHX_ "Can't call method \"%s\" on unblessed reference",
+		   name);
 
     stash = SvSTASH(ob);
 
   fetch:
+    /* shortcut for simple names */
+    if (hashp) {
+	HE* he = hv_fetch_ent(stash, meth, 0, *hashp);
+	if (he) {
+	    gv = (GV*)HeVAL(he);
+	    if (isGV(gv) && GvCV(gv) &&
+		(!GvCVGEN(gv) || GvCVGEN(gv) == PL_sub_generation))
+		return (SV*)GvCV(gv);
+	}
+    }
+
     gv = gv_fetchmethod(stash, name);
     if (!gv) {
 	char* leaf = name;
@@ -2578,11 +2617,11 @@ PP(pp_method)
 	    packname = name;
 	    packlen = sep - name;
 	}
-	DIE(aTHX_ "Can't locate object method \"%s\" via package \"%.*s\"",
-	    leaf, (int)packlen, packname);
+	Perl_croak(aTHX_
+		   "Can't locate object method \"%s\" via package \"%s\"",
+		   leaf, packname);
     }
-    SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv);
-    RETURN;
+    return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv;
 }
 
 #ifdef USE_THREADS