diff options
| -rw-r--r-- | pod/perldelta.pod | 5 | ||||
| -rw-r--r-- | pod/perldiag.pod | 8 | ||||
| -rw-r--r-- | pp_ctl.c | 47 | ||||
| -rw-r--r-- | t/op/require_errors.t | 5 |
4 files changed, 52 insertions, 13 deletions
diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 5aa97e5cc2..dc7cd8343d 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -210,6 +210,11 @@ and New Warnings =item * +L<Object with arguments in @INC does not support a hook method + |perldiag/"Object with arguments in @INC does not support a hook method"> + +=item * + XXX L<message|perldiag/"message"> =back diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 6b3d132a23..6e538cf702 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -4461,6 +4461,14 @@ and you mentioned a variable that starts with 0 that has more than one digit. You probably want to remove the leading 0, or if the intent was to express a variable name in octal you should convert to decimal. +=item Object with arguments in @INC does not support a hook method + +(F) You pushed an array reference hook into C<@INC> which has an object +as the first argument, but the object doesn't support any known hooks. +Since you used the array form of creating a hook, you should have supplied +an object that supports either the C<INC> or C<INCDIR> methods. You +could also use a coderef instead of an object. + =item Octal number > 037777777777 non-portable (W portable) The octal number you specified is larger than 2**32-1 @@ -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 { diff --git a/t/op/require_errors.t b/t/op/require_errors.t index 849d57fc32..b4d07016d7 100644 --- a/t/op/require_errors.t +++ b/t/op/require_errors.t @@ -348,7 +348,6 @@ like $@, qr/^Can't locate \Q$nonsearch\E at/, { }, 'INCDIR works as expected'); } { - local $::TODO = "Pending object handling improvements"; # as of 5.37.7 fresh_perl_like( '@INC = ("a",bless({},"CB"),"e");' @@ -357,7 +356,6 @@ like $@, qr/^Can't locate \Q$nonsearch\E at/, { }, 'Objects with no INC or INCDIR method are stringified'); } { - local $::TODO = "Pending object handling improvements"; # as of 5.37.7 fresh_perl_like( '{package CB; use overload qw("")=>sub { "blorg"};} ' @@ -367,7 +365,6 @@ like $@, qr/^Can't locate \Q$nonsearch\E at/, { }, 'Objects with overload and no INC or INCDIR method are stringified'); } { - local $::TODO = "Pending object handling improvments"; # as of 5.37.7 fresh_perl_like( '@INC = ("a",bless(sub { warn "blessed sub called" },"CB"),"e");' @@ -376,7 +373,6 @@ like $@, qr/^Can't locate \Q$nonsearch\E at/, { }, 'Blessed subs with no hook methods are executed'); } { - local $::TODO = "Pending better error messages (eval)"; # as of 5.37.7 fresh_perl_like( '@INC = ("a",bless(sub { die "blessed sub called" },"CB"),"e");' @@ -394,7 +390,6 @@ like $@, qr/^Can't locate \Q$nonsearch\E at/, { }, 'Blessed subs with methods call method and produce expected message'); } { - local $::TODO = "Pending object handling improvments"; # as of 5.37.7 fresh_perl_like( '@INC = ("a",[bless([],"CB"),1],"e");' |