From 08be9e37a8077281197497dae5b56d365afc1cd7 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Sat, 19 Dec 2009 18:09:54 -0600 Subject: add test for roles, and fix subclassing test --- t/003-subclassing.t | 13 +++++++++- t/004-roles.t | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 82 insertions(+), 1 deletion(-) create mode 100644 t/004-roles.t 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; +} -- cgit v1.2.3-54-g00ecf