[Bps-public-commit] r13647 - in Scalar-Defer: t

[nothingmuch at bestpractical.com]

Author: nothingmuch
Date: Fri Jun 27 03:26:10 2008
New Revision: 13647

Modified:
   Scalar-Defer/lib/Scalar/Defer.pm
   Scalar-Defer/t/01-basic.t

Log:
fix tokuhiro's UNIVERSAL methods on class bug

Modified: Scalar-Defer/lib/Scalar/Defer.pm
==============================================================================
--- Scalar-Defer/lib/Scalar/Defer.pm	(original)
+++ Scalar-Defer/lib/Scalar/Defer.pm	Fri Jun 27 03:26:10 2008
@@ -90,14 +90,19 @@
     };
 
     {
-        no strict 'refs';
-        no warnings 'redefine';
-
         foreach my $sym (keys %UNIVERSAL::) {
-            *{$sym} = sub {
-                unshift @_, Scalar::Defer::SUB_FORCE()->(shift(@_));
-                goto &{$_[0]->can($sym)};
-            };
+			my $code = 'sub $sym {
+				if ( defined Scalar::Util::blessed($_[0]) ) { # FUCK
+					unshift @_, Scalar::Defer::SUB_FORCE()->(shift(@_));
+					goto &{$_[0]->can("$sym")};
+				} else {
+					return shift->SUPER::$sym(@_);
+				}
+            }';
+
+			$code =~ s/\$sym/$sym/ge;
+
+			eval $code;
         }
 
         *DESTROY  = \&Scalar::Defer::DESTROY;

Modified: Scalar-Defer/t/01-basic.t
==============================================================================
--- Scalar-Defer/t/01-basic.t	(original)
+++ Scalar-Defer/t/01-basic.t	Fri Jun 27 03:26:10 2008
@@ -1,4 +1,4 @@
-use Test::More tests => 14;
+use Test::More tests => 19;
 use ok 'Scalar::Defer';
 
 my ($x, $y);
@@ -27,3 +27,10 @@
 is($obj->can('meth'), SomeClass->can('meth'), '->can works too');
 ok($obj->isa('SomeClass'), '->isa works too');
 is($obj->VERSION, SomeClass->VERSION, '->VERSION works too');
+
+ok( Scalar::Defer->can("can"), "can('can') as a class method" );
+ok( !Scalar::Defer::Deferred->can('blah'), "can('blah') is false as a class method" );
+
+ok( $obj->can("can"), "can('can') as an object method" );
+ok( $obj->can("meth"), "can('meth')");
+ok( !$obj->can('blah'), "can('blah') is false as an object method" );