This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #113932] UNIVERSAL::can with globs and globrefs
authorFather Chrysostomos <sprout@cpan.org>
Sun, 7 Jul 2013 19:31:00 +0000 (12:31 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 9 Jul 2013 01:05:43 +0000 (18:05 -0700)
(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.

t/op/universal.t
universal.c

index 4edbed3..7ca51fb 100644 (file)
@@ -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';
 }
index a72c072..97231e2 100644 (file)
@@ -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)