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

#!/usr/bin/perl

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