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' );
}
sub tests02 {
- tests01( person_attr_count => 3 );
+ tests01( person_attr_count => 3, @_ );
local $Test::Builder::Level = $Test::Builder::Level + 1;
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 $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;
- my $article = A($name);
+ my $articled = A($name);
ok( $class->meta->has_attribute($name),
- "$class has $article $name attribute" );
+ "$class has $articled 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;
- my $article = A($name);
+ my $articled = A($name);
ok( $class->meta->has_attribute($name),
- "$class has $article $name attribute" );
+ "$class has $articled 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;
- my $article = A($name);
- ok( $class->meta->has_method($name), "$class has $article $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;
- my $article = A($name);
- ok( $class->meta->has_method($name), "$class has $article $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' );
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 {
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'
- );
+ is( $employee->full_name, 'Amanda Palmer (Singer)', 'full_name() is properly overriden in Employee' );
}
sub person02 {
balance => 0,
);
- is(
- $person->as_string, 'Bilbo Baggins',
- 'as-string() is correctly implemented'
- );
+ is( $person->as_string, 'Bilbo Baggins',
+ 'as_string() is correctly implemented' );
account_tests($person);
}
my $employee = Employee->new(
first_name => 'Amanda',
last_name => 'Palmer',
- position => 'Singer',
+ title => 'Singer',
balance => 0,
);
- is(
- $employee->as_string, 'Amanda Palmer (Singer)',
- 'as_string() uses overridden full_name method 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) };
- like(
- $@, qr/\QBalance cannot be negative/,
- 'cannot withdraw more than is in our balance'
- );
+ eval { $person->withdraw( 75 + $base_amount ) };
+ like( $@, qr/\QBalance cannot be negative/,
+ 'cannot withdraw more than is in our balance' );
- $person->withdraw(23);
+ $person->withdraw( 23 );
- is( $person->balance, 27,
- 'balance is 25 after deposit of 50 and withdrawal of 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