From: Stevan Little Date: Fri, 3 Nov 2006 05:30:38 +0000 (+0000) Subject: tests pass now X-Git-Tag: 0_16~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=39b3bc94309529721acb365c64b2ff52a0c2be35;p=gitmo%2FMoose.git tests pass now --- diff --git a/lib/Moose.pm b/lib/Moose.pm index 3264473..0f98b57 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -1,4 +1,6 @@ +use lib '/Users/stevan/Projects/Moose/Moose/Class-MOP/trunk/lib'; + package Moose; use strict; diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 91132d5..b9bcb6d 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -229,21 +229,21 @@ sub initialize_instance_slot { ## Slot management -sub set_value { - my ($self, $instance, $value) = @_; -} - -sub get_value { - my ($self, $instance) = @_; -} - -sub has_value { - my ($self, $instance) = @_; -} - -sub clear_value { - my ($self, $instance) = @_; -} +#sub set_value { +# my ($self, $instance, $value) = @_; +#} +# +#sub get_value { +# my ($self, $instance) = @_; +#} +# +#sub has_value { +# my ($self, $instance) = @_; +#} +# +#sub clear_value { +# my ($self, $instance) = @_; +#} ## installing accessors @@ -394,14 +394,10 @@ will behave just as L does. =item B -=item B - -=item B - -=item B - =item B +=item B + =back =head2 Additional Moose features diff --git a/lib/Moose/Meta/Method.pm b/lib/Moose/Meta/Method.pm index 8c902f0..4907a70 100644 --- a/lib/Moose/Meta/Method.pm +++ b/lib/Moose/Meta/Method.pm @@ -13,4 +13,37 @@ __END__ =pod +=head1 NAME + +=head1 SYNOPOSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan@iinteractive.comE + +Yuval Kogman Enothingmuch@woobling.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + =cut \ No newline at end of file diff --git a/lib/Moose/Meta/Method/Accessor.pm b/lib/Moose/Meta/Method/Accessor.pm index 2fc64b3..e353af2 100644 --- a/lib/Moose/Meta/Method/Accessor.pm +++ b/lib/Moose/Meta/Method/Accessor.pm @@ -1,28 +1,20 @@ +use lib '/Users/stevan/Projects/Moose/Moose/Class-MOP/trunk/lib'; + package Moose::Meta::Method::Accessor; use strict; use warnings; +use Carp 'confess'; + our $VERSION = '0.01'; -use base 'Moose::Meta::Method'; +use base 'Moose::Meta::Method', 'Class::MOP::Method::Accessor'; ## generators -sub generate_predicate_method { - my $self = shift; - my $attr = $self->associated_attribute; - my $attr_name = $attr->name; -} - -sub generate_clearer_method { - my $self = shift; - my $attr = $self->associated_attribute; - my $attr_name = $attr->name; -} - sub generate_accessor_method { my $self = shift; my $attr = $self->associated_attribute; @@ -86,7 +78,6 @@ sub generate_reader_method { my $attr = $self->associated_attribute; my $attr_name = $attr->name; - my $attr_name = $attr->slots; my $code = 'sub {' . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;' . $self->_inline_check_lazy @@ -97,50 +88,34 @@ sub generate_reader_method { return $sub; } -## Inline methods - -sub generate_accessor_method_inline { - my $self = shift; - my $attr = $self->associated_attribute; - my $attr_name = $attr->name; - my $meta_instance = $attr->associated_class->instance_metaclass; -} - -sub generate_reader_method_inline { - my $self = shift; - my $attr = $self->associated_attribute; - my $attr_name = $attr->name; - my $meta_instance = $attr->associated_class->instance_metaclass; -} - -sub generate_writer_method_inline { - my $self = shift; - my $attr = $self->associated_attribute; - my $attr_name = $attr->name; - my $meta_instance = $attr->associated_class->instance_metaclass; -} - - -sub generate_predicate_method_inline { - my $self = shift; - my $attr = $self->associated_attribute; - my $attr_name = $attr->name; - my $meta_instance = $attr->associated_class->instance_metaclass; -} +#sub generate_predicate_method { +# my $self = shift; +# my $attr = $self->associated_attribute; +# my $attr_name = $attr->name; +#} +# +#sub generate_clearer_method { +# my $self = shift; +# my $attr = $self->associated_attribute; +# my $attr_name = $attr->name; +#} -sub generate_clearer_method_inline { - my $self = shift; - my $attr = $self->associated_attribute; - my $attr_name = $attr->name; - my $meta_instance = $attr->associated_class->instance_metaclass; -} +## Inline methods -## +*generate_accessor_method_inline = \&generate_accessor_method; +*generate_reader_method_inline = \&generate_reader_method; +*generate_writer_method_inline = \&generate_writer_method; +#*generate_predicate_method_inline = \&generate_predicate_method; +#*generate_clearer_method_inline = \&generate_clearer_method; +## ... private helpers sub _inline_check_constraint { my ($self, $value) = @_; - return '' unless $self->has_type_constraint; + + my $attr = $self->associated_attribute; + + return '' unless $attr->has_type_constraint; # FIXME - remove 'unless defined($value) - constraint Undef return sprintf <<'EOF', $value, $value, $value, $value @@ -152,21 +127,25 @@ EOF } sub _inline_check_coercion { - my $self = shift; - return '' unless $self->should_coerce; + my $attr = (shift)->associated_attribute; + + return '' unless $attr->should_coerce; return 'my $val = $attr->type_constraint->coerce($_[1]);' } sub _inline_check_required { - my $self = shift; - return '' unless $self->is_required; + my $attr = (shift)->associated_attribute; + + return '' unless $attr->is_required; return 'defined($_[1]) || confess "Attribute ($attr_name) is required, so cannot be set to undef";' } sub _inline_check_lazy { - my $self = shift; - return '' unless $self->is_lazy; - if ($self->has_type_constraint) { + my $attr = (shift)->associated_attribute; + + return '' unless $attr->is_lazy; + + if ($attr->has_type_constraint) { # NOTE: # this could probably be cleaned # up and streamlined a little more @@ -191,37 +170,41 @@ sub _inline_check_lazy { sub _inline_store { my ($self, $instance, $value) = @_; + my $attr = $self->associated_attribute; - my $mi = $self->associated_class->get_meta_instance; - my $slot_name = sprintf "'%s'", $self->slots; + my $mi = $attr->associated_class->get_meta_instance; + my $slot_name = sprintf "'%s'", $attr->slots; my $code = $mi->inline_set_slot_value($instance, $slot_name, $value) . ";"; $code .= $mi->inline_weaken_slot_value($instance, $slot_name, $value) . ";" - if $self->is_weak_ref; + if $attr->is_weak_ref; return $code; } sub _inline_trigger { my ($self, $instance, $value) = @_; - return '' unless $self->has_trigger; + my $attr = $self->associated_attribute; + return '' unless $attr->has_trigger; return sprintf('$attr->trigger->(%s, %s, $attr);', $instance, $value); } sub _inline_get { my ($self, $instance) = @_; + my $attr = $self->associated_attribute; - my $mi = $self->associated_class->get_meta_instance; - my $slot_name = sprintf "'%s'", $self->slots; + my $mi = $attr->associated_class->get_meta_instance; + my $slot_name = sprintf "'%s'", $attr->slots; return $mi->inline_get_slot_value($instance, $slot_name); } sub _inline_auto_deref { my ( $self, $ref_value ) = @_; + my $attr = $self->associated_attribute; - return $ref_value unless $self->should_auto_deref; + return $ref_value unless $attr->should_auto_deref; - my $type_constraint = $self->type_constraint; + my $type_constraint = $attr->type_constraint; my $sigil; if ($type_constraint->is_a_type_of('ArrayRef')) { @@ -243,4 +226,49 @@ __END__ =pod +=head1 NAME + +=head1 SYNOPOSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan@iinteractive.comE + +Yuval Kogman Enothingmuch@woobling.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + =cut \ No newline at end of file diff --git a/lib/Moose/Meta/Method/Overriden.pm b/lib/Moose/Meta/Method/Overriden.pm index 7114976..7d04326 100644 --- a/lib/Moose/Meta/Method/Overriden.pm +++ b/lib/Moose/Meta/Method/Overriden.pm @@ -13,4 +13,37 @@ __END__ =pod +=head1 NAME + +=head1 SYNOPOSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan@iinteractive.comE + +Yuval Kogman Enothingmuch@woobling.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + =cut \ No newline at end of file diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm index fbe9424..d7bc664 100644 --- a/lib/Moose/Meta/Role.pm +++ b/lib/Moose/Meta/Role.pm @@ -12,6 +12,7 @@ use B 'svref_2object'; our $VERSION = '0.05'; use Moose::Meta::Class; +use Moose::Meta::Role::Method; use base 'Class::MOP::Module'; @@ -326,7 +327,7 @@ sub _check_required_methods { my $method = $other->get_method($required_method_name); # check if it is an override or a generated accessor .. (!$method->isa('Moose::Meta::Method::Overriden') && - !$method->isa('Class::MOP::Attribute::Accessor')) + !$method->isa('Class::MOP::Method::Accessor')) || confess "'" . $self->name . "' requires the method '$required_method_name' " . "to be implemented by '" . $other->name . "', the method is only a method modifier"; # before/after/around methods are a little trickier @@ -540,15 +541,6 @@ sub combine { return $combined; } -package Moose::Meta::Role::Method; - -use strict; -use warnings; - -our $VERSION = '0.01'; - -use base 'Class::MOP::Method'; - 1; __END__ diff --git a/lib/Moose/Meta/Role/Method.pm b/lib/Moose/Meta/Role/Method.pm new file mode 100644 index 0000000..b95973d --- /dev/null +++ b/lib/Moose/Meta/Role/Method.pm @@ -0,0 +1,50 @@ + +package Moose::Meta::Role::Method; + +use strict; +use warnings; + +our $VERSION = '0.01'; + +use base 'Class::MOP::Method'; + +1; + +__END__ + +=pod + +=head1 NAME + +=head1 SYNOPOSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan@iinteractive.comE + +Yuval Kogman Enothingmuch@woobling.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut \ No newline at end of file diff --git a/lib/Moose/Meta/TypeConstraint/Union.pm b/lib/Moose/Meta/TypeConstraint/Union.pm index 9167111..0e43472 100644 --- a/lib/Moose/Meta/TypeConstraint/Union.pm +++ b/lib/Moose/Meta/TypeConstraint/Union.pm @@ -115,4 +115,67 @@ __END__ =pod +=head1 NAME + +=head1 SYNOPOSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan@iinteractive.comE + +Yuval Kogman Enothingmuch@woobling.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + =cut diff --git a/t/300_immutable_moose.t b/t/300_immutable_moose.t index 4f30812..eb126bd 100644 --- a/t/300_immutable_moose.t +++ b/t/300_immutable_moose.t @@ -3,4 +3,9 @@ use strict; use warnings; -use Test::More no_plan => 1; \ No newline at end of file +use Test::More no_plan => 1; +use Test::Exception; + +BEGIN { + use_ok('Moose'); +}