From: Anders Nor Berle <berle@cpan.org>
Date: Fri, 10 Aug 2007 16:52:47 +0000 (+0000)
Subject: * s/can_role/does_role/g.
X-Git-Tag: 0_25~9
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=adf823317010b616dfabab828adb8936de0065c3;p=gitmo%2FMoose.git

* s/can_role/does_role/g.
* Make does_role work without ->meta method.
* Improved testing.
---

diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm
index ef9646d..ff2283f 100644
--- a/lib/Moose/Util.pm
+++ b/lib/Moose/Util.pm
@@ -1,7 +1,7 @@
 package Moose::Util;
 
 use Exporter qw/import/;
-use Scalar::Util qw/blessed/;
+use Scalar::Util;
 
 use strict;
 use warnings;
@@ -10,14 +10,18 @@ our $VERSION = '0.01';
 
 our $AUTHORITY = 'cpan:BERLE';
 
-our @EXPORT_OK = qw/can_role search_class_by_role/;
+our @EXPORT_OK = qw/does_role search_class_by_role/;
 
-sub can_role {
-  my ($class,$does) = @_;
+sub does_role {
+  my ($class, $role) = @_;
 
-  return ((!ref $class && eval { $class->isa ('UNIVERSAL') }) || Scalar::Util::blessed ($class))
-    && $class->can ('does')
-    && $class->does ($does);
+  return unless defined $class;
+
+  my $meta = Class::MOP::get_metaclass_by_name (ref $class || $class);
+
+  return unless defined $meta;
+
+  return $meta->does_role ($role);
 }
 
 sub search_class_by_role {
@@ -46,8 +50,8 @@ Moose::Util - Moose utilities
 
   use Moose::Util qw/can_role search_class_by_role/;
 
-  if (can_role ($object,'rolename')) {
-    print "The object can do rolename!\n";
+  if (does_role($object, $role)) {
+    print "The object can do $role!\n";
   }
 
   my $class = search_class_by_role($object, 'FooRole');
@@ -57,9 +61,9 @@ Moose::Util - Moose utilities
 
 =over 4
 
-=item can_role
+=item does_role
 
-  can_role ($object,$rolename);
+  does_role($object, $rolename);
 
 Returns true if $object can do the role $rolename.
 
diff --git a/lib/Test/Moose.pm b/lib/Test/Moose.pm
index 9808b3a..e9694e2 100644
--- a/lib/Test/Moose.pm
+++ b/lib/Test/Moose.pm
@@ -1,7 +1,7 @@
 package Test::Moose;
 
 use Exporter;
-use Moose::Util qw/can_role/;
+use Moose::Util qw/does_role/;
 use Test::Builder;
 
 use strict;
@@ -34,7 +34,7 @@ sub import {
 sub does_ok ($$;$) {
   my ($class,$does,$name) = @_;
 
-  return $tester->ok (can_role ($class,$does),$name)
+  return $tester->ok (does_role ($class,$does),$name)
 }
 
 1;
diff --git a/t/400_moose_util.t b/t/400_moose_util.t
new file mode 100644
index 0000000..247617e
--- /dev/null
+++ b/t/400_moose_util.t
@@ -0,0 +1,55 @@
+#!/usr/bin/env perl
+
+use Test::More tests => 9;
+
+use strict;
+use warnings;
+
+BEGIN {
+  use_ok('Moose');
+  use_ok('Moose::Role');
+  use_ok('Moose::Util');
+}
+
+{
+  package Foo;
+
+  use Moose::Role;
+}
+
+{
+  package Bar;
+
+  use Moose;
+
+  with qw/Foo/;
+}
+
+{
+  package Baz;
+
+  use Moose;
+}
+
+# Classes
+
+ok(Moose::Util::does_role('Bar', 'Foo'));
+
+ok(! Moose::Util::does_role('Baz', 'Foo'));
+
+# Objects
+
+my $bar = Bar->new;
+
+ok(Moose::Util::does_role($bar, 'Foo'));
+
+my $baz = Baz->new;
+
+ok(! Moose::Util::does_role($baz, 'Foo'));
+
+# Invalid values
+
+ok(! Moose::Util::does_role(undef,'Foo'));
+
+ok(! Moose::Util::does_role(1,'Foo'));
+
diff --git a/t/400_test_moose.t b/t/401_test_moose.t
similarity index 82%
rename from t/400_test_moose.t
rename to t/401_test_moose.t
index 288e695..dc6291a 100644
--- a/t/400_test_moose.t
+++ b/t/401_test_moose.t
@@ -1,9 +1,15 @@
-use Test::Builder::Tester tests => 1;
-use Test::Moose;
+use Test::Builder::Tester tests => 4;
+use Test::More;
 
 use strict;
 use warnings;
 
+BEGIN {
+  use_ok('Moose');
+  use_ok('Moose::Role');
+  use_ok('Test::Moose');
+}
+
 {
   package Foo;