[gitmo/Class-MOP.git] / t / 020_attribute.t

use strict;
use warnings;

use Scalar::Util 'reftype', 'blessed';

use Test::More tests => 104;
use Test::Exception;

use Class::MOP;
use Class::MOP::Attribute;
use Class::MOP::Method;


dies_ok { Class::MOP::Attribute->name } q{... can't call name() as a class method};


{
    my $attr = Class::MOP::Attribute->new('$foo');
    isa_ok($attr, 'Class::MOP::Attribute');

    is($attr->name, '$foo', '... $attr->name == $foo');
    ok($attr->has_init_arg, '... $attr does have an init_arg');
    is($attr->init_arg, '$foo', '... $attr init_arg is the name');

    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->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 {
        $attr->attach_to_class($class);
    } '... 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');    
    
    {
        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');        
        
        isa_ok($reader, 'Class::MOP::Method');
        isa_ok($writer, 'Class::MOP::Method');        
    }

    my $attr_clone = $attr->clone();
    isa_ok($attr_clone, 'Class::MOP::Attribute');
    isnt($attr, $attr_clone, '... but they are different instances');

    is($attr->associated_class, $attr_clone->associated_class, '... the associated classes are the same though');
    is($attr->associated_class, $class, '... the associated classes are the same though');
    is($attr_clone->associated_class, $class, '... the associated classes are the same though');

    is_deeply($attr, $attr_clone, '... but they are the same inside');
}

