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 && memEQ(origname, "SUPER", 5)) {
/* ->SUPER::method should really be looked up in original stash */
SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
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);