New modules

* Moose::Util
* Test::Moose

diff --git a/Changes b/Changes
index 844e041..6ded70c 100644 (file)
--- a/Changes
+++ b/Changes
@@ -37,6 +37,12 @@ Revision history for Perl extension Moose
     * Moose::Spec::Role
       - a formal definition of roles
 
+    * Moose::Util
+      - utilities for easier working with moose classes
+
+    * Test::Moose
+      - moose specific tests
+
 0.24 Tues. July 3, 2007
     ~ Some doc updates/cleanup ~
 

diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm
new file mode 100644 (file)
index 0000000..904ecd4
--- /dev/null
+++ b/lib/Moose/Util.pm
@@ -0,0 +1,73 @@
+package Moose::Util;
+
+use Exporter qw/import/;
+use Scalar::Util qw/blessed/;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+our $AUTHORITY = 'cpan:BERLE';
+
+our @EXPORT_OK = qw/can_role/;
+
+sub can_role {
+  my ($class,$does) = @_;
+
+  return ((!ref $class && eval { $class->isa ('UNIVERSAL') }) || Scalar::Util::blessed ($class))
+    && $class->can ('does')
+    && $class->does ($does);
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Util - Moose utilities
+
+=head1 SYNOPSIS
+
+  use Moose::Util qw/can_role/;
+
+  if (can_role ($object,'rolename')) {
+    print "The object can do rolename!\n";
+  }
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item can_role
+
+  can_role ($object,$rolename);
+
+Returns true if $object can do the role $rolename.
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no 
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Anders Nor Berle E<lt>debolaz@gmail.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. 
+
+=cut
+

diff --git a/lib/Test/Moose.pm b/lib/Test/Moose.pm
new file mode 100644 (file)
index 0000000..e7c1409
--- /dev/null
+++ b/lib/Test/Moose.pm
@@ -0,0 +1,97 @@
+package Test::Moose;
+
+use Exporter;
+use Moose::Util qw/can_role/;
+use Test::Builder;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+our $AUTHORITY = 'cpan:BERLE';
+
+our @EXPORT = qw/can_role/;
+
+my $tester = Test::Builder->new;
+
+sub import {
+  my $class = shift;
+
+  if (@_) {
+    my $package = caller;
+    
+    $tester->exported_to ($package);
+
+    $tester->plan (@_);
+  }
+
+  @_ = ($class);
+
+  goto &Exporter::import;
+}
+
+sub does_ok ($$;$) {
+  my ($class,$does,$name) = @_;
+
+  return $tester->ok (can_role ($class,$does),$name)
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Test::Moose - Test functions for Moose specific features
+
+=head1 SYNOPSIS
+
+  use Test::Moose plan => 1;
+
+  does_ok ($class,$role,"Does $class do $role");
+
+=head1 TESTS
+
+=over 4
+
+=item does_ok
+
+  does_ok ($class,$role,$name);
+
+Tests if a class does a certain role, similar to what isa_ok does for
+isa.
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Test::More>
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no 
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Anders Nor Berle E<lt>debolaz@gmail.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. 
+
+=cut
+

diff --git a/t/400_test_moose.t b/t/400_test_moose.t
new file mode 100644 (file)
index 0000000..288e695
--- /dev/null
+++ b/t/400_test_moose.t
@@ -0,0 +1,60 @@
+use Test::Builder::Tester tests => 1;
+use Test::Moose;
+
+use strict;
+use warnings;
+
+{
+  package Foo;
+
+  use Moose::Role;
+}
+
+{
+  package Bar;
+
+  use Moose;
+
+  with qw/Foo/;
+}
+
+{
+  package Baz;
+
+  use Moose;
+}
+
+# class ok
+
+test_out('ok 1 - does_ok class');
+
+does_ok('Bar','Foo','does_ok class');
+
+# class fail
+
+test_out ('not ok 2 - does_ok class fail');
+
+test_fail (+2);
+
+does_ok('Baz','Foo','does_ok class fail');
+
+# object ok
+
+my $bar = Bar->new;
+
+test_out ('ok 3 - does_ok object');
+
+does_ok ($bar,'Foo','does_ok object');
+
+# object fail
+
+my $baz = Baz->new;
+
+test_out ('not ok 4 - does_ok object fail');
+
+test_fail (+2);
+
+does_ok ($baz,'Foo','does_ok object fail');
+
+test_test ('does_ok');
+