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

use strict;
use warnings;

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

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

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


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');

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