Redo method modifiers exercise to use before/after/around instead of augment/inner

[gitmo/moose-presentations.git] / moose-class / exercises / t / lib / MooseClass / Tests.pm

diff --git a/moose-class/exercises/t/lib/MooseClass/Tests.pm b/moose-class/exercises/t/lib/MooseClass/Tests.pm
index b7dd57f..d5a86bf 100644 (file)
--- a/moose-class/exercises/t/lib/MooseClass/Tests.pm
+++ b/moose-class/exercises/t/lib/MooseClass/Tests.pm
@@ -121,43 +121,66 @@ sub tests03 {
 }
 
 sub tests04 {
-    has_meta('Document');
-    has_ro_attr( 'Document',  $_ ) for qw( title author );
-
-    has_meta('Report');
-    has_ro_attr( 'Report',    'summary' );
-
-    has_meta('TPSReport');
-    has_ro_attr( 'TPSReport', $_ ) for qw( t p s );
-
-    has_method( 'Document', 'output' );
-    has_augmented_method( 'Report',    'output' );
-    has_augmented_method( 'TPSReport', 'output' );
-
-    my $tps = TPSReport->new(
-        title   => 'That TPS Report',
-        author  => 'Peter Gibbons (for Bill Lumberg)',
-        summary => 'I celebrate his whole collection!',
-        t       => 'PC Load Letter',
-        p       => 'Swingline',
-        s       => 'flair!',
-    );
-
-    my $output = $tps->output;
-    $output =~ s/\n\n+/\n/g;
-
-    is( $output, <<'EOF', 'output returns expected report' );
-That TPS Report
-I celebrate his whole collection!
-t: PC Load Letter
-p: Swingline
-s: flair!
-Written by Peter Gibbons (for Bill Lumberg)
-EOF
-
-    no_droppings('Document');
-    no_droppings('Report');
-    no_droppings('TPSReport');
+    has_meta('Person');
+
+    ok( Person->can('full_name'), 'Person has a full_name() method' )
+        or BAIL_OUT(
+        'Person does not have a full_name() method. Cannot continue testing.'
+        );
+
+    my $meth = Person->meta()->get_method('full_name');
+    ok(
+        $meth && $meth->isa('Class::MOP::Method::Wrapped'),
+        'method modifiers have been applied to the Person->full_name method'
+    );
+
+    is(
+        scalar $meth->before_modifiers,
+        1,
+        'Person->full_name has a single before modifier'
+    );
+
+    is(
+        scalar $meth->after_modifiers,
+        1,
+        'Person->full_name has a single after modifier'
+    );
+
+    my $person = Person->new(
+        first_name => 'Bilbo',
+        last_name  => 'Baggins',
+    );
+
+    is_deeply(
+        \@Person::CALL,
+        [],
+        'Person::CALL global is empty before calling full_name'
+    );
+
+    $person->full_name();
+
+    is_deeply(
+        \@Person::CALL,
+        [ 'calling full_name', 'called full_name' ],
+        'Person::CALL global contains before and after strings'
+    );
+
+    is(
+        scalar $meth->around_modifiers,
+        1,
+        'Person->full_name has a single around modifier'
+    );
+
+    my $larry = Person->new(
+        first_name => 'Larry',
+        last_name  => 'Wall',
+    );
+
+    is(
+        $larry->full_name,
+        '*Larry Wall*',
+        'full_name is wrapped by asterisks when last name is Wall'
+    );
 }
 
 sub tests05 {
@@ -519,10 +542,18 @@ sub person01 {
     );
 
     $person = eval { Person->new( [ qw( Lisa Smith ) ] ) };
-    ok( !$@, 'Person->new() can accept an array reference as an argument' )
-        or BAIL_OUT(
-        'You must implement Person->BUILDARGS in order to continue these tests'
+
+    if ( my $e = $@ ) {
+        diag(
+            "Calling Person->new() with an array reference threw an error:\n$e"
         );
+        BAIL_OUT(
+            'You must implement Person->BUILDARGS correctly in order to continue these tests'
+        );
+    }
+    else {
+        ok( 1, 'Person->new() can accept an array reference as an argument' );
+    }
 
     is( $person->first_name, 'Lisa', 'set first_name from two-arg arrayref' );
     is( $person->last_name, 'Smith', 'set last_name from two-arg arrayref' );
@@ -675,6 +706,12 @@ sub account_tests {
     my $base_amount = shift || 0;
 
     $person->deposit(50);
+
+    is(
+        $person->balance, 50 + $base_amount,
+        "balance is 50 + $base_amount",
+    );
+
     eval { $person->withdraw( 75 + $base_amount ) };
     like(
         $@, qr/\QBalance cannot be negative/,