-#!/usr/bin/perl
-
use strict;
use warnings;
use Scalar::Util 'reftype', 'blessed';
-use Test::More tests => 97;
-use Test::Exception;
+use Test::More;
+use Test::Fatal;
+
+use Class::MOP;
+use Class::MOP::Attribute;
+use Class::MOP::Method;
+
+
+isnt( exception { Class::MOP::Attribute->name }, undef, q{... can't call name() as a class method} );
-BEGIN {
- use_ok('Class::MOP');
- use_ok('Class::MOP::Attribute');
-}
{
my $attr = Class::MOP::Attribute->new('$foo');
ok(!$attr->has_default, '... $attr does not have an default');
ok(!$attr->has_builder, '... $attr does not have a builder');
+ {
+ my $reader = $attr->get_read_method_ref;
+ my $writer = $attr->get_write_method_ref;
+
+ ok(!blessed($reader), '... it is a plain old sub');
+ ok(!blessed($writer), '... it is a plain old sub');
+
+ is(reftype($reader), 'CODE', '... it is a plain old sub');
+ is(reftype($writer), 'CODE', '... it is a plain old sub');
+ }
+
my $class = Class::MOP::Class->initialize('Foo');
isa_ok($class, 'Class::MOP::Class');
- lives_ok {
+ is( exception {
$attr->attach_to_class($class);
- } '... attached a class successfully';
+ }, undef, '... attached a class successfully' );
is($attr->associated_class, $class, '... the class was associated correctly');
-
+
ok(!$attr->get_read_method, '... $attr does not have an read method');
- ok(!$attr->get_write_method, '... $attr does not have an write method');
-
+ ok(!$attr->get_write_method, '... $attr does not have an write method');
+
{
my $reader = $attr->get_read_method_ref;
- my $writer = $attr->get_write_method_ref;
-
- ok(!blessed($reader), '... it is a plain old sub');
- ok(!blessed($writer), '... it is a plain old sub');
-
- is(reftype($reader), 'CODE', '... it is a plain old sub');
- is(reftype($writer), 'CODE', '... it is a plain old sub');
+ my $writer = $attr->get_write_method_ref;
+
+ ok(blessed($reader), '... it is a plain old sub');
+ ok(blessed($writer), '... it is a plain old sub');
+
+ isa_ok($reader, 'Class::MOP::Method');
+ isa_ok($writer, 'Class::MOP::Method');
}
my $attr_clone = $attr->clone();
ok(!$attr->has_accessor, '... $attr does not have an accessor');
ok(!$attr->has_reader, '... $attr does not have an reader');
ok(!$attr->has_writer, '... $attr does not have an writer');
-
+
ok(!$attr->get_read_method, '... $attr does not have an read method');
- ok(!$attr->get_write_method, '... $attr does not have an write method');
-
+ ok(!$attr->get_write_method, '... $attr does not have an write method');
+
{
my $reader = $attr->get_read_method_ref;
- my $writer = $attr->get_write_method_ref;
-
+ my $writer = $attr->get_write_method_ref;
+
ok(!blessed($reader), '... it is a plain old sub');
- ok(!blessed($writer), '... it is a plain old sub');
-
+ ok(!blessed($writer), '... it is a plain old sub');
+
is(reftype($reader), 'CODE', '... it is a plain old sub');
- is(reftype($writer), 'CODE', '... it is a plain old sub');
- }
+ is(reftype($writer), 'CODE', '... it is a plain old sub');
+ }
my $attr_clone = $attr->clone();
isa_ok($attr_clone, 'Class::MOP::Attribute');
ok(!$attr->has_reader, '... $attr does not have an reader');
ok(!$attr->has_writer, '... $attr does not have an writer');
-
+
is($attr->get_read_method, 'foo', '... $attr does not have an read method');
- is($attr->get_write_method, 'foo', '... $attr does not have an write method');
-
+ is($attr->get_write_method, 'foo', '... $attr does not have an write method');
+
{
my $reader = $attr->get_read_method_ref;
- my $writer = $attr->get_write_method_ref;
-
+ my $writer = $attr->get_write_method_ref;
+
ok(!blessed($reader), '... it is not a plain old sub');
- ok(!blessed($writer), '... it is not a plain old sub');
-
+ ok(!blessed($writer), '... it is not a plain old sub');
+
is(reftype($reader), 'CODE', '... it is a plain old sub');
- is(reftype($writer), 'CODE', '... it is a plain old sub');
- }
+ is(reftype($writer), 'CODE', '... it is a plain old sub');
+ }
my $attr_clone = $attr->clone();
isa_ok($attr_clone, 'Class::MOP::Attribute');
is($attr->writer, 'set_foo', '... $attr->writer == set_foo');
ok(!$attr->has_accessor, '... $attr does not have an accessor');
-
+
is($attr->get_read_method, 'get_foo', '... $attr does not have an read method');
- is($attr->get_write_method, 'set_foo', '... $attr does not have an write method');
-
+ is($attr->get_write_method, 'set_foo', '... $attr does not have an write method');
+
{
my $reader = $attr->get_read_method_ref;
- my $writer = $attr->get_write_method_ref;
-
+ my $writer = $attr->get_write_method_ref;
+
ok(!blessed($reader), '... it is not a plain old sub');
- ok(!blessed($writer), '... it is not a plain old sub');
-
+ ok(!blessed($writer), '... it is not a plain old sub');
+
is(reftype($reader), 'CODE', '... it is a plain old sub');
- is(reftype($writer), 'CODE', '... it is a plain old sub');
- }
+ is(reftype($writer), 'CODE', '... it is a plain old sub');
+ }
my $attr_clone = $attr->clone();
isa_ok($attr_clone, 'Class::MOP::Attribute');
is($attr->builder, 'foo_builder', '... $attr->builder == foo_builder');
}
+
+{
+ for my $value ({}, bless({}, 'Foo')) {
+ like( exception {
+ Class::MOP::Attribute->new('$foo', default => $value);
+ }, qr/References are not allowed as default values/ );
+ }
+}
+
+{
+ my $attr;
+ is( exception {
+ my $meth = Class::MOP::Method->wrap(sub {shift}, name => 'foo', package_name => 'bar');
+ $attr = Class::MOP::Attribute->new('$foo', default => $meth);
+ }, undef, 'Class::MOP::Methods accepted as default' );
+
+ is($attr->default(42), 42, 'passthrough for default on attribute');
+}
+
+done_testing;