rv2cv hooks should not create 2nd-class subs

$ perl5.17.2 -Mblib -e 'sub foo{}; foo $bar; use Lexical::Sub baz => sub{}; baz $bar'
Can't call method "baz" on an undefined value at -e line 1.
$ perl5.17.2 -Mblib -e 'sub foo{}; foo bar; use Lexical::Sub baz => sub{}; baz bar'
Can't locate object method "baz" via package "bar" (perhaps you forgot to load "bar"?) at -e line 1.

So if you use Lexical::Sub, your sub doesn’t get to participate in
determining whether ‘foo $bar’ or ‘foo bar’ is a method call.

This is because Lexical::Sub uses an rv2cv hook to intercept sub
lookup.  And toke.c:S_intuit_method thinks there cannot be a CV with-
out a GV (which was the case when it was first written).

Commit f7461760 introduced this rv2cv hooking for bareword lookup, but
failed to update S_intuit_method accordingly.

2 files changed, 54 insertions, 0 deletions

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 57c8fd078d..3785c3b059 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -1101,6 +1101,29 @@ addissub_myck_add(pTHX_ OP *op)
     return newBINOP(OP_SUBTRACT, flags, aop, bop);
 }
 
+static Perl_check_t old_ck_rv2cv;
+
+static OP *
+my_ck_rv2cv(pTHX_ OP *o)
+{
+    SV *ref;
+    SV **flag_svp = hv_fetchs(GvHV(PL_hintgv), "XS::APItest/addunder", 0);
+    OP *aop;
+
+    if (flag_svp && SvTRUE(*flag_svp) && (o->op_flags & OPf_KIDS)
+     && (aop = cUNOPx(o)->op_first) && aop->op_type == OP_CONST
+     && aop->op_private & (OPpCONST_ENTERED|OPpCONST_BARE)
+     && (ref = cSVOPx(aop)->op_sv) && SvPOK(ref) && SvCUR(ref)
+     && *(SvEND(ref)-1) == 'o')
+    {
+	SvGROW(ref, SvCUR(ref)+2);
+	*SvEND(ref) = '_';
+	SvCUR(ref)++;
+	*SvEND(ref) = '\0';
+    }
+    return old_ck_rv2cv(aTHX_ o);
+}
+
 #include "const-c.inc"
 
 MODULE = XS::APItest		PACKAGE = XS::APItest
@@ -3349,6 +3372,11 @@ setup_addissub()
 CODE:
     wrap_op_checker(OP_ADD, addissub_myck_add, &addissub_nxck_add);
 
+void
+setup_rv2cv_addunderbar()
+CODE:
+    wrap_op_checker(OP_RV2CV, my_ck_rv2cv, &old_ck_rv2cv);
+
 #ifdef USE_ITHREADS
 
 bool
diff --git a/ext/XS-APItest/t/sym-hook.t b/ext/XS-APItest/t/sym-hook.t
new file mode 100644
index 0000000000..023aad9b4d
--- /dev/null
+++ b/ext/XS-APItest/t/sym-hook.t
@@ -0,0 +1,26 @@
+
+# Test that PL_check hooks for RV2*V can override symbol lookups.
+
+# So far we only test RV2CV.
+
+use XS::APItest;
+use Test::More tests => 3;
+
+BEGIN {
+    setup_rv2cv_addunderbar;
+    $^H{'XS::APItest/addunder'} = 1; # make foo() actually call foo_()
+}
+
+sub foo_ { @_ ? shift . "___" : "phew" }
+
+is(foo(), "phew");
+
+# Make sure subs looked up via rv2cv check hooks are not treated as second-
+# class subs.
+
+BEGIN { # If there is a foo symbol, this test will not be testing anything.
+    delete $::{foo};
+}
+is((foo bar), 'bar___');
+$bar = "baz";
+is((foo $bar), 'baz___');