X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F014_attribute_introspection.t;h=c8a486476f28f44b7d8ea68bd0ad58ff7d3ad123;hb=860f85abed70a4947fb698784aa94252324d770d;hp=2fb3acb5bced03b3973164b7d6b4fe08a39b661c;hpb=aa448b163f4882fc3e4b92a1c1f22e3c9ad9f933;p=gitmo%2FClass-MOP.git diff --git a/t/014_attribute_introspection.t b/t/014_attribute_introspection.t index 2fb3acb..c8a4864 100644 --- a/t/014_attribute_introspection.t +++ b/t/014_attribute_introspection.t @@ -1,70 +1,103 @@ -#!/usr/bin/perl - use strict; use warnings; -use Test::More tests => 38; +use Test::More tests => 64; use Test::Exception; -BEGIN { - use_ok('Class::MOP'); +use Class::MOP; + +{ + my $attr = Class::MOP::Attribute->new('$test'); + is($attr->meta, Class::MOP::Attribute->meta, '... instance and class both lead to the same meta'); } { my $meta = Class::MOP::Attribute->meta(); isa_ok($meta, 'Class::MOP::Class'); - + my @methods = qw( - meta - new clone + new + clone + + initialize_instance_slot + _set_initial_slot_value + name - has_accessor accessor - has_writer writer - has_reader reader - has_predicate predicate - has_init_arg init_arg - has_default default - + has_accessor accessor + has_writer writer + has_write_method get_write_method get_write_method_ref + has_reader reader + has_read_method get_read_method get_read_method_ref + has_predicate predicate + has_clearer clearer + has_builder builder + has_init_arg init_arg + has_default default is_default_a_coderef + has_initializer initializer + + definition_context + + slots + get_value + set_value + set_initial_value + has_value + clear_value + associated_class - attach_to_class detach_from_class - - generate_accessor_method - generate_reader_method - generate_writer_method - generate_predicate_method - + attach_to_class + detach_from_class + + accessor_metaclass + + associated_methods + associate_method + process_accessors install_accessors remove_accessors + + _new ); - + is_deeply( - [ sort @methods ], [ sort $meta->get_method_list ], - '... our method list matches'); - + [ sort @methods ], + '... our method list matches'); + foreach my $method_name (@methods) { ok($meta->has_method($method_name), '... Class::MOP::Attribute->has_method(' . $method_name . ')'); } - - my @attributes = qw( - name accessor reader writer predicate - init_arg default associated_class - ); + + my @attributes = ( + 'name', + 'accessor', + 'reader', + 'writer', + 'predicate', + 'clearer', + 'builder', + 'init_arg', + 'initializer', + 'definition_context', + 'default', + 'associated_class', + 'associated_methods', + ); is_deeply( - [ sort @attributes ], [ sort $meta->get_attribute_list ], + [ sort @attributes ], '... our attribute list matches'); - + foreach my $attribute_name (@attributes) { - ok($meta->has_attribute($attribute_name), '... Class::MOP::Attribute->has_attribute(' . $attribute_name . ')'); + ok($meta->has_attribute($attribute_name), '... Class::MOP::Attribute->has_attribute(' . $attribute_name . ')'); } - - # We could add some tests here to make sure that - # the attribute have the appropriate - # accessor/reader/writer/predicate combinations, - # but that is getting a little excessive so I - # wont worry about it for now. Maybe if I get + + # We could add some tests here to make sure that + # the attribute have the appropriate + # accessor/reader/writer/predicate combinations, + # but that is getting a little excessive so I + # wont worry about it for now. Maybe if I get # bored I will do it. -} \ No newline at end of file +}