stop using &PL_sv_yes as no-op method

Method lookup yields a fake method for ->import or ->unimport if there's
no actual method, for historical reasons so that "use" doesn't barf
if there's no import method.  This fake method used to be &PL_sv_yes
being used as a magic placeholder, recognised specially by pp_entersub.
But &PL_sv_yes is a string, which we'd expect to serve as a symbolic
CV ref.  Change method lookup to yield an actual CV with a body in this
case, and remove the special case from pp_entersub.  This fixes the
remaining part of [perl #126042].

6 files changed, 44 insertions, 58 deletions

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 5ceb7fe939..891b7e71d4 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -2339,9 +2339,17 @@ CODE:
        only current internal behavior, these tests can be changed in the
        future if necessery */
     PUSHMARK(SP);
-    retcnt = call_sv(&PL_sv_yes, 0); /* does nothing */
+    retcnt = call_sv(&PL_sv_yes, G_EVAL);
     SPAGAIN;
     SP -= retcnt;
+    errsv = ERRSV;
+    errstr = SvPV(errsv, errlen);
+    if(memBEGINs(errstr, errlen, "Undefined subroutine &main::1 called at")) {
+        PUSHMARK(SP);
+        retcnt = call_sv((SV*)i_sub, 0); /* call again to increase counter */
+        SPAGAIN;
+        SP -= retcnt;
+    }
     PUSHMARK(SP);
     retcnt = call_sv(&PL_sv_no, G_EVAL);
     SPAGAIN;
diff --git a/ext/XS-APItest/t/call.t b/ext/XS-APItest/t/call.t
index 355e49886e..8192b9bd36 100644
--- a/ext/XS-APItest/t/call.t
+++ b/ext/XS-APItest/t/call.t
@@ -33,7 +33,7 @@ sub i {
     $call_sv_count++;
 }
 call_sv_C();
-is($call_sv_count, 6, "call_sv_C passes");
+is($call_sv_count, 7, "call_sv_C passes");
 
 sub d {
     die "its_dead_jim\n";
diff --git a/gv.c b/gv.c
index bc5b388588..00adb8995c 100644
--- a/gv.c
+++ b/gv.c
@@ -1091,9 +1091,10 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
 	/* This is the special case that exempts Foo->import and
 	   Foo->unimport from being an error even if there's no
 	  import/unimport subroutine */
-	if (strEQ(name,"import") || strEQ(name,"unimport"))
-	    gv = MUTABLE_GV(&PL_sv_yes);
-	else if (autoload)
+	if (strEQ(name,"import") || strEQ(name,"unimport")) {
+	    gv = (GV*)sv_2mortal((SV*)newCONSTSUB_flags(NULL,
+						NULL, 0, 0, NULL));
+	} else if (autoload)
 	    gv = gv_autoload_pvn(
 		ostash, name, name_end - name, GV_AUTOLOAD_ISMETHOD|flags
 	    );
diff --git a/pp_hot.c b/pp_hot.c
index 7609638b8f..87e60970d6 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -5007,16 +5007,6 @@ PP(pp_entersub)
                 if (UNLIKELY(!SvOK(sv)))
                     DIE(aTHX_ PL_no_usym, "a subroutine");
 
-                if (UNLIKELY(sv == &PL_sv_yes)) { /* unfound import, ignore */
-                    if (PL_op->op_flags & OPf_STACKED) /* hasargs */
-                        SP = PL_stack_base + POPMARK;
-                    else
-                        (void)POPMARK;
-                    if (GIMME_V == G_SCALAR)
-                        PUSHs(&PL_sv_undef);
-                    RETURN;
-                }
-
                 sym = SvPV_nomg_const(sv, len);
                 if (PL_op->op_private & HINT_STRICT_REFS)
                     DIE(aTHX_ "Can't use string (\"%" SVf32 "\"%s) as a subroutine ref while \"strict refs\" in use", sv, len>32 ? "..." : "");
diff --git a/t/op/method.t b/t/op/method.t
index 82f8263a10..d0fc321804 100644
--- a/t/op/method.t
+++ b/t/op/method.t
@@ -13,7 +13,35 @@ BEGIN {
 use strict;
 no warnings 'once';
 
-plan(tests => 151);
+plan(tests => 162);
+
+{
+    # RT #126042 &{1==1} * &{1==1} would crash
+    # There are two issues here.  Method lookup yields a fake method for
+    # ->import or ->unimport if there's no actual method, for historical
+    # reasons so that "use" doesn't barf if there's no import method.
+    # The first bug, the one which caused the crash, is that the fake
+    # method was broken in scalar context, messing up the stack.  We test
+    # for that on its own.
+    foreach my $meth (qw(import unimport)) {
+	is join(",", map { $_ // "u" } "a", "b", "Unknown"->$meth, "c", "d"), "a,b,c,d", "Unknown->$meth in list context";
+	is join(",", map { $_ // "u" } "a", "b", scalar("Unknown"->$meth), "c", "d"), "a,b,u,c,d", "Unknown->$meth in scalar context";
+    }
+    # The second issue is that the fake method wasn't actually a CV or
+    # anything referencing a CV, but was &PL_sv_yes being used as a magic
+    # placeholder.  That's inconsistent with &PL_sv_yes being a string,
+    # which we'd expect to serve as a symbolic CV ref.  This test must
+    # come before AUTOLOAD gets set up below.
+    foreach my $one (1, !!1) {
+	my @res = eval { no strict "refs"; &$one() };
+	like $@, qr/\AUndefined subroutine \&main::1 called at /;
+	@res = eval { no strict "refs"; local *1 = sub { 123 }; &$one() };
+	is $@, "";
+	is "@res", "123";
+	@res = eval { &$one() };
+	like $@, qr/\ACan't use string \("1"\) as a subroutine ref while "strict refs" in use at /;
+    }
+}
 
 @A::ISA = 'BB';
 @BB::ISA = 'C';
@@ -687,23 +715,6 @@ SKIP: {
     like ($@, qr/Modification of a read-only value attempted/, 'RT #123619');
 }
 
-{
-    # RT #126042 &{1==1} * &{1==1} would crash
-
-    # pp_entersub and pp_method_named cooperate to prevent calls to an
-    # undefined import() or unimport() method from croaking.
-    # If pp_method_named can't find the method it pushes &PL_sv_yes, and
-    # pp_entersub checks for that specific SV to avoid croaking.
-    # Ideally they wouldn't use that hack but...
-    # Unfortunately pp_entersub's handling of that case is broken in scalar context.
-
-    # Rather than using the test case from the ticket, since &{1==1}
-    # isn't documented (and may not be supported in future perls) test
-    # calls to undefined import method, which also crashes.
-    fresh_perl_is('Unknown->import() * Unknown->unimport(); print "ok\n"', "ok\n", {},
-                  "check unknown import() methods don't corrupt the stack");
-}
-
 # RT#130496: assertion failure when looking for a method of undefined name
 # on an unblessed reference
 fresh_perl_is('eval { {}->$x }; print $@;',
diff --git a/t/op/sub.t b/t/op/sub.t
index f73abb455f..5de358ebf3 100644
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -6,7 +6,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan(tests => 65);
+plan(tests => 61);
 
 sub empty_sub {}
 
@@ -17,30 +17,6 @@ is(scalar(@test), 0, 'Didnt return anything');
 @test = empty_sub(1,2,3);
 is(scalar(@test), 0, 'Didnt return anything');
 
-# RT #63790:  calling PL_sv_yes as a sub is special-cased to silently
-# return (so Foo->import() silently fails if import() doesn't exist),
-# But make sure it correctly pops the stack and mark stack before returning.
-
-{
-    my @a;
-    push @a, 4, 5, main->import(6,7);
-    ok(eq_array(\@a, [4,5]), "import with args");
-
-    @a = ();
-    push @a, 14, 15, main->import;
-    ok(eq_array(\@a, [14,15]), "import without args");
-
-    my $x = 1;
-
-    @a = ();
-    push @a, 24, 25, &{$x == $x}(26,27);
-    ok(eq_array(\@a, [24,25]), "yes with args");
-
-    @a = ();
-    push @a, 34, 35, &{$x == $x};
-    ok(eq_array(\@a, [34,35]), "yes without args");
-}
-
 # [perl #91844] return should always copy
 {
     $foo{bar} = 7;