From: gfx Date: Fri, 25 Sep 2009 12:27:07 +0000 (+0900) Subject: Fix tests and documents X-Git-Tag: 0.35~9 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=612d3e1a65aebf8042df5972079695883a4eec6e;p=gitmo%2FMouse.git Fix tests and documents --- diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 4feac11..a9a8431 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -376,7 +376,7 @@ It adds the following options to the constructor: =over 4 -=item * C<< is => 'ro', 'rw', 'bare' >> +=item C<< is => 'ro', 'rw', 'bare' >> This provides a shorthand for specifying the C, C, or C names. If the attribute is read-only ('ro') then it will @@ -392,7 +392,7 @@ Use 'bare' when you are deliberately not installing any methods Moose will issue a deprecation warning when this attribute is added to a metaclass. -=item * C<< isa => Type >> +=item C<< isa => Type >> This option accepts a type. The type can be a string, which should be a type name. If the type name is unknown, it is assumed to be a class @@ -404,14 +404,14 @@ If you I provide a C option, then your C option must be a class name, and that class must do the role specified with C. -=item * C<< does => Role >> +=item C<< does => Role >> This is short-hand for saying that the attribute's type must be an object which does the named role. B -=item * C<< coerce => Bool >> +=item C<< coerce => Bool >> This option is only valid for objects with a type constraint (C). If this is true, then coercions will be applied whenever @@ -419,12 +419,12 @@ this attribute is set. You can make both this and the C option true. -=item * C<< trigger => CodeRef >> +=item C<< trigger => CodeRef >> This option accepts a subroutine reference, which will be called after the attribute is set. -=item * C<< required => Bool >> +=item C<< required => Bool >> An attribute which is required must be provided to the constructor. An attribute which is required can also have a C or C, @@ -433,24 +433,24 @@ which will satisfy its required-ness. A required attribute must have a C, C or a non-C C -=item * C<< lazy => Bool >> +=item C<< lazy => Bool >> A lazy attribute must have a C or C. When an attribute is lazy, the default value will not be calculated until the attribute is read. -=item * C<< weak_ref => Bool >> +=item C<< weak_ref => Bool >> If this is true, the attribute's value will be stored as a weak reference. -=item * C<< auto_deref => Bool >> +=item C<< auto_deref => Bool >> If this is true, then the reader will dereference the value when it is called. The attribute must have a type constraint which defines the attribute as an array or hash reference. -=item * C<< lazy_build => Bool >> +=item C<< lazy_build => Bool >> Setting this to true makes the attribute lazy and provides a number of default methods. @@ -479,7 +479,7 @@ on success, otherwise Ces. =head2 C<< clone_and_inherit_options(options) -> Mouse::Meta::Attribute >> -Creates a new attribute in OwnerClass, inheriting options from parent classes. +Creates a new attribute in the owner class, inheriting options from parent classes. Accessors and helper methods are installed. Some error checking is done. =head1 SEE ALSO diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index 97d5ee3..0534302 100644 --- a/lib/Mouse/Meta/Class.pm +++ b/lib/Mouse/Meta/Class.pm @@ -67,7 +67,7 @@ sub find_method_by_name{ sub get_all_methods { my($self) = @_; - return map{ $self->find_method_by_name($self) } $self->get_all_method_names; + return map{ $self->find_method_by_name($_) } $self->get_all_method_names; } sub get_all_method_names { @@ -441,41 +441,36 @@ Mouse::Meta::Class - The Mouse class metaclass =head1 METHODS -=head2 initialize ClassName -> Mouse::Meta::Class +=head2 C<< initialize(ClassName) -> Mouse::Meta::Class >> Finds or creates a Mouse::Meta::Class instance for the given ClassName. Only one instance should exist for a given class. -=head2 name -> ClassName +=head2 C<< name -> ClassName >> Returns the name of the owner class. -=head2 superclasses -> [ClassName] +=head2 C<< superclasses -> ClassNames >> C<< superclass(ClassNames) >> Gets (or sets) the list of superclasses of the owner class. -=head2 add_attribute (name => spec | Mouse::Meta::Attribute) +=head2 C<< add_attribute(name => spec | Mouse::Meta::Attribute) >> Begins keeping track of the existing L for the owner class. -=head2 get_all_attributes -> (Mouse::Meta::Attribute) +=head2 C<< get_all_attributes -> (Mouse::Meta::Attribute) >> Returns the list of all L instances associated with this class and its superclasses. -=head2 get_attribute_map -> { name => Mouse::Meta::Attribute } - -Returns a mapping of attribute names to their corresponding -L objects. - -=head2 get_attribute_list -> { name => Mouse::Meta::Attribute } +=head2 C<< get_attribute_list -> { name => Mouse::Meta::Attribute } >> This returns a list of attribute names which are defined in the local class. If you want a list of all applicable attributes for a class, use the C method. -=head2 has_attribute Name -> Bool +=head2 C<< has_attribute(Name) -> Bool >> Returns whether we have a L with the given name. @@ -483,15 +478,15 @@ Returns whether we have a L with the given name. Returns the L with the given name. -=head2 linearized_isa -> [ClassNames] +=head2 C<< linearized_isa -> [ClassNames] >> Returns the list of classes in method dispatch order, with duplicates removed. -=head2 new_object Parameters -> Instance +=head2 C<< new_object(Parameters) -> Instance >> -Create a new instance. +Creates a new instance. -=head2 clone_object Instance -> Instance +=head2 C<< clone_object(Instance, Parameters) -> Instance >> Clones the given C which must be an instance governed by this metaclass. diff --git a/lib/Mouse/Meta/Method.pm b/lib/Mouse/Meta/Method.pm index cbe349a..21cff59 100755 --- a/lib/Mouse/Meta/Method.pm +++ b/lib/Mouse/Meta/Method.pm @@ -19,6 +19,10 @@ sub body { $_[0]->{body} } sub name { $_[0]->{name} } sub package_name{ $_[0]->{package} } +sub fully_qualified_name { + my $self = shift; + return $self->package_name . '::' . $self->name; +} 1; diff --git a/t/021-weak-ref.t b/t/021-weak-ref.t index cdafd3c..3f054c9 100644 --- a/t/021-weak-ref.t +++ b/t/021-weak-ref.t @@ -2,16 +2,7 @@ use strict; use warnings; -use Test::More; -BEGIN { - if (eval "require Scalar::Util; 1") { - plan tests => 21; - } - else { - plan skip_all => "Scalar::Util required for this test"; - } -} - +use Test::More tests => 31; use Test::Exception; my %destroyed; @@ -35,7 +26,9 @@ do { $destroyed{ $self->type }++; } }; +}; +sub do_test{ my $self = Class->new(type => 'accessor'); $self->self($self); @@ -47,12 +40,23 @@ do { ok(Scalar::Util::isweak($object->{self}), "weak reference"); ok($object->self->self->self->self, "we've got circularity"); } -}; +} + +do_test(); is($destroyed{accessor}, 1, "destroyed from the accessor"); is($destroyed{constructor}, 1, "destroyed from the constructor"); is($destroyed{middle}, 1, "casuality of war"); +Class->meta->make_immutable(); +ok(Class->meta->is_immutable, 'make_immutable made it immutable'); +do_test(); + +is($destroyed{accessor}, 2, "destroyed from the accessor (after make_immutable)"); +is($destroyed{constructor}, 2, "destroyed from the constructor (after make_immutable)"); +is($destroyed{middle}, 2, "casuality of war (after make_immutable)"); + + ok(!Class->meta->get_attribute('type')->is_weak_ref, "type is not a weakref"); ok(Class->meta->get_attribute('self')->is_weak_ref, "self IS a weakref"); diff --git a/t/025-more-isa.t b/t/025-more-isa.t index 3485956..6e621a7 100755 --- a/t/025-more-isa.t +++ b/t/025-more-isa.t @@ -92,6 +92,7 @@ do { sub bar {} package I; + no warnings 'once'; # work around 5.6.2 our $NOT_CODE = 1; }; diff --git a/t/100-meta-class.t b/t/100-meta-class.t index 7a921bb..4b413bd 100644 --- a/t/100-meta-class.t +++ b/t/100-meta-class.t @@ -1,7 +1,7 @@ #!/usr/bin/env perl use strict; use warnings; -use Test::More tests => 22; +use Test::More tests => 26; use Test::Exception; { package Class; @@ -96,3 +96,16 @@ ok($child_meta->has_method('child_method')); is( join(' ', sort $child_meta->get_method_list), join(' ', sort qw(meta bishop child_method)) ); + +can_ok($child_meta, 'find_method_by_name'); +is $child_meta->find_method_by_name('child_method')->fully_qualified_name, 'Child::child_method'; +is $child_meta->find_method_by_name('pawn')->fully_qualified_name, 'Class::pawn'; + + +is( join(' ', sort map{ $_->fully_qualified_name } grep{ $_->package_name ne 'Mouse::Object' } $child_meta->get_all_methods), + join(' ', sort qw( + Child::bishop Child::child_method Child::meta + + Class::MY_CONST Class::has_pawn Class::pawn Class::stub Class::stub_with_attr + )) +); diff --git a/t/400-define-role.t b/t/400-define-role.t index 47ac4ee..7067651 100644 --- a/t/400-define-role.t +++ b/t/400-define-role.t @@ -71,7 +71,8 @@ TODO: { eval { excludes 'excluded'; }; - local our $TODO = "Mouse::Role does not currently support 'excludes'"; + our $TODO; + local $TODO = "Mouse::Role does not currently support 'excludes'"; ::ok(!$@, "excludes"); no Mouse::Role;