add test for roles, and fix subclassing test

2 files changed, 82 insertions, 1 deletions

diff --git a/t/003-subclassing.t b/t/003-subclassing.t
index 6a562ee..54b0a40 100644
--- a/t/003-subclassing.t
+++ b/t/003-subclassing.t
@@ -1,7 +1,8 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 10;
+use Test::More tests => 11;
+use Test::Exception;
 
 use MooseX::Module::Refresh;
 
@@ -49,6 +50,16 @@ $foobar = FooBarSub->new(foo => 'FOO');
 is($foobar->bar, 'barsub', "We got the right result, still");
 is($foobar->foo, 'FOOsub', "We got the right result, still");
 
+throws_ok { $r->refresh } qr/syntax error.*"has baz"/;
+
+write_out($file, <<".");
+package FooBar; 
+use Moose;
+has baz => (is => 'ro', predicate => 'foo');
+sub bar { 'baz' }
+1;
+.
+
 $r->refresh;
 
 $foobar = FooBarSub->new(baz => 'FOO');
diff --git a/t/004-roles.t b/t/004-roles.t
new file mode 100644
index 0000000..af239d5
--- /dev/null
+++ b/t/004-roles.t
@@ -0,0 +1,70 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 9;
+
+use MooseX::Module::Refresh;
+
+use File::Temp 'tempdir';
+my $tmp = tempdir( CLEANUP => 1 );
+
+my $file = $tmp."/".'FooBar.pm';
+my $rolefile = $tmp."/".'FooBarRole.pm';
+push @INC, $tmp;
+
+write_out($rolefile, <<".");
+package FooBarRole;
+use Moose::Role;
+has foo => (is => 'ro', clearer => 'clear_foo');
+sub bar { 'bar' }
+1;
+.
+
+write_out($file, <<".");
+package FooBar;
+use Moose;
+with 'FooBarRole';
+around foo => sub { my (\$orig, \$self) = \@_; return \$self->\$orig . 'role' };
+around bar => sub { my (\$orig, \$self) = \@_; return \$self->\$orig . 'role' };
+1;
+.
+
+use_ok('FooBar', "Required our dummy module");
+
+my $r = MooseX::Module::Refresh->new();
+
+my $foobar = FooBar->new(foo => 'FOO');
+is($foobar->bar, 'barrole', "We got the right result");
+is($foobar->foo, 'FOOrole', "We got the right result");
+
+write_out($rolefile, <<".");
+package FooBarRole; 
+use Moose::Role;
+has baz => (is => 'ro', predicate => 'foo');
+sub bar { 'baz' }
+1;
+.
+
+$foobar = FooBar->new(foo => 'FOO');
+is($foobar->bar, 'barrole', "We got the right result, still");
+is($foobar->foo, 'FOOrole', "We got the right result, still");
+
+$r->refresh;
+
+$foobar = FooBar->new(baz => 'FOO');
+is($foobar->bar, 'bazrole', "We got the right new result");
+is($foobar->baz, 'FOO', "We got the right new result");
+is($foobar->foo, '1role', "We got the right new result");
+ok(!$foobar->can('clear_foo'), "the clear_foo method was removed");
+
+sub write_out {
+    my $file = shift;
+    local *FH;
+    open FH, "> $file" or die "Cannot open $file: $!";
+    print FH $_[0];
+    close FH;
+}
+
+END {
+    unlink $file, $rolefile;
+}