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

#!/usr/bin/perl

use strict;
use warnings;

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

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

BEGIN {
    use_ok('Class::MOP');
    use_ok('Class::MOP::Attribute');
}

{
    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 $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');        
        
        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, $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');

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