{
    my $attr = Class::MOP::Attribute->new('$foo', (
        init_arg => '-foo',
        default  => 'BAR'
    ));
    isa_ok($attr, 'Class::MOP::Attribute');

    is($attr->name, '$foo', '... $attr->name == $foo');

    ok($attr->has_init_arg, '... $attr does have an init_arg');
    is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
    ok($attr->has_default, '... $attr does have an default');
    is($attr->default, 'BAR', '... $attr->default == BAR');
    ok(!$attr->has_builder, '... $attr does not have a builder');

    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');    
    
    {
        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 $attr_clone = $attr->clone();
    isa_ok($attr_clone, 'Class::MOP::Attribute');
    isnt($attr, $attr_clone, '... but they are different instances');

    is($attr->associated_class, $attr_clone->associated_class, '... the associated classes are the same though');
    is($attr->associated_class, undef, '... the associated class is actually undef');
    is($attr_clone->associated_class, undef, '... the associated class is actually undef');

    is_deeply($attr, $attr_clone, '... but they are the same inside');
}

{
    my $attr = Class::MOP::Attribute->new('$foo', (
        accessor => 'foo',
        init_arg => '-foo',
        default  => 'BAR'
    ));
    isa_ok($attr, 'Class::MOP::Attribute');

    is($attr->name, '$foo', '... $attr->name == $foo');

    ok($attr->has_init_arg, '... $attr does have an init_arg');
    is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
    ok($attr->has_default, '... $attr does have an default');
    is($attr->default, 'BAR', '... $attr->default == BAR');

    ok($attr->has_accessor, '... $attr does have an accessor');
    is($attr->accessor, 'foo', '... $attr->accessor == foo');

    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');    
    
    {
        my $reader = $attr->get_read_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');         
        
        is(reftype($reader), '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');
    isnt($attr, $attr_clone, '... but they are different instances');

    is_deeply($attr, $attr_clone, '... but they are the same inside');
}

{
    my $attr = Class::MOP::Attribute->new('$foo', (
        reader   => 'get_foo',
        writer   => 'set_foo',
        init_arg => '-foo',
        default  => 'BAR'
    ));
    isa_ok($attr, 'Class::MOP::Attribute');

    is($attr->name, '$foo', '... $attr->name == $foo');

    ok($attr->has_init_arg, '... $attr does have an init_arg');
    is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
    ok($attr->has_default, '... $attr does have an default');
    is($attr->default, 'BAR', '... $attr->default == BAR');

    ok($attr->has_reader, '... $attr does have an reader');
    is($attr->reader, 'get_foo', '... $attr->reader == get_foo');
    ok($attr->has_writer, '... $attr does have an writer');
    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');    
    
    {
        my $reader = $attr->get_read_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');           
        
        is(reftype($reader), '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');
    isnt($attr, $attr_clone, '... but they are different instances');

    is_deeply($attr, $attr_clone, '... but they are the same inside');
}

{
    my $attr = Class::MOP::Attribute->new('$foo');
    isa_ok($attr, 'Class::MOP::Attribute');

    my $attr_clone = $attr->clone('name' => '$bar');
    isa_ok($attr_clone, 'Class::MOP::Attribute');
    isnt($attr, $attr_clone, '... but they are different instances');

    isnt($attr->name, $attr_clone->name, '... we changes the name parameter');

    is($attr->name, '$foo', '... $attr->name == $foo');
    is($attr_clone->name, '$bar', '... $attr_clone->name == $bar');
}

{
    my $attr = Class::MOP::Attribute->new('$foo', (builder => 'foo_builder'));
    isa_ok($attr, 'Class::MOP::Attribute');

    ok(!$attr->has_default, '... $attr does not have a default');
    ok($attr->has_builder, '... $attr does have a builder');
    is($attr->builder, 'foo_builder', '... $attr->builder == foo_builder');

}

{
    for my $value ({}, bless({}, 'Foo')) {
        throws_ok {
            Class::MOP::Attribute->new('$foo', default => $value);
        } qr/References are not allowed as default values/;
    }
}

{
    my $attr;
    lives_ok {
        my $meth = Class::MOP::Method->wrap(sub {shift}, name => 'foo', package_name => 'bar');
        $attr = Class::MOP::Attribute->new('$foo', default => $meth);
    } 'Class::MOP::Methods accepted as default';

    is($attr->default(42), 42, 'passthrough for default on attribute');
}
Commit	Line	Data
2eb717d5	1	use strict;
	2	use warnings;
	3
742fb371	4	use Scalar::Util 'reftype', 'blessed';
742fb371	5
ed337aad	6	use Test::More tests => 104;
2eb717d5	7	use Test::Exception;
2eb717d5	8
988fb42e	9	use Class::MOP;
988fb42e	10	use Class::MOP::Attribute;
ed337aad	11	use Class::MOP::Method;
988fb42e	12
	13
	14	dies_ok { Class::MOP::Attribute->name } q{... can't call name() as a class method};
	15
2eb717d5	16
	17	{
	18	my $attr = Class::MOP::Attribute->new('$foo');
	19	isa_ok($attr, 'Class::MOP::Attribute');
	20
	21	is($attr->name, '$foo', '... $attr->name == $foo');
7b31baf4	22	ok($attr->has_init_arg, '... $attr does have an init_arg');
1d68af04	23	is($attr->init_arg, '$foo', '... $attr init_arg is the name');
1d68af04	24
2eb717d5	25	ok(!$attr->has_accessor, '... $attr does not have an accessor');
	26	ok(!$attr->has_reader, '... $attr does not have an reader');
	27	ok(!$attr->has_writer, '... $attr does not have an writer');
1d68af04	28	ok(!$attr->has_default, '... $attr does not have an default');
	29	ok(!$attr->has_builder, '... $attr does not have a builder');
	30
def5c0b5	31	{
	32	my $reader = $attr->get_read_method_ref;
	33	my $writer = $attr->get_write_method_ref;
	34
	35	ok(!blessed($reader), '... it is a plain old sub');
	36	ok(!blessed($writer), '... it is a plain old sub');
	37
	38	is(reftype($reader), 'CODE', '... it is a plain old sub');
	39	is(reftype($writer), 'CODE', '... it is a plain old sub');
	40	}
	41
a27ae83f	42	my $class = Class::MOP::Class->initialize('Foo');
a27ae83f	43	isa_ok($class, 'Class::MOP::Class');
1d68af04	44
a27ae83f	45	lives_ok {
	46	$attr->attach_to_class($class);
	47	} '... attached a class successfully';
1d68af04	48
a27ae83f	49	is($attr->associated_class, $class, '... the class was associated correctly');
742fb371	50
	51	ok(!$attr->get_read_method, '... $attr does not have an read method');
	52	ok(!$attr->get_write_method, '... $attr does not have an write method');
	53
	54	{
	55	my $reader = $attr->get_read_method_ref;
	56	my $writer = $attr->get_write_method_ref;
	57
def5c0b5	58	ok(blessed($reader), '... it is a plain old sub');
def5c0b5	59	ok(blessed($writer), '... it is a plain old sub');
742fb371	60
def5c0b5	61	isa_ok($reader, 'Class::MOP::Method');
def5c0b5	62	isa_ok($writer, 'Class::MOP::Method');
742fb371	63	}
1d68af04	64
5659d76e	65	my $attr_clone = $attr->clone();
	66	isa_ok($attr_clone, 'Class::MOP::Attribute');
	67	isnt($attr, $attr_clone, '... but they are different instances');
1d68af04	68
a27ae83f	69	is($attr->associated_class, $attr_clone->associated_class, '... the associated classes are the same though');
1d68af04	70	is($attr->associated_class, $class, '... the associated classes are the same though');
	71	is($attr_clone->associated_class, $class, '... the associated classes are the same though');
	72
5659d76e	73	is_deeply($attr, $attr_clone, '... but they are the same inside');
2eb717d5	74	}
	75
	76	{
	77	my $attr = Class::MOP::Attribute->new('$foo', (
	78	init_arg => '-foo',
	79	default => 'BAR'
	80	));
	81	isa_ok($attr, 'Class::MOP::Attribute');
	82
	83	is($attr->name, '$foo', '... $attr->name == $foo');
1d68af04	84
2eb717d5	85	ok($attr->has_init_arg, '... $attr does have an init_arg');
2eb717d5	86	is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
1d68af04	87	ok($attr->has_default, '... $attr does have an default');
2eb717d5	88	is($attr->default, 'BAR', '... $attr->default == BAR');
1d68af04	89	ok(!$attr->has_builder, '... $attr does not have a builder');
1d68af04	90
2eb717d5	91	ok(!$attr->has_accessor, '... $attr does not have an accessor');
2eb717d5	92	ok(!$attr->has_reader, '... $attr does not have an reader');
1d68af04	93	ok(!$attr->has_writer, '... $attr does not have an writer');
742fb371	94
	95	ok(!$attr->get_read_method, '... $attr does not have an read method');
	96	ok(!$attr->get_write_method, '... $attr does not have an write method');
	97
	98	{
	99	my $reader = $attr->get_read_method_ref;
	100	my $writer = $attr->get_write_method_ref;
	101
	102	ok(!blessed($reader), '... it is a plain old sub');
	103	ok(!blessed($writer), '... it is a plain old sub');
	104
	105	is(reftype($reader), 'CODE', '... it is a plain old sub');
	106	is(reftype($writer), 'CODE', '... it is a plain old sub');
	107	}
1d68af04	108
5659d76e	109	my $attr_clone = $attr->clone();
	110	isa_ok($attr_clone, 'Class::MOP::Attribute');
	111	isnt($attr, $attr_clone, '... but they are different instances');
1d68af04	112
a27ae83f	113	is($attr->associated_class, $attr_clone->associated_class, '... the associated classes are the same though');
1d68af04	114	is($attr->associated_class, undef, '... the associated class is actually undef');
	115	is($attr_clone->associated_class, undef, '... the associated class is actually undef');
	116
	117	is_deeply($attr, $attr_clone, '... but they are the same inside');
2eb717d5	118	}
	119
	120	{
	121	my $attr = Class::MOP::Attribute->new('$foo', (
	122	accessor => 'foo',
	123	init_arg => '-foo',
	124	default => 'BAR'
	125	));
	126	isa_ok($attr, 'Class::MOP::Attribute');
	127
	128	is($attr->name, '$foo', '... $attr->name == $foo');
1d68af04	129
2eb717d5	130	ok($attr->has_init_arg, '... $attr does have an init_arg');
2eb717d5	131	is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
1d68af04	132	ok($attr->has_default, '... $attr does have an default');
2eb717d5	133	is($attr->default, 'BAR', '... $attr->default == BAR');
2eb717d5	134
1d68af04	135	ok($attr->has_accessor, '... $attr does have an accessor');
2eb717d5	136	is($attr->accessor, 'foo', '... $attr->accessor == foo');
1d68af04	137
2eb717d5	138	ok(!$attr->has_reader, '... $attr does not have an reader');
1d68af04	139	ok(!$attr->has_writer, '... $attr does not have an writer');
742fb371	140
	141	is($attr->get_read_method, 'foo', '... $attr does not have an read method');
	142	is($attr->get_write_method, 'foo', '... $attr does not have an write method');
	143
	144	{
	145	my $reader = $attr->get_read_method_ref;
	146	my $writer = $attr->get_write_method_ref;
	147
	148	ok(!blessed($reader), '... it is not a plain old sub');
	149	ok(!blessed($writer), '... it is not a plain old sub');
	150
	151	is(reftype($reader), 'CODE', '... it is a plain old sub');
	152	is(reftype($writer), 'CODE', '... it is a plain old sub');
	153	}
1d68af04	154
5659d76e	155	my $attr_clone = $attr->clone();
5659d76e	156	isa_ok($attr_clone, 'Class::MOP::Attribute');
a740253a	157	isnt($attr, $attr_clone, '... but they are different instances');
1d68af04	158
1d68af04	159	is_deeply($attr, $attr_clone, '... but they are the same inside');
2eb717d5	160	}
	161
	162	{
	163	my $attr = Class::MOP::Attribute->new('$foo', (
	164	reader => 'get_foo',
1d68af04	165	writer => 'set_foo',
2eb717d5	166	init_arg => '-foo',
	167	default => 'BAR'
	168	));
	169	isa_ok($attr, 'Class::MOP::Attribute');
	170
	171	is($attr->name, '$foo', '... $attr->name == $foo');
1d68af04	172
2eb717d5	173	ok($attr->has_init_arg, '... $attr does have an init_arg');
2eb717d5	174	is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
1d68af04	175	ok($attr->has_default, '... $attr does have an default');
2eb717d5	176	is($attr->default, 'BAR', '... $attr->default == BAR');
	177
	178	ok($attr->has_reader, '... $attr does have an reader');
1d68af04	179	is($attr->reader, 'get_foo', '... $attr->reader == get_foo');
2eb717d5	180	ok($attr->has_writer, '... $attr does have an writer');
1d68af04	181	is($attr->writer, 'set_foo', '... $attr->writer == set_foo');
	182
	183	ok(!$attr->has_accessor, '... $attr does not have an accessor');
742fb371	184
	185	is($attr->get_read_method, 'get_foo', '... $attr does not have an read method');
	186	is($attr->get_write_method, 'set_foo', '... $attr does not have an write method');
	187
	188	{
	189	my $reader = $attr->get_read_method_ref;
	190	my $writer = $attr->get_write_method_ref;
	191
	192	ok(!blessed($reader), '... it is not a plain old sub');
	193	ok(!blessed($writer), '... it is not a plain old sub');
	194
	195	is(reftype($reader), 'CODE', '... it is a plain old sub');
	196	is(reftype($writer), 'CODE', '... it is a plain old sub');
	197	}
2eb717d5	198
5659d76e	199	my $attr_clone = $attr->clone();
5659d76e	200	isa_ok($attr_clone, 'Class::MOP::Attribute');
a740253a	201	isnt($attr, $attr_clone, '... but they are different instances');
1d68af04	202
1d68af04	203	is_deeply($attr, $attr_clone, '... but they are the same inside');
2eb717d5	204	}
22286063	205
	206	{
	207	my $attr = Class::MOP::Attribute->new('$foo');
	208	isa_ok($attr, 'Class::MOP::Attribute');
1d68af04	209
22286063	210	my $attr_clone = $attr->clone('name' => '$bar');
	211	isa_ok($attr_clone, 'Class::MOP::Attribute');
	212	isnt($attr, $attr_clone, '... but they are different instances');
1d68af04	213
22286063	214	isnt($attr->name, $attr_clone->name, '... we changes the name parameter');
1d68af04	215
22286063	216	is($attr->name, '$foo', '... $attr->name == $foo');
1d68af04	217	is($attr_clone->name, '$bar', '... $attr_clone->name == $bar');
22286063	218	}
22286063	219
1d68af04	220	{
	221	my $attr = Class::MOP::Attribute->new('$foo', (builder => 'foo_builder'));
	222	isa_ok($attr, 'Class::MOP::Attribute');
	223
	224	ok(!$attr->has_default, '... $attr does not have a default');
	225	ok($attr->has_builder, '... $attr does have a builder');
	226	is($attr->builder, 'foo_builder', '... $attr->builder == foo_builder');
	227
	228	}
ed337aad	229
	230	{
	231	for my $value ({}, bless({}, 'Foo')) {
	232	throws_ok {
	233	Class::MOP::Attribute->new('$foo', default => $value);
	234	} qr/References are not allowed as default values/;
	235	}
	236	}
	237
	238	{
	239	my $attr;
	240	lives_ok {
	241	my $meth = Class::MOP::Method->wrap(sub {shift}, name => 'foo', package_name => 'bar');
	242	$attr = Class::MOP::Attribute->new('$foo', default => $meth);
	243	} 'Class::MOP::Methods accepted as default';
	244
	245	is($attr->default(42), 42, 'passthrough for default on attribute');
	246	}