X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=gv.c;h=da794039f7b49a1ee9e2b40a4a34bf53dac8028b;hb=56e771c1bc71c994cd5a877d8b2eadd47e254ff8;hp=23a694c472b4f80846dc3cfecb5b778367cc0db6;hpb=f2df708187f7170c3344b7542e7aa96faa0b2fd8;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/gv.c b/gv.c
index 23a694c..da79403 100644
--- a/gv.c
+++ b/gv.c
@@ -520,7 +520,7 @@ Perl_gv_fetchmeth_autoload(pTHX_ HV *stash, const char *name, STRLEN len, I32 le
 
 	if (!stash)
 	    return NULL;	/* UNIVERSAL::AUTOLOAD could cause trouble */
-	if (len == S_autolen && strnEQ(name, S_autoload, S_autolen))
+	if (len == S_autolen && memEQ(name, S_autoload, S_autolen))
 	    return NULL;
 	if (!(gv = gv_fetchmeth(stash, S_autoload, S_autolen, FALSE)))
 	    return NULL;
@@ -599,43 +599,51 @@ S_gv_get_super_pkg(pTHX_ const char* name, I32 namelen)
     return stash;
 }
 
-/* FIXME. If changing this function note the comment in pp_hot's
-   S_method_common:
-
-   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. ...
+GV *
+Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
+{
+    PERL_ARGS_ASSERT_GV_FETCHMETHOD_AUTOLOAD;
 
-   I'd guess that with one more flag bit that could all be moved inside
-   here.
-*/
+    return gv_fetchmethod_flags(stash, name, autoload ? GV_AUTOLOAD : 0);
+}
 
+/* Don't merge this yet, as it's likely to get a len parameter, and possibly
+   even a U32 hash */
 GV *
-Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
+Perl_gv_fetchmethod_flags(pTHX_ HV *stash, const char *name, U32 flags)
 {
     dVAR;
     register const char *nend;
     const char *nsplit = NULL;
     GV* gv;
     HV* ostash = stash;
+    const char * const origname = name;
+    SV *const error_report = (SV *)stash;
+    const U32 autoload = flags & GV_AUTOLOAD;
+    const U32 do_croak = flags & GV_CROAK;
 
-    PERL_ARGS_ASSERT_GV_FETCHMETHOD_AUTOLOAD;
+    PERL_ARGS_ASSERT_GV_FETCHMETHOD_FLAGS;
 
-    if (stash && SvTYPE(stash) < SVt_PVHV)
+    if (SvTYPE(stash) < SVt_PVHV)
 	stash = NULL;
+    else {
+	/* The only way stash can become NULL later on is if nsplit is set,
+	   which in turn means that there is no need for a SVt_PVHV case
+	   the error reporting code.  */
+    }
 
     for (nend = name; *nend; nend++) {
-	if (*nend == '\'')
+	if (*nend == '\'') {
 	    nsplit = nend;
-	else if (*nend == ':' && *(nend + 1) == ':')
-	    nsplit = ++nend;
+	    name = nend + 1;
+	}
+	else if (*nend == ':' && *(nend + 1) == ':') {
+	    nsplit = nend++;
+	    name = nend + 1;
+	}
     }
     if (nsplit) {
-	const char * const origname = name;
-	name = nsplit + 1;
-	if (*nsplit == ':')
-	    --nsplit;
-	if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) {
+	if ((nsplit - origname) == 5 && memEQ(origname, "SUPER", 5)) {
 	    /* ->SUPER::method should really be looked up in original stash */
 	    SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
 						  CopSTASHPV(PL_curcop)));
@@ -664,6 +672,31 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
 	    gv = (GV*)&PL_sv_yes;
 	else if (autoload)
 	    gv = gv_autoload4(ostash, name, nend - name, TRUE);
+	if (!gv && do_croak) {
+	    /* Right now this is exclusively for the benefit of S_method_common
+	       in pp_hot.c  */
+	    if (stash) {
+		Perl_croak(aTHX_
+			   "Can't locate object method \"%s\" via package \"%.*s\"",
+			   name, (int)HvNAMELEN_get(stash), HvNAME_get(stash));
+	    }
+	    else {
+		STRLEN packlen;
+		const char *packname;
+
+		if (nsplit) {
+		    packlen = nsplit - origname;
+		    packname = origname;
+		} else {
+		    packname = SvPV_const(error_report, packlen);
+		}
+
+		Perl_croak(aTHX_
+			   "Can't locate object method \"%s\" via package \"%.*s\""
+			   " (perhaps you forgot to load \"%.*s\"?)",
+			   name, (int)packlen, packname, (int)packlen, packname);
+	    }
+	}
     }
     else if (autoload) {
 	CV* const cv = GvCV(gv);
@@ -702,7 +735,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
 
     PERL_ARGS_ASSERT_GV_AUTOLOAD4;
 
-    if (len == S_autolen && strnEQ(name, S_autoload, S_autolen))
+    if (len == S_autolen && memEQ(name, S_autoload, S_autolen))
 	return NULL;
     if (stash) {
 	if (SvTYPE(stash) < SVt_PVHV) {