use warnings;
use Lingua::EN::Inflect qw( A PL_N );
+use Scalar::Util qw( blessed );
use Test::More 'no_plan';
sub tests01 {
no_droppings('Person');
is_immutable('Person');
+
+ no_droppings('Employee');
+ is_immutable('Employee');
}
sub tests02 {
}
ok(
- $history_attr->meta()
+ $history_attr->meta()->can('does_role')
+ && $history_attr->meta()
->does_role('Moose::Meta::Attribute::Native::Trait::Array'),
'BankAccount history attribute uses native delegation to an array ref'
);
);
my $deposit_meth = $person_meta->get_method('deposit');
- isa_ok( $deposit_meth, 'Moose::Meta::Method::Delegation' );
+ _my_isa_ok(
+ $deposit_meth, 'Moose::Meta::Method::Delegation',
+ 'The Person->deposit method exists and is a delegation method'
+ );
my $withdraw_meth = $person_meta->get_method('withdraw');
- isa_ok( $withdraw_meth, 'Moose::Meta::Method::Delegation' );
+ _my_isa_ok(
+ $withdraw_meth, 'Moose::Meta::Method::Delegation',
+ 'The Person->withdraw method exists and is a delegation method'
+ );
person06();
local $Test::Builder::Level = $Test::Builder::Level + 1;
- use_ok($package)
- or BAIL_OUT("$package cannot be loaded");
+ {
+ my @warn;
+ local $SIG{__WARN__} = sub { push @warn, @_ };
+
+ use_ok($package)
+ or BAIL_OUT("$package cannot be loaded");
+
+ BAIL_OUT("Warning when loading $package: @warn")
+ if @warn;
+ }
ok( $package->can('meta'), "$package has a meta() method" )
or BAIL_OUT(
ok( $package->meta->has_method($name), "$package has $articled method" );
my $meth = $package->meta->get_method($name);
- isa_ok( $meth, 'Moose::Meta::Method::Overridden' );
-}
-
-sub has_augmented_method {
- my $class = shift;
- my $name = shift;
-
- local $Test::Builder::Level = $Test::Builder::Level + 1;
-
- 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::Augmented' );
+ _my_isa_ok(
+ $meth, 'Moose::Meta::Method::Overridden',
+ "The $name method is an overridden method"
+ );
}
sub requires_method {
}
sub person06 {
+ my $account = BankAccount->new();
+
my $person = Person->new(
first_name => 'Bilbo',
last_name => 'Baggins',
+ account => $account,
+ );
+
+ is(
+ $person->account, $account,
+ 'account object passed to Person->new is still in object'
+ );
+
+ _my_isa_ok(
+ $person->account, 'BankAccount',
+ 'The value of $person->account() isa BankAccount object'
);
- isa_ok( $person->account, 'BankAccount' );
is(
$person->account->owner, $person,
'owner of bank account is person that created account'
);
}
+sub _my_isa_ok {
+ my $thing = shift;
+ my $class = shift;
+ my $desc = shift;
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+ ok(
+ $thing && ( blessed $thing || !ref $thing ) && $thing->isa($class),
+ $desc
+ );
+}
+
1;