From: Stevan Little Date: Wed, 4 Jun 2008 06:24:35 +0000 (+0000) Subject: some speed gains and a new test X-Git-Tag: 0_55~125 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=21f1e23149cf11f1259e7a008dba1bd9a6402e6a;p=gitmo%2FMoose.git some speed gains and a new test --- diff --git a/Changes b/Changes index a1cc1dc..3adb109 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,23 @@ Revision history for Perl extension Moose +0.49 + * Moose::Meta::Attribute + - fixed how the is => (ro|rw) works with + custom defined reader, writer and accessor + options. + - added docs for this (TODO). + - added tests for this (Thanks to Penfold) + - added the custom attribute alias for regular + Moose attributes which is "Moose" + + * Moose + Moose::Meta::Class + Moose::Meta::Attribute + Moose::Meta::Role + Moose::Meta::Role::Composite + Moose::Util::TypeConstraints + - + 0.48 Thurs. May 29, 2008 (early morning release engineering)-- diff --git a/README b/README index 8d43d52..2c60542 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -Moose version 0.48 +Moose version 0.49 =========================== See the individual module documentation for more information diff --git a/lib/Moose.pm b/lib/Moose.pm index f90c67c..332593a 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -4,10 +4,10 @@ package Moose; use strict; use warnings; -our $VERSION = '0.48'; +our $VERSION = '0.49'; our $AUTHORITY = 'cpan:STEVAN'; -use Scalar::Util 'blessed', 'reftype'; +use Scalar::Util 'blessed'; use Carp 'confess', 'croak', 'cluck'; use Sub::Exporter; diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 6759ec9..34c16ca 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -4,11 +4,11 @@ package Moose::Meta::Attribute; use strict; use warnings; -use Scalar::Util 'blessed', 'weaken', 'reftype'; +use Scalar::Util 'blessed', 'weaken'; use Carp 'confess'; use overload (); -our $VERSION = '0.24'; +our $VERSION = '0.26'; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Method::Accessor; @@ -207,11 +207,28 @@ sub _process_options { my ($class, $name, $options) = @_; if (exists $options->{is}) { + +=pod + +is => ro, writer => _foo # turns into (reader => foo, writer => _foo) as before +is => rw, writer => _foo # turns into (reader => foo, writer => _foo) +is => rw, accessor => _foo # turns into (accessor => _foo) +is => ro, accessor => _foo # error, accesor is rw + +=cut + if ($options->{is} eq 'ro') { + confess "Cannot define an accessor name on a read-only attribute, accessors are read/write" + if exists $options->{accessor}; $options->{reader} ||= $name; } elsif ($options->{is} eq 'rw') { - $options->{accessor} = $name; + if ($options->{writer}) { + $options->{reader} ||= $name; + } + else { + $options->{accessor} ||= $name; + } } else { confess "I do not understand this option (is => " . $options->{is} . ") on attribute $name" @@ -255,7 +272,7 @@ sub _process_options { } if (exists $options->{trigger}) { - (reftype($options->{trigger}) || '') eq 'CODE' + ('CODE' eq ref $options->{trigger}) || confess "Trigger must be a CODE ref"; } @@ -522,7 +539,7 @@ sub install_accessors { #cluck("Not delegating method '$handle' because it is a core method") and next if $class_name->isa("Moose::Object") and $handle =~ /^BUILD|DEMOLISH$/ || Moose::Object->can($handle); - if ((reftype($method_to_call) || '') eq 'CODE') { + if ('CODE' eq ref($method_to_call)) { $associated_class->add_method($handle => Class::MOP::subname($name, $method_to_call)); } else { @@ -629,6 +646,9 @@ sub _get_delegate_method_list { } } +package Moose::Meta::Attribute::Custom::Moose; +sub register_implementation { 'Moose::Meta::Attribute' } + 1; __END__ diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 352400c..f151258 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -7,9 +7,9 @@ use warnings; use Class::MOP; use Carp 'confess'; -use Scalar::Util 'weaken', 'blessed', 'reftype'; +use Scalar::Util 'weaken', 'blessed'; -our $VERSION = '0.23'; +our $VERSION = '0.24'; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Method::Overriden; diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm index fd437ca..5774648 100644 --- a/lib/Moose/Meta/Role.pm +++ b/lib/Moose/Meta/Role.pm @@ -6,9 +6,9 @@ use warnings; use metaclass; use Carp 'confess'; -use Scalar::Util 'blessed', 'reftype'; +use Scalar::Util 'blessed'; -our $VERSION = '0.14'; +our $VERSION = '0.15'; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Class; @@ -357,7 +357,7 @@ sub alias_method { || confess "You must define a method name"; my $body = (blessed($method) ? $method->body : $method); - ('CODE' eq (reftype($body) || '')) + ('CODE' eq ref($body)) || confess "Your code block must be a CODE reference"; $self->add_package_symbol("&${method_name}" => $body); diff --git a/lib/Moose/Meta/Role/Composite.pm b/lib/Moose/Meta/Role/Composite.pm index ba719e1..99a3431 100644 --- a/lib/Moose/Meta/Role/Composite.pm +++ b/lib/Moose/Meta/Role/Composite.pm @@ -5,9 +5,9 @@ use warnings; use metaclass; use Carp 'confess'; -use Scalar::Util 'blessed', 'reftype'; +use Scalar::Util 'blessed'; -our $VERSION = '0.02'; +our $VERSION = '0.03'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::Role'; diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 9cde8d6..9e3a832 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -5,10 +5,10 @@ use strict; use warnings; use Carp 'confess'; -use Scalar::Util 'blessed', 'reftype'; +use Scalar::Util 'blessed'; use Sub::Exporter; -our $VERSION = '0.23'; +our $VERSION = '0.24'; our $AUTHORITY = 'cpan:STEVAN'; ## -------------------------------------------------------- @@ -290,7 +290,7 @@ sub subtype ($$;$$$) { # subtype(MyNumbers => as Num); # now MyNumbers is the same as Num # ... yeah I know it's ugly code # - SL - unshift @_ => undef if scalar @_ <= 2 && (reftype($_[1]) || '') eq 'CODE'; + unshift @_ => undef if scalar @_ <= 2 && ('CODE' eq ref($_[1])); goto &_create_type_constraint; } diff --git a/t/020_attributes/021_method_generation_rules.t b/t/020_attributes/021_method_generation_rules.t new file mode 100644 index 0000000..db96f52 --- /dev/null +++ b/t/020_attributes/021_method_generation_rules.t @@ -0,0 +1,65 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 18; +use Test::Exception; + +BEGIN { + use_ok('Moose'); +} + +=pod + + is => rw, writer => _foo # turns into (reader => foo, writer => _foo) + is => ro, writer => _foo # turns into (reader => foo, writer => _foo) as before + is => rw, accessor => _foo # turns into (accessor => _foo) + is => ro, accessor => _foo # error, accesor is rw + +=cut + +sub make_class { + my ($is, $attr, $class) = @_; + + eval "package $class; use Moose; has 'foo' => ( is => '$is', $attr => '_foo' );"; + + return $@ ? die $@ : $class; +} + +my $obj; +my $class; + +$class = make_class('rw', 'writer', 'Test::Class::WriterRW'); +ok($class, "Can define attr with rw + writer"); + +$obj = $class->new(); + +can_ok($obj, qw/foo _foo/); +lives_ok {$obj->_foo(1)} "$class->_foo is writer"; +is($obj->foo(), 1, "$class->foo is reader"); +dies_ok {$obj->foo(2)} "$class->foo is not writer"; # this should fail +ok(!defined $obj->_foo(), "$class->_foo is not reader"); + +$class = make_class('ro', 'writer', 'Test::Class::WriterRO'); +ok($class, "Can define attr with ro + writer"); + +$obj = $class->new(); + +can_ok($obj, qw/foo _foo/); +lives_ok {$obj->_foo(1)} "$class->_foo is writer"; +is($obj->foo(), 1, "$class->foo is reader"); +dies_ok {$obj->foo(1)} "$class->foo is not writer"; +isnt($obj->_foo(), 1, "$class->_foo is not reader"); + +$class = make_class('rw', 'accessor', 'Test::Class::AccessorRW'); +ok($class, "Can define attr with rw + accessor"); + +$obj = $class->new(); + +can_ok($obj, qw/_foo/); +lives_ok {$obj->_foo(1)} "$class->_foo is writer"; +is($obj->_foo(), 1, "$class->foo is reader"); + +dies_ok { make_class('ro', 'accessor', "Test::Class::AccessorRO"); } "Cant define attr with ro + accessor"; +