more test tweaks
Dave Rolsky [Mon, 8 Jun 2009 22:22:11 +0000 (17:22 -0500)]
moose-class/exercises/t/01-classes.t
moose-class/exercises/t/lib/MooseClass/Tests.pm

index 67619ce..d4db456 100644 (file)
@@ -1,4 +1,4 @@
-# Your task ...
+# Your tasks ...
 #
 # Create a Person class in lib/Person.pm
 #
index 8bc112d..7c4d338 100644 (file)
@@ -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;