[perl #113932] UNIVERSAL::can with globs and globrefs

(Also perl #118105.)

This allows *ARGV->can("print") to work as long as IO::Handle is
loaded.  This translates into UNIVERSAL::can(\*ARGV,"print").  This
commit also changes UNIVERSAL::can to accept a plain *ARGV as well.

UNIVERSAL::can("ARGV",...) is left as it is (ARGV is treated as a pack-
age name), because changing that requires a bigger patch, and I don’t
know when I will get to it.

diff --git a/t/op/universal.t b/t/op/universal.t
index 4edbed3..7ca51fb 100644 (file)
--- a/t/op/universal.t
+++ b/t/op/universal.t
@@ -111,11 +111,11 @@ 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';
+sub IO::Handle::turn {}
+ok UNIVERSAL::can(*STDOUT, 'turn'), 'globs with IOs can';
+ok UNIVERSAL::can(\*STDOUT, 'turn'), 'globrefs with IOs can';
 {
     local $::TODO = '[perl #113932]';
-    ok UNIVERSAL::can(*STDOUT, 'print'), 'globs with IOs can can';
-    ok UNIVERSAL::can(\*STDOUT, 'print'), 'globrefs with IOs can can';
-    sub IO::Handle::turn {}
     # Should this pass?  Or is the existing behaviour correct?
     ok UNIVERSAL::can("STDOUT", 'turn'), 'IO barewords can';
 }

diff --git a/universal.c b/universal.c
index a72c072..97231e2 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -356,8 +356,10 @@ XS(XS_UNIVERSAL_can)
 
     SvGETMAGIC(sv);
 
-    if (!SvOK(sv) || !(SvROK(sv) || SvNIOK(sv) || (SvPOK(sv) && SvCUR(sv))
-       ))
+    /* Reject undef and empty string.  Note that the string form takes
+       precedence here over the numeric form, as (!1)->foo treats the
+       invocant as the empty string, though it is a dualvar. */
+    if (!SvOK(sv) || (SvPOK(sv) && !SvCUR(sv)))
        XSRETURN_UNDEF;
 
     rv = &PL_sv_undef;
@@ -366,7 +368,11 @@ XS(XS_UNIVERSAL_can)
         sv = MUTABLE_SV(SvRV(sv));
         if (SvOBJECT(sv))
             pkg = SvSTASH(sv);
+        else if (isGV_with_GP(sv) && GvIO(sv))
+           pkg = SvSTASH(GvIO(sv));
     }
+    else if (isGV_with_GP(sv) && GvIO(sv))
+        pkg = SvSTASH(GvIO(sv));
     else {
         pkg = gv_stashsv(sv, 0);
         if (!pkg)