From: gfx <gfuji@cpan.org>
Date: Fri, 9 Oct 2009 05:39:26 +0000 (+0900)
Subject: Add 4 recipe tests
X-Git-Tag: 0.37_05~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f9aca0f35658e5e0657e8ce78b783c0185d59969;p=gitmo%2FMouse.git

Add 4 recipe tests
---

diff --git a/t/000_recipes/moose_cookbook_basics_recipe6.t b/t/000_recipes/moose_cookbook_basics_recipe6.t
new file mode 100644
index 0000000..485abcf
--- /dev/null
+++ b/t/000_recipes/moose_cookbook_basics_recipe6.t
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+use Test::Exception;
+$| = 1;
+
+
+
+# =begin testing SETUP
+{
+
+  package Document::Page;
+  use Mouse;
+
+  has 'body' => ( is => 'rw', isa => 'Str', default => sub {''} );
+
+  sub create {
+      my $self = shift;
+      $self->open_page;
+      inner();
+      $self->close_page;
+  }
+
+  sub append_body {
+      my ( $self, $appendage ) = @_;
+      $self->body( $self->body . $appendage );
+  }
+
+  sub open_page  { (shift)->append_body('<page>') }
+  sub close_page { (shift)->append_body('</page>') }
+
+  package Document::PageWithHeadersAndFooters;
+  use Mouse;
+
+  extends 'Document::Page';
+
+  augment 'create' => sub {
+      my $self = shift;
+      $self->create_header;
+      inner();
+      $self->create_footer;
+  };
+
+  sub create_header { (shift)->append_body('<header/>') }
+  sub create_footer { (shift)->append_body('<footer/>') }
+
+  package TPSReport;
+  use Mouse;
+
+  extends 'Document::PageWithHeadersAndFooters';
+
+  augment 'create' => sub {
+      my $self = shift;
+      $self->create_tps_report;
+      inner();
+  };
+
+  sub create_tps_report {
+      (shift)->append_body('<report type="tps"/>');
+  }
+
+  # <page><header/><report type="tps"/><footer/></page>
+  my $report_xml = TPSReport->new->create;
+}
+
+
+
+# =begin testing
+{
+my $tps_report = TPSReport->new;
+isa_ok( $tps_report, 'TPSReport' );
+
+is(
+    $tps_report->create,
+    q{<page><header/><report type="tps"/><footer/></page>},
+    '... got the right TPS report'
+);
+}
+
+
+
+
+1;
diff --git a/t/000_recipes/moose_cookbook_extending_recipe3.t b/t/000_recipes/moose_cookbook_extending_recipe3.t
new file mode 100644
index 0000000..7470380
--- /dev/null
+++ b/t/000_recipes/moose_cookbook_extending_recipe3.t
@@ -0,0 +1,75 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+use Test::Exception;
+$| = 1;
+
+
+
+# =begin testing SETUP
+BEGIN {
+    eval 'use Test::Output;';
+    if ($@) {
+        diag 'Test::Output is required for this test';
+        ok(1);
+        exit 0;
+    }
+}
+
+
+
+# =begin testing SETUP
+{
+
+  package MyApp::Base;
+  use Mouse;
+
+  extends 'Mouse::Object';
+
+  before 'new' => sub { warn "Making a new " . $_[0] };
+
+  no Mouse;
+
+  package MyApp::UseMyBase;
+  use Mouse ();
+  use Mouse::Exporter;
+
+  Mouse::Exporter->setup_import_methods( also => 'Mouse' );
+
+  sub init_meta {
+      shift;
+      return Mouse->init_meta( @_, base_class => 'MyApp::Base' );
+  }
+}
+
+
+
+# =begin testing
+{
+{
+    package Foo;
+
+    MyApp::UseMyBase->import;
+
+    has( 'size' => ( is => 'rw' ) );
+}
+
+ok( Foo->isa('MyApp::Base'), 'Foo isa MyApp::Base' );
+
+ok( Foo->can('size'), 'Foo has a size method' );
+
+my $foo;
+stderr_like(
+    sub { $foo = Foo->new( size => 2 ) },
+    qr/^Making a new Foo/,
+    'got expected warning when calling Foo->new'
+);
+
+is( $foo->size(), 2, '$foo->size is 2' );
+}
+
+
+
+
+1;
diff --git a/t/000_recipes/moose_cookbook_roles_recipe1.t b/t/000_recipes/moose_cookbook_roles_recipe1.t
new file mode 100644
index 0000000..0a6a3b4
--- /dev/null
+++ b/t/000_recipes/moose_cookbook_roles_recipe1.t
@@ -0,0 +1,203 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+use Test::Exception;
+$| = 1;
+
+
+
+# =begin testing SETUP
+{
+
+  package Eq;
+  use Mouse::Role;
+
+  requires 'equal_to';
+
+  sub not_equal_to {
+      my ( $self, $other ) = @_;
+      not $self->equal_to($other);
+  }
+
+  package Comparable;
+  use Mouse::Role;
+
+  with 'Eq';
+
+  requires 'compare';
+
+  sub equal_to {
+      my ( $self, $other ) = @_;
+      $self->compare($other) == 0;
+  }
+
+  sub greater_than {
+      my ( $self, $other ) = @_;
+      $self->compare($other) == 1;
+  }
+
+  sub less_than {
+      my ( $self, $other ) = @_;
+      $self->compare($other) == -1;
+  }
+
+  sub greater_than_or_equal_to {
+      my ( $self, $other ) = @_;
+      $self->greater_than($other) || $self->equal_to($other);
+  }
+
+  sub less_than_or_equal_to {
+      my ( $self, $other ) = @_;
+      $self->less_than($other) || $self->equal_to($other);
+  }
+
+  package Printable;
+  use Mouse::Role;
+
+  requires 'to_string';
+
+  package US::Currency;
+  use Mouse;
+
+  with 'Comparable', 'Printable';
+
+  has 'amount' => ( is => 'rw', isa => 'Num', default => 0 );
+
+  sub compare {
+      my ( $self, $other ) = @_;
+      $self->amount <=> $other->amount;
+  }
+
+  sub to_string {
+      my $self = shift;
+      sprintf '$%0.2f USD' => $self->amount;
+  }
+}
+
+
+
+# =begin testing
+{
+ok( US::Currency->does('Comparable'), '... US::Currency does Comparable' );
+ok( US::Currency->does('Eq'),         '... US::Currency does Eq' );
+ok( US::Currency->does('Printable'),  '... US::Currency does Printable' );
+
+my $hundred = US::Currency->new( amount => 100.00 );
+isa_ok( $hundred, 'US::Currency' );
+{
+local $TODO = 'UNIVERSAL::DOES is not supported';
+ok( $hundred->DOES("US::Currency"), "UNIVERSAL::DOES for class" );
+ok( $hundred->DOES("Comparable"),   "UNIVERSAL::DOES for role" );
+}
+can_ok( $hundred, 'amount' );
+is( $hundred->amount, 100, '... got the right amount' );
+
+can_ok( $hundred, 'to_string' );
+is( $hundred->to_string, '$100.00 USD',
+    '... got the right stringified value' );
+
+ok( $hundred->does('Comparable'), '... US::Currency does Comparable' );
+ok( $hundred->does('Eq'),         '... US::Currency does Eq' );
+ok( $hundred->does('Printable'),  '... US::Currency does Printable' );
+
+my $fifty = US::Currency->new( amount => 50.00 );
+isa_ok( $fifty, 'US::Currency' );
+
+can_ok( $fifty, 'amount' );
+is( $fifty->amount, 50, '... got the right amount' );
+
+can_ok( $fifty, 'to_string' );
+is( $fifty->to_string, '$50.00 USD', '... got the right stringified value' );
+
+ok( $hundred->greater_than($fifty),             '... 100 gt 50' );
+ok( $hundred->greater_than_or_equal_to($fifty), '... 100 ge 50' );
+ok( !$hundred->less_than($fifty),               '... !100 lt 50' );
+ok( !$hundred->less_than_or_equal_to($fifty),   '... !100 le 50' );
+ok( !$hundred->equal_to($fifty),                '... !100 eq 50' );
+ok( $hundred->not_equal_to($fifty),             '... 100 ne 50' );
+
+ok( !$fifty->greater_than($hundred),             '... !50 gt 100' );
+ok( !$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100' );
+ok( $fifty->less_than($hundred),                 '... 50 lt 100' );
+ok( $fifty->less_than_or_equal_to($hundred),     '... 50 le 100' );
+ok( !$fifty->equal_to($hundred),                 '... !50 eq 100' );
+ok( $fifty->not_equal_to($hundred),              '... 50 ne 100' );
+
+ok( !$fifty->greater_than($fifty),            '... !50 gt 50' );
+ok( $fifty->greater_than_or_equal_to($fifty), '... !50 ge 50' );
+ok( !$fifty->less_than($fifty),               '... 50 lt 50' );
+ok( $fifty->less_than_or_equal_to($fifty),    '... 50 le 50' );
+ok( $fifty->equal_to($fifty),                 '... 50 eq 50' );
+ok( !$fifty->not_equal_to($fifty),            '... !50 ne 50' );
+
+## ... check some meta-stuff
+
+# Eq
+
+my $eq_meta = Eq->meta;
+isa_ok( $eq_meta, 'Mouse::Meta::Role' );
+
+ok( $eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to' );
+ok( $eq_meta->requires_method('equal_to'),
+    '... Eq requires_method not_equal_to' );
+
+# Comparable
+
+my $comparable_meta = Comparable->meta;
+isa_ok( $comparable_meta, 'Mouse::Meta::Role' );
+
+ok( $comparable_meta->does_role('Eq'), '... Comparable does Eq' );
+
+foreach my $method_name (
+    qw(
+    equal_to not_equal_to
+    greater_than greater_than_or_equal_to
+    less_than less_than_or_equal_to
+    )
+    ) {
+    ok( $comparable_meta->has_method($method_name),
+        '... Comparable has_method ' . $method_name );
+}
+
+ok( $comparable_meta->requires_method('compare'),
+    '... Comparable requires_method compare' );
+
+# Printable
+
+my $printable_meta = Printable->meta;
+isa_ok( $printable_meta, 'Mouse::Meta::Role' );
+
+ok( $printable_meta->requires_method('to_string'),
+    '... Printable requires_method to_string' );
+
+# US::Currency
+
+my $currency_meta = US::Currency->meta;
+isa_ok( $currency_meta, 'Mouse::Meta::Class' );
+
+ok( $currency_meta->does_role('Comparable'),
+    '... US::Currency does Comparable' );
+ok( $currency_meta->does_role('Eq'), '... US::Currency does Eq' );
+ok( $currency_meta->does_role('Printable'),
+    '... US::Currency does Printable' );
+
+foreach my $method_name (
+    qw(
+    amount
+    equal_to not_equal_to
+    compare
+    greater_than greater_than_or_equal_to
+    less_than less_than_or_equal_to
+    to_string
+    )
+    ) {
+    ok( $currency_meta->has_method($method_name),
+        '... US::Currency has_method ' . $method_name );
+}
+}
+
+
+
+
+1;
diff --git a/t/000_recipes/moose_cookbook_roles_recipe3.t b/t/000_recipes/moose_cookbook_roles_recipe3.t
new file mode 100644
index 0000000..750a543
--- /dev/null
+++ b/t/000_recipes/moose_cookbook_roles_recipe3.t
@@ -0,0 +1,96 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+use Test::Exception;
+$| = 1;
+
+
+
+# =begin testing SETUP
+{
+    # Not in the recipe, but needed for writing tests.
+    package Employee;
+
+    use Mouse;
+
+    has 'name' => (
+        is       => 'ro',
+        isa      => 'Str',
+        required => 1,
+    );
+
+    has 'work' => (
+        is        => 'rw',
+        isa       => 'Str',
+        predicate => 'has_work',
+    );
+}
+
+
+
+# =begin testing SETUP
+{
+
+  package MyApp::Role::Job::Manager;
+
+  use List::Util qw( first );
+
+  use Mouse::Role;
+
+  has 'employees' => (
+      is  => 'rw',
+      isa => 'ArrayRef[Employee]',
+  );
+
+  sub assign_work {
+      my $self = shift;
+      my $work = shift;
+
+      my $employee = first { !$_->has_work } @{ $self->employees };
+
+      die 'All my employees have work to do!' unless $employee;
+
+      $employee->work($work);
+  }
+
+  package main;
+
+  my $lisa = Employee->new( name => 'Lisa' );
+  MyApp::Role::Job::Manager->meta->apply($lisa);
+
+  my $homer = Employee->new( name => 'Homer' );
+  my $bart  = Employee->new( name => 'Bart' );
+  my $marge = Employee->new( name => 'Marge' );
+
+  $lisa->employees( [ $homer, $bart, $marge ] );
+  $lisa->assign_work('mow the lawn');
+}
+
+
+
+# =begin testing
+{
+{
+    my $lisa = Employee->new( name => 'Lisa' );
+    MyApp::Role::Job::Manager->meta->apply($lisa);
+
+    my $homer = Employee->new( name => 'Homer' );
+    my $bart  = Employee->new( name => 'Bart' );
+    my $marge = Employee->new( name => 'Marge' );
+
+    $lisa->employees( [ $homer, $bart, $marge ] );
+    $lisa->assign_work('mow the lawn');
+
+    ok( $lisa->does('MyApp::Role::Job::Manager'),
+        'lisa now does the manager role' );
+
+    is( $homer->work, 'mow the lawn',
+        'homer was assigned a task by lisa' );
+}
+}
+
+
+
+
+1;