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 );
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_rw_attr( 'Employee', $_ ) for qw( title salary );
has_ro_attr( 'Employee', 'ssn' );
has_overridden_method( 'Employee', 'full_name' );
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 tests03 {
+ {
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+ has_meta('Person');
+ has_meta('Employee');
+
+ has_rw_attr( 'Person', 'title' );
+
+ has_rw_attr( 'Employee', 'title' );
+ has_rw_attr( 'Employee', 'salary_level' );
+ has_ro_attr( 'Employee', 'salary' );
+
+ has_method( 'Employee', '_build_salary' );
+ }
+
+ ok( ! Employee->meta->has_method('full_name'),
+ 'Employee no longer implements a full_name method' );
+
+ my $person_title_attr = Person->meta->get_attribute('title');
+ ok( !$person_title_attr->is_required, 'title is not required in Person' );
+ is( $person_title_attr->predicate, 'has_title',
+ 'Person title attr has a has_title predicate' );
+ is( $person_title_attr->clearer, 'clear_title',
+ 'Person title attr has a clear_title clearer' );
+
+ my $balance_attr = Person->meta->get_attribute('balance');
+ is( $balance_attr->default, 100, 'balance defaults to 100' );
+
+ my $employee_title_attr = Employee->meta->get_attribute('title');
+ is( $employee_title_attr->default, 'Worker',
+ 'title defaults to Worker in Employee' );
+
+ my $salary_level_attr = Employee->meta->get_attribute('salary_level');
+ is( $salary_level_attr->default, 1, 'salary_level defaults to 1' );
+
+ my $salary_attr = Employee->meta->get_attribute('salary');
+ ok( !$salary_attr->init_arg, 'no init_arg for salary attribute' );
+ ok( $salary_attr->has_builder, 'salary attr has a builder' );
+
+ person03();
+ employee03();
+}
+
sub has_meta {
my $class = shift;
my $class = shift;
my $name = shift;
- ok( $class->meta->has_attribute($name), "$class has attribute - $name" );
+ my $articled = A($name);
+ ok( $class->meta->has_attribute($name),
+ "$class has $articled attribute" );
my $attr = $class->meta->get_attribute($name);
my $class = shift;
my $name = shift;
- ok( $class->meta->has_attribute($name), "$class has attribute - $name" );
+ my $articled = A($name);
+ ok( $class->meta->has_attribute($name),
+ "$class has $articled attribute" );
my $attr = $class->meta->get_attribute($name);
my $class = shift;
my $name = shift;
- ok( $class->meta->has_method($name), "$class has a $name method" );
+ my $articled = A($name);
+ ok( $class->meta->has_method($name), "$class has $articled method" );
}
sub has_overridden_method {
my $class = shift;
my $name = shift;
- ok( $class->meta->has_method($name), "$class has a $name method" );
+ my $articled = A($name);
+ ok( $class->meta->has_method($name), "$class has $articled method" );
my $meth = $class->meta->get_method($name);
isa_ok( $meth, 'Moose::Meta::Method::Overridden' );
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',
my $employee = Employee->new(
first_name => 'Amanda',
last_name => 'Palmer',
- position => 'Singer',
+ title => 'Singer',
+ );
+
+ 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',
+ title => 'Singer',
+ balance => 0,
);
- is( $employee->full_name, 'Amanda Palmer (Singer)',
- 'full_name() is properly overriden in Employee' );
+ is( $employee->as_string, 'Amanda Palmer (Singer)',
+ 'as_string() uses overridden full_name method in Employee' );
+
+ account_tests($employee);
}
+sub person03 {
+ my $person = Person->new(
+ first_name => 'Bilbo',
+ last_name => 'Baggins',
+ );
+
+ is( $person->full_name, 'Bilbo Baggins',
+ 'full_name() is correctly implemented for a Person without a title' );
+ ok( !$person->has_title,
+ 'Person has_title predicate is working correctly' );
+
+ $person->title('Ringbearer');
+ ok( $person->has_title, 'Person has_title predicate is working correctly' );
+ is( $person->full_name, 'Bilbo Baggins (Ringbearer)',
+ 'full_name() is correctly implemented for a Person with a title' );
+
+ $person->clear_title;
+ ok( !$person->has_title, 'Person clear_title method cleared the title' );
+
+ account_tests( $person, 100 );
+}
+
+sub employee03 {
+ my $employee = Employee->new(
+ first_name => 'Jimmy',
+ last_name => 'Foo',
+ salary_level => 3,
+ salary => 42,
+ );
+
+ is( $employee->salary, 30000,
+ 'salary is calculated from salary_level, and salary passed to constructor is ignored' );
+}
+
+sub account_tests {
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+ my $person = shift;
+ my $base_amount = shift || 0;
+
+ $person->deposit(50);
+ eval { $person->withdraw( 75 + $base_amount ) };
+ like( $@, qr/\QBalance cannot be negative/,
+ 'cannot withdraw more than is in our balance' );
+
+ $person->withdraw( 23 );
+
+ is( $person->balance, 27 + $base_amount,
+ 'balance is 27 (+ starting balance) after deposit of 50 and withdrawal of 23' );
+}
1;
projects / gitmo/moose-presentations.git / blobdiff