From: Dave Rolsky Date: Mon, 8 Jun 2009 22:22:11 +0000 (-0500) Subject: more test tweaks X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5cab7e05b31032373bbe1349c4675fb8e20c45fb;p=gitmo%2Fmoose-presentations.git more test tweaks --- diff --git a/moose-class/exercises/t/01-classes.t b/moose-class/exercises/t/01-classes.t index 67619ce..d4db456 100644 --- a/moose-class/exercises/t/01-classes.t +++ b/moose-class/exercises/t/01-classes.t @@ -1,4 +1,4 @@ -# Your task ... +# Your tasks ... # # Create a Person class in lib/Person.pm # diff --git a/moose-class/exercises/t/lib/MooseClass/Tests.pm b/moose-class/exercises/t/lib/MooseClass/Tests.pm index 8bc112d..7c4d338 100644 --- a/moose-class/exercises/t/lib/MooseClass/Tests.pm +++ b/moose-class/exercises/t/lib/MooseClass/Tests.pm @@ -3,17 +3,23 @@ package MooseClass::Tests; use strict; use warnings; -use Lingua::EN::Inflect qw( PL_N ); +use Lingua::EN::Inflect qw( A PL_N ); use Test::More 'no_plan'; sub tests01 { + my %p = ( + person_attr_count => 2, + employee_attr_count => 3, + @_, + ); + local $Test::Builder::Level = $Test::Builder::Level + 1; has_meta('Person'); check_isa( 'Person', ['Moose::Object'] ); - count_attrs( 'Person', 2 ); + count_attrs( 'Person', $p{person_attr_count} ); has_rw_attr( 'Person', $_ ) for qw( first_name last_name ); @@ -28,7 +34,7 @@ sub tests01 { check_isa( 'Employee', [ 'Person', 'Moose::Object' ] ); - count_attrs( 'Employee', 3 ); + count_attrs( 'Employee', $p{employee_attr_count} ); has_rw_attr( 'Employee', $_ ) for qw( position salary ); has_ro_attr( 'Employee', 'ssn' ); @@ -38,6 +44,23 @@ sub tests01 { employee01(); } +sub tests02 { + tests01( person_attr_count => 3 ); + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + no_droppings($_) for qw( Printable HasAccount ); + + does_role( 'Person', $_ ) for qw( Printable HasAccount ); + has_method( 'Person', $_ ) for qw( as_string deposit withdraw ); + has_rw_attr( 'Person', 'balance' ); + + does_role( 'Employee', $_ ) for qw( Printable HasAccount ); + + person02(); + employee02(); +} + sub has_meta { my $class = shift; @@ -67,50 +90,66 @@ sub count_attrs { my $count = shift; my $noun = PL_N( 'attribute', $count ); - is( scalar $class->meta->get_attribute_list, $count, - "$class defines $count $noun" ); + is( + scalar $class->meta->get_attribute_list, $count, + "$class defines $count $noun" + ); } sub has_rw_attr { my $class = shift; my $name = shift; - ok( $class->meta->has_attribute($name), "$class has attribute - $name" ); + my $article = A($name); + ok( $class->meta->has_attribute($name), + "$class has $article $name attribute" ); my $attr = $class->meta->get_attribute($name); - is( $attr->get_read_method, $name, - "$name attribute has a reader accessor - $name()" ); - is( $attr->get_write_method, $name, - "$name attribute has a writer accessor - $name()" ); + is( + $attr->get_read_method, $name, + "$name attribute has a reader accessor - $name()" + ); + is( + $attr->get_write_method, $name, + "$name attribute has a writer accessor - $name()" + ); } sub has_ro_attr { my $class = shift; my $name = shift; - ok( $class->meta->has_attribute($name), "$class has attribute - $name" ); + my $article = A($name); + ok( $class->meta->has_attribute($name), + "$class has $article $name attribute" ); my $attr = $class->meta->get_attribute($name); - is( $attr->get_read_method, $name, - "$name attribute has a reader accessor - $name()" ); - is( $attr->get_write_method, undef, - "$name attribute does not have a writer" ); + is( + $attr->get_read_method, $name, + "$name attribute has a reader accessor - $name()" + ); + is( + $attr->get_write_method, undef, + "$name attribute does not have a writer" + ); } sub has_method { my $class = shift; my $name = shift; - ok( $class->meta->has_method($name), "$class has a $name method" ); + my $article = A($name); + ok( $class->meta->has_method($name), "$class has $article $name method" ); } sub has_overridden_method { my $class = shift; my $name = shift; - ok( $class->meta->has_method($name), "$class has a $name method" ); + my $article = A($name); + ok( $class->meta->has_method($name), "$class has $article $name method" ); my $meth = $class->meta->get_method($name); isa_ok( $meth, 'Moose::Meta::Method::Overridden' ); @@ -128,14 +167,23 @@ sub is_immutable { ok( $class->meta->is_immutable, "$class has been made immutable" ); } +sub does_role { + my $class = shift; + my $role = shift; + + ok( $class->meta->does_role($role), "$class does the $role role" ); +} + sub person01 { my $person = Person->new( first_name => 'Bilbo', last_name => 'Baggins', ); - is( $person->full_name, 'Bilbo Baggins', - 'full_name() is correctly implemented' ); + is( + $person->full_name, 'Bilbo Baggins', + 'full_name() is correctly implemented' + ); } sub employee01 { @@ -145,9 +193,59 @@ sub employee01 { position => 'Singer', ); - is( $employee->full_name, 'Amanda Palmer (Singer)', - 'full_name() is properly overriden in Employee' ); + is( + $employee->full_name, 'Amanda Palmer (Singer)', + 'full_name() is properly overriden in Employee' + ); } +sub person02 { + my $person = Person->new( + first_name => 'Bilbo', + last_name => 'Baggins', + balance => 0, + ); + + is( + $person->as_string, 'Bilbo Baggins', + 'as-string() is correctly implemented' + ); + + account_tests($person); +} + +sub employee02 { + my $employee = Employee->new( + first_name => 'Amanda', + last_name => 'Palmer', + position => 'Singer', + balance => 0, + ); + + is( + $employee->as_string, 'Amanda Palmer (Singer)', + 'as_string() uses overridden full_name method in Employee' + ); + + account_tests($employee); +} + +sub account_tests { + local $Test::Builder::Level = $Test::Builder::Level + 1; + + my $person = shift; + + $person->deposit(50); + eval { $person->withdraw(75) }; + like( + $@, qr/\QBalance cannot be negative/, + 'cannot withdraw more than is in our balance' + ); + + $person->withdraw(23); + + is( $person->balance, 27, + 'balance is 25 after deposit of 50 and withdrawal of 23' ); +} 1;