-#!/usr/bin/perl
-
use strict;
use warnings;
-use Test::More tests => 23;
+use Test::More;
use Test::Exception;
-BEGIN {
- use_ok('Class::MOP');
- use_ok('Class::MOP::Attribute');
-}
+use Class::MOP;
+use Class::MOP::Attribute;
# most values are static
default => qr/hello (.*)/
));
} '... no refs for defaults';
-
+
dies_ok {
Class::MOP::Attribute->new('$test' => (
default => []
));
- } '... no refs for defaults';
-
+ } '... no refs for defaults';
+
dies_ok {
Class::MOP::Attribute->new('$test' => (
default => {}
));
- } '... no refs for defaults';
-
-
+ } '... no refs for defaults';
+
+
dies_ok {
Class::MOP::Attribute->new('$test' => (
default => \(my $var)
));
- } '... no refs for defaults';
+ } '... no refs for defaults';
dies_ok {
Class::MOP::Attribute->new('$test' => (
}
+{
+ dies_ok {
+ Class::MOP::Attribute->new('$test' => (
+ builder => qr/hello (.*)/
+ ));
+ } '... no refs for builders';
+
+ dies_ok {
+ Class::MOP::Attribute->new('$test' => (
+ builder => []
+ ));
+ } '... no refs for builders';
+
+ dies_ok {
+ Class::MOP::Attribute->new('$test' => (
+ builder => {}
+ ));
+ } '... no refs for builders';
+
+
+ dies_ok {
+ Class::MOP::Attribute->new('$test' => (
+ builder => \(my $var)
+ ));
+ } '... no refs for builders';
+
+ dies_ok {
+ Class::MOP::Attribute->new('$test' => (
+ builder => bless {} => 'Foo'
+ ));
+ } '... no refs for builders';
+
+ dies_ok {
+ Class::MOP::Attribute->new('$test' => (
+ builder => 'Foo', default => 'Foo'
+ ));
+ } '... no default AND builder';
+
+ my $undef_attr;
+ lives_ok {
+ $undef_attr = Class::MOP::Attribute->new('$test' => (
+ default => undef,
+ predicate => 'has_test',
+ ));
+ } '... undef as a default is okay';
+ ok($undef_attr->has_default, '... and it counts as an actual default');
+ ok(!Class::MOP::Attribute->new('$test')->has_default,
+ '... but attributes with no default have no default');
+
+ Class::MOP::Class->create(
+ 'Foo',
+ attributes => [$undef_attr],
+ );
+ {
+ my $obj = Foo->meta->new_object;
+ ok($obj->has_test, '... and the default is populated');
+ is($obj->meta->get_attribute('$test')->get_value($obj), undef, '... with the right value');
+ }
+ lives_ok { Foo->meta->make_immutable }
+ '... and it can be inlined';
+ {
+ my $obj = Foo->new;
+ ok($obj->has_test, '... and the default is populated');
+ is($obj->meta->get_attribute('$test')->get_value($obj), undef, '... with the right value');
+ }
+
+}
+
+
{ # bad construtor args
dies_ok {
Class::MOP::Attribute->new();
} '... no name argument';
- dies_ok {
+ # These are no longer errors
+ lives_ok {
Class::MOP::Attribute->new('');
} '... bad name argument';
- dies_ok {
+ lives_ok {
Class::MOP::Attribute->new(0);
} '... bad name argument';
}
{
- my $attr = Class::MOP::Attribute->new('$test');
+ my $attr = Class::MOP::Attribute->new('$test');
dies_ok {
$attr->attach_to_class();
} '... attach_to_class died as expected';
-
+
dies_ok {
$attr->attach_to_class('Fail');
- } '... attach_to_class died as expected';
-
+ } '... attach_to_class died as expected';
+
dies_ok {
$attr->attach_to_class(bless {} => 'Fail');
- } '... attach_to_class died as expected';
+ } '... attach_to_class died as expected';
}
{
my $attr = Class::MOP::Attribute->new('$test' => (
reader => [ 'whoops, this wont work' ]
));
-
+
$attr->attach_to_class(Class::MOP::Class->initialize('Foo'));
dies_ok {
$attr->install_accessors;
- } '... bad reader format';
+ } '... bad reader format';
}
{
my $attr = Class::MOP::Attribute->new('$test');
dies_ok {
- $attr->process_accessors('fail', 'my_failing_sub');
+ $attr->_process_accessors('fail', 'my_failing_sub');
} '... cannot find "fail" type generator';
}
my $attr = My::Attribute->new('$test' => (
reader => 'test'
));
-
+
dies_ok {
$attr->install_accessors;
- } '... failed to generate accessors correctly';
+ } '... failed to generate accessors correctly';
}
{
my $attr = Class::MOP::Attribute->new('$test' => (
predicate => 'has_test'
));
-
+
my $Bar = Class::MOP::Class->create('Bar');
isa_ok($Bar, 'Class::MOP::Class');
-
+
$Bar->add_attribute($attr);
-
+
can_ok('Bar', 'has_test');
-
- is($attr, $Bar->remove_attribute('$test'), '... removed the $test attribute');
-
- ok(!Bar->can('has_test'), '... Bar no longer has the "has_test" method');
+
+ is($attr, $Bar->remove_attribute('$test'), '... removed the $test attribute');
+
+ ok(!Bar->can('has_test'), '... Bar no longer has the "has_test" method');
}
{
# NOTE:
- # the next three tests once tested that
- # the code would fail, but we lifted the
- # restriction so you can have an accessor
- # along with a reader/writer pair (I mean
- # why not really). So now they test that
- # it works, which is kinda silly, but it
+ # the next three tests once tested that
+ # the code would fail, but we lifted the
+ # restriction so you can have an accessor
+ # along with a reader/writer pair (I mean
+ # why not really). So now they test that
+ # it works, which is kinda silly, but it
# tests the API change, so I keep it.
lives_ok {
lives_ok {
Class::MOP::Attribute->new('$foo', (
accessor => 'foo',
- reader => 'get_foo',
+ reader => 'get_foo',
writer => 'set_foo',
));
} '... can create accessors with reader/writers';
}
+
+done_testing;