From: Nick Woolley <nick@noodlefactory.co.uk>
Date: Tue, 31 Mar 2009 19:10:25 +0000 (+0100)
Subject: Added a new test, essentially the code posted in RT bug #42992.  It
X-Git-Tag: 0.20~57
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=51212d90d006b7d5b497f54b805482f9b14e34e7;p=gitmo%2FMouse.git

Added a new test, essentially the code posted in RT bug #42992.  It
still fails pending the bug in Class::Method::Modifiers (RT #43167)
being fixed, so marked as "TODO".
---

diff --git a/t/000-recipes/002_schwartz_tutorial.t b/t/000-recipes/002_schwartz_tutorial.t
new file mode 100755
index 0000000..cad54b4
--- /dev/null
+++ b/t/000-recipes/002_schwartz_tutorial.t
@@ -0,0 +1,147 @@
+#!/usr/bin/perl
+
+# This adapted from the tutorial here:
+# http://www.stonehenge.com/merlyn/LinuxMag/col94.html
+# The Moose is Flying (part 1)'
+# Using Mouse, instead
+
+# use feature ':5.10';
+
+
+use strict;
+use warnings;
+
+# functions to capture the output of the tutorial
+our $DUMMY_STDOUT = "";
+sub dprint { $DUMMY_STDOUT .= join "", @_ };
+sub stdout { my $stdout = $DUMMY_STDOUT; $DUMMY_STDOUT = ""; return $stdout }
+sub say    { ::dprint $_, "\n" for @_ }
+
+######################################################################
+# This is the tutorial, as posted by Heikki Lehvaslaiho in Mouse's RT
+# ticket #42992, except with print and say modified to use the above.
+
+package Animal;
+use Mouse::Role;
+has 'name' => (is => 'rw');
+sub speak {
+    my $self = shift;
+    ::dprint $self->name, " goes ", $self->sound, "\n";
+}
+requires 'sound';
+has 'color' => (is => 'rw', default => sub { shift->default_color });
+requires 'default_color';
+no Mouse::Role;
+1;
+
+## Cow.pm:
+package Cow;
+use Mouse;
+with 'Animal';
+sub default_color { 'spotted' }
+sub sound { 'moooooo' }
+no Mouse;
+1;
+## Horse.pm:
+package Horse;
+use Mouse;
+with 'Animal';
+sub default_color { 'brown' }
+sub sound { 'neigh' }
+no Mouse;
+1;
+## Sheep.pm:
+package Sheep;
+use Mouse;
+with 'Animal';
+sub default_color { 'black' }
+sub sound { 'baaaah' }
+no Mouse;
+1;
+
+package MouseA;
+use Mouse;
+with 'Animal';
+sub default_color { 'white' }
+sub sound { 'squeak' }
+after 'speak' => sub {
+    ::dprint "[but you can barely hear it!]\n";
+};
+before 'speak' => sub {
+    ::dprint "[Ahem]\n";
+};
+no Mouse;
+1;
+
+
+
+package Racer;
+use Mouse::Role;
+has $_ => (is => 'rw', default => 0)
+    foreach qw(wins places shows losses);
+sub won { my $self = shift; $self->wins($self->wins + 1) }
+sub placed { my $self = shift; $self->places($self->places + 1) }
+sub showed { my $self = shift; $self->shows($self->shows + 1) }
+sub lost { my $self = shift; $self->losses($self->losses + 1) }
+sub standings {
+    my $self = shift;
+    join ", ", map { $self->$_ . " $_" } qw(wins places shows losses);
+}
+no Mouse::Role;
+1;
+
+
+
+# To create the race horse, we just mix a horse with a racer:
+
+package RaceHorse;
+use Mouse;
+extends 'Horse';
+with 'Racer';
+no Mouse;
+1;
+
+
+######################################################################
+# Now the tests
+package main;
+use Test::More tests => 5;
+
+#use Horse;
+my $talking = Horse->new(name => 'Mr. Ed');
+say $talking->name;             # prints Mr. Ed
+is stdout, "Mr. Ed\n";
+$talking->color("grey");        # sets the color
+$talking->speak;                # says "Mr. Ed goes neigh"
+
+TODO: { local $TODO = "this currently fails because of a bug in Class::Method::Modifiers (see RT #42992)";
+is stdout, <<EXPECTED;
+Mr. Ed goes neigh
+EXPECTED
+
+
+#use Sheep;
+my $baab = Sheep->new(color => 'white', name => 'Baab');
+$baab->speak;                   # prints "Baab goes baaaah"
+is stdout, <<EXPECTED;
+Baab goes baaaah
+EXPECTED
+    }
+
+#use MouseA
+my $mickey = MouseA->new(name => 'Mickey');
+$mickey->speak;
+is stdout, <<EXPECTED;
+[Ahem]
+Mickey goes squeak
+[but you can barely hear it!]
+EXPECTED
+
+#use RaceHorse;
+my $s = RaceHorse->new(name => 'Seattle Slew');
+$s->won; $s->won; $s->won; $s->placed; $s->lost; # run some races
+::dprint $s->standings, "\n";      # 3 wins, 1 places, 0 shows, 1 losses
+is stdout, <<EXPECTED;
+3 wins, 1 places, 0 shows, 1 losses
+EXPECTED
+