pp_ctl.c - handle objects in @INC a bit more gracefully

If an object doesn't have an INC hook then don't call it. Either simply
stringify the ref (think overloads), OR, if it is a blessed coderef,
then just execute it like it was an unblessed coderef.

Also handle when an object is passed as the first argument of the
array form of call. Previously this would throw an exception as the
first argument on the stack when we call_method() would not be
blessed. When this is the scenario we pass in the array as the third
argument to the method.

1 files changed, 39 insertions, 8 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index 6872b8c025..6c3a34b20c 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4307,25 +4307,55 @@ S_require_file(pTHX_ SV *sv)
                         SvSetSV_nosteal(nsv,sv);
                     }
 
+                    const char *method = NULL;
                     SV * inc_idx_sv = save_scalar(PL_incgv);
                     sv_setiv(inc_idx_sv,inc_idx);
+                    if (sv_isobject(loader)) {
+                        /* if it is an object and it has an INC method, then
+                         * call the method.
+                         */
+                        HV *pkg = SvSTASH(SvRV(loader));
+                        GV * gv = gv_fetchmethod_pvn_flags(pkg, "INC", 3, 0);
+                        if (gv && isGV(gv)) {
+                            method = "INC";
+                        }
+                        /* But if we have no method, check if this is a
+                         * coderef, if it is then we treat it as an
+                         * unblessed coderef would be treated: we
+                         * execute it. If it is some other and it is in
+                         * an array ref wrapper, then really we don't
+                         * know what to do with it, (why use the
+                         * wrapper?) and we throw an exception to help
+                         * debug. If it is not in a wrapper assume it
+                         * has an overload and treat it as a string.
+                         * Maybe in the future we can detect if it does
+                         * have overloading and throw an error if not.
+                         */
+                        if (!method) {
+                            if (SvTYPE(SvRV(loader)) != SVt_PVCV) {
+                                if (dirsv != loader)
+                                    croak("Object with arguments in @INC does not support a hook method");
+                                else
+                                    goto treat_as_string;
+                            }
+                        }
+                    }
 
                     ENTER_with_name("call_INC_hook");
                     SAVETMPS;
-                    EXTEND(SP, 2);
-
+                    EXTEND(SP, 2 + ((method && (loader != dirsv)) ? 1 : 0));
                     PUSHMARK(SP);
-                    PUSHs(dirsv);
+                    PUSHs(method ? loader : dirsv); /* always use the object for method calls */
                     PUSHs(nsv);
+                    if (method && (loader != dirsv)) /* add the args array for method calls */
+                        PUSHs(dirsv);
                     PUTBACK;
                     if (SvGMAGICAL(loader)) {
                         SV *l = sv_newmortal();
                         sv_setsv_nomg(l, loader);
                         loader = l;
                     }
-                    const char *method = NULL;
-                    if (sv_isobject(loader)) {
-                        method = "INC";
+                    if (method) {
                         count = call_method(method, G_LIST|G_EVAL);
                     } else {
                         count = call_sv(loader, G_LIST|G_EVAL);
@@ -4482,12 +4512,13 @@ S_require_file(pTHX_ SV *sv)
                         filter_sub = NULL;
                     }
                 }
-                else if (path_searchable) {
+                else
+                    treat_as_string:
+                    if (path_searchable) {
                     /* match against a plain @INC element (non-searchable
                      * paths are only matched against refs in @INC) */
                     const char *dir;
                     STRLEN dirlen;
-
                     if (SvOK(dirsv)) {
                         dir = SvPV_nomg_const(dirsv, dirlen);
                     } else {