-#!/usr/bin/perl
-
use strict;
use warnings;
-use Test::More tests => 76;
+use Test::More tests => 91;
use Test::Exception;
-BEGIN {
- use_ok('Class::MOP');
- use_ok('Class::MOP::Class::Immutable');
-}
+use Class::MOP;
+
{
package Foo;
-
+
use strict;
use warnings;
use metaclass;
-
+
__PACKAGE__->meta->add_attribute('bar' => (
reader => 'bar',
default => 'BAR',
));
-
+
package Bar;
-
+
use strict;
use warnings;
use metaclass;
-
+
__PACKAGE__->meta->superclasses('Foo');
__PACKAGE__->meta->add_attribute('baz' => (
reader => 'baz',
default => sub { 'BAZ' },
- ));
-
+ ));
+
package Baz;
-
+
use strict;
use warnings;
use metaclass;
-
+
__PACKAGE__->meta->superclasses('Bar');
__PACKAGE__->meta->add_attribute('bah' => (
reader => 'bah',
default => 'BAH',
- ));
+ ));
+
+ package Buzz;
+
+ use strict;
+ use warnings;
+ use metaclass;
+
+
+ __PACKAGE__->meta->add_attribute('bar' => (
+ accessor => 'bar',
+ predicate => 'has_bar',
+ clearer => 'clear_bar',
+ ));
+
+ __PACKAGE__->meta->add_attribute('bah' => (
+ accessor => 'bah',
+ predicate => 'has_bah',
+ clearer => 'clear_bah',
+ default => 'BAH'
+ ));
+
}
{
my $meta = Foo->meta;
is($meta->name, 'Foo', '... checking the Foo metaclass');
-
+
{
my $bar_accessor = $meta->get_method('bar');
isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
- isa_ok($bar_accessor, 'Class::MOP::Method');
-
- ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
+ isa_ok($bar_accessor, 'Class::MOP::Method');
+
+ ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
}
-
- ok(!$meta->is_immutable, '... our class is not immutable');
+
+ ok(!$meta->is_immutable, '... our class is not immutable');
lives_ok {
$meta->make_immutable(
inline_constructor => 1,
- inline_accessors => 0,
+ inline_accessors => 0,
);
} '... changed Foo to be immutable';
- ok($meta->is_immutable, '... our class is now immutable');
- isa_ok($meta, 'Class::MOP::Class::Immutable');
- isa_ok($meta, 'Class::MOP::Class');
-
+ ok($meta->is_immutable, '... our class is now immutable');
+ isa_ok($meta, 'Class::MOP::Class');
+
# they made a constructor for us :)
can_ok('Foo', 'new');
-
+
{
my $foo = Foo->new;
isa_ok($foo, 'Foo');
is($foo->bar, 'BAR', '... got the right default value');
}
-
+
{
my $foo = Foo->new(bar => 'BAZ');
isa_ok($foo, 'Foo');
is($foo->bar, 'BAZ', '... got the right parameter value');
- }
+ }
+
+ # NOTE:
+ # check that the constructor correctly handles inheritance
+ {
+ my $bar = Bar->new();
+ isa_ok($bar, 'Bar');
+ isa_ok($bar, 'Foo');
+ is($bar->bar, 'BAR', '... got the right inherited parameter value');
+ is($bar->baz, 'BAZ', '... got the right inherited parameter value');
+ }
# check out accessors too
{
my $bar_accessor = $meta->get_method('bar');
isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
- isa_ok($bar_accessor, 'Class::MOP::Method');
-
- ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
+ isa_ok($bar_accessor, 'Class::MOP::Method');
+
+ ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
}
}
{
my $meta = Bar->meta;
is($meta->name, 'Bar', '... checking the Bar metaclass');
-
+
{
my $bar_accessor = $meta->find_method_by_name('bar');
isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
- isa_ok($bar_accessor, 'Class::MOP::Method');
-
- ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
-
+ isa_ok($bar_accessor, 'Class::MOP::Method');
+
+ ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
+
my $baz_accessor = $meta->get_method('baz');
isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
- isa_ok($baz_accessor, 'Class::MOP::Method');
-
- ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');
+ isa_ok($baz_accessor, 'Class::MOP::Method');
+
+ ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');
}
-
- ok(!$meta->is_immutable, '... our class is not immutable');
+
+ ok(!$meta->is_immutable, '... our class is not immutable');
lives_ok {
$meta->make_immutable(
inline_constructor => 1,
- inline_accessors => 1,
+ inline_accessors => 1,
);
} '... changed Bar to be immutable';
- ok($meta->is_immutable, '... our class is now immutable');
- isa_ok($meta, 'Class::MOP::Class::Immutable');
- isa_ok($meta, 'Class::MOP::Class');
-
+ ok($meta->is_immutable, '... our class is now immutable');
+ isa_ok($meta, 'Class::MOP::Class');
+
# they made a constructor for us :)
can_ok('Bar', 'new');
-
+
{
my $bar = Bar->new;
isa_ok($bar, 'Bar');
is($bar->bar, 'BAR', '... got the right default value');
- is($bar->baz, 'BAZ', '... got the right default value');
+ is($bar->baz, 'BAZ', '... got the right default value');
}
-
+
{
my $bar = Bar->new(bar => 'BAZ!', baz => 'BAR!');
isa_ok($bar, 'Bar');
is($bar->bar, 'BAZ!', '... got the right parameter value');
- is($bar->baz, 'BAR!', '... got the right parameter value');
- }
+ is($bar->baz, 'BAR!', '... got the right parameter value');
+ }
# check out accessors too
{
my $bar_accessor = $meta->find_method_by_name('bar');
isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
- isa_ok($bar_accessor, 'Class::MOP::Method');
-
- ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
-
+ isa_ok($bar_accessor, 'Class::MOP::Method');
+
+ ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
+
my $baz_accessor = $meta->get_method('baz');
isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
- isa_ok($baz_accessor, 'Class::MOP::Method');
-
- ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
+ isa_ok($baz_accessor, 'Class::MOP::Method');
+
+ ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
}
}
{
my $meta = Baz->meta;
is($meta->name, 'Baz', '... checking the Bar metaclass');
-
+
{
my $bar_accessor = $meta->find_method_by_name('bar');
isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
- isa_ok($bar_accessor, 'Class::MOP::Method');
-
- ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
-
+ isa_ok($bar_accessor, 'Class::MOP::Method');
+
+ ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
+
my $baz_accessor = $meta->find_method_by_name('baz');
isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
- isa_ok($baz_accessor, 'Class::MOP::Method');
-
- ok($baz_accessor->is_inline, '... the baz accessor is inlined');
-
+ isa_ok($baz_accessor, 'Class::MOP::Method');
+
+ ok($baz_accessor->is_inline, '... the baz accessor is inlined');
+
my $bah_accessor = $meta->get_method('bah');
isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
- isa_ok($bah_accessor, 'Class::MOP::Method');
-
- ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');
+ isa_ok($bah_accessor, 'Class::MOP::Method');
+
+ ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');
}
-
- ok(!$meta->is_immutable, '... our class is not immutable');
+
+ ok(!$meta->is_immutable, '... our class is not immutable');
lives_ok {
$meta->make_immutable(
inline_constructor => 0,
- inline_accessors => 1,
+ inline_accessors => 1,
);
} '... changed Bar to be immutable';
- ok($meta->is_immutable, '... our class is now immutable');
- isa_ok($meta, 'Class::MOP::Class::Immutable');
- isa_ok($meta, 'Class::MOP::Class');
-
+ ok($meta->is_immutable, '... our class is now immutable');
+ isa_ok($meta, 'Class::MOP::Class');
+
ok(!Baz->meta->has_method('new'), '... no constructor was made');
-
+
{
- my $baz = Baz->meta->construct_instance;
+ my $baz = Baz->meta->new_object;
isa_ok($baz, 'Bar');
is($baz->bar, 'BAR', '... got the right default value');
- is($baz->baz, 'BAZ', '... got the right default value');
+ is($baz->baz, 'BAZ', '... got the right default value');
}
-
+
{
- my $baz = Baz->meta->construct_instance(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!');
+ my $baz = Baz->meta->new_object(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!');
isa_ok($baz, 'Baz');
is($baz->bar, 'BAZ!', '... got the right parameter value');
is($baz->baz, 'BAR!', '... got the right parameter value');
- is($baz->bah, 'BAH!', '... got the right parameter value');
- }
+ is($baz->bah, 'BAH!', '... got the right parameter value');
+ }
# check out accessors too
{
my $bar_accessor = $meta->find_method_by_name('bar');
isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
- isa_ok($bar_accessor, 'Class::MOP::Method');
-
- ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
-
+ isa_ok($bar_accessor, 'Class::MOP::Method');
+
+ ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
+
my $baz_accessor = $meta->find_method_by_name('baz');
isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
- isa_ok($baz_accessor, 'Class::MOP::Method');
-
- ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
+ isa_ok($baz_accessor, 'Class::MOP::Method');
+
+ ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
my $bah_accessor = $meta->get_method('bah');
isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
- isa_ok($bah_accessor, 'Class::MOP::Method');
-
- ok($bah_accessor->is_inline, '... the baz accessor is not inlined');
+ isa_ok($bah_accessor, 'Class::MOP::Method');
+
+ ok($bah_accessor->is_inline, '... the baz accessor is not inlined');
}
}
+
+{
+ my $buzz;
+ ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
+ ::ok(!$buzz->has_bar, '...bar is not set');
+ ::is($buzz->bar, undef, '...bar returns undef');
+ ::ok(!$buzz->has_bar, '...bar was not autovivified');
+
+ $buzz->bar(undef);
+ ::ok($buzz->has_bar, '...bar is set');
+ ::is($buzz->bar, undef, '...bar is undef');
+ $buzz->clear_bar;
+ ::ok(!$buzz->has_bar, '...bar is no longerset');
+
+ my $buzz2;
+ ::lives_ok { $buzz2 = Buzz->meta->new_object('bar' => undef) } '...Buzz instantiated successfully';
+ ::ok($buzz2->has_bar, '...bar is set');
+ ::is($buzz2->bar, undef, '...bar is undef');
+
+}
+
+{
+ my $buzz;
+ ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
+ ::ok($buzz->has_bah, '...bah is set');
+ ::is($buzz->bah, 'BAH', '...bah returns "BAH"' );
+
+ my $buzz2;
+ ::lives_ok { $buzz2 = Buzz->meta->new_object('bah' => undef) } '...Buzz instantiated successfully';
+ ::ok($buzz2->has_bah, '...bah is set');
+ ::is($buzz2->bah, undef, '...bah is undef');
+
+}
projects / gitmo/Class-MOP.git / blobdiff