all packages can do methods in UNIVERSAL [perl #47113]

Foo->can("can") should be true even if "package Foo" hasn't been seen
yet (obviously, since that method call doesn't die with a method not
found error).

diff --git a/t/op/universal.t b/t/op/universal.t
index 40f14ce..01459dd 100644 (file)
--- a/t/op/universal.t
+++ b/t/op/universal.t
@@ -10,7 +10,7 @@ BEGIN {
     require "./test.pl";
 }
 
-plan tests => 135;
+plan tests => 138;
 
 $a = {};
 bless $a, "Bob";
@@ -107,7 +107,7 @@ for ($p=0; $p < @refs; $p++) {
     };
 };
 
-ok ! UNIVERSAL::can(23, "can");
+ok UNIVERSAL::can(23, "can");
 ++${"23::foo"};
 ok UNIVERSAL::can("23", "can"), '"23" can can when the pack exists';
 ok UNIVERSAL::can(23, "can"), '23 can can when the pack exists';
@@ -167,7 +167,7 @@ if ('a' lt 'A') {
 eval 'sub UNIVERSAL::sleep {}';
 ok $a->can("sleep");
 
-ok ! UNIVERSAL::can($b, "can");
+ok UNIVERSAL::can($b, "can");
 
 ok ! $a->can("export_tags");   # a method in Exporter
 
@@ -331,3 +331,8 @@ use warnings "deprecated";
     @RT66112::T6::ISA = qw/RT66112::E/;
     ok(RT66112::T6->isa('RT66112::A'), "modify \@ISA in isa (RT66112::T6 isa RT66112::A)");
 }
+
+ok(Undeclared->can("can"));
+sub Undeclared::foo { }
+ok(Undeclared->can("foo"));
+ok(!Undeclared->can("something_else"));

diff --git a/universal.c b/universal.c
index 384d307..383feaa 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -369,6 +369,8 @@ XS(XS_UNIVERSAL_can)
     }
     else {
         pkg = gv_stashsv(sv, 0);
+        if (!pkg)
+            pkg = gv_stashpv("UNIVERSAL", 0);
     }
 
     if (pkg) {