From: Stevan Little Date: Sat, 15 Apr 2006 20:36:26 +0000 (+0000) Subject: BUGS X-Git-Tag: 0_05~32 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=446e850ff17832686a136e4363316a259783cb9c;p=gitmo%2FMoose.git BUGS --- diff --git a/lib/Moose.pm b/lib/Moose.pm index a7f185c..c100bf2 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -32,7 +32,8 @@ sub import { # make a subtype for each Moose class subtype $pkg => as 'Object' - => where { $_->isa($pkg) }; + => where { $_->isa($pkg) } + unless find_type_constraint($pkg); my $meta; if ($pkg->can('meta')) { @@ -219,6 +220,8 @@ more :) =item Moose Offers Often Super Extensions +=item Meta Object Orientation Syntax Extensions + =back =head1 BUILDING CLASSES WITH MOOSE diff --git a/lib/Moose/Cookbook/Recipe6.pod b/lib/Moose/Cookbook/Recipe6.pod index 281de44..42c2381 100644 --- a/lib/Moose/Cookbook/Recipe6.pod +++ b/lib/Moose/Cookbook/Recipe6.pod @@ -7,86 +7,65 @@ Moose::Cookbook::Recipe6 - The Moose::Role example =head1 SYNOPSIS - package Constraint; + package Eq; use strict; use warnings; use Moose::Role; - has 'value' => (isa => 'Int', is => 'ro'); + requires 'equal_to'; - around 'validate' => sub { - my $c = shift; - my ($self, $field) = @_; - return undef if $c->($self, $self->validation_value($field)); - return $self->error_message; - }; - - sub validation_value { - my ($self, $field) = @_; - return $field; + sub not_equal_to { + my ($self, $other) = @_; + !$self->equal_to($other); } - sub error_message { confess "Abstract method!" } - - package Constraint::OnLength; + package Ord; use strict; use warnings; use Moose::Role; - has 'units' => (isa => 'Str', is => 'ro'); + with 'Eq'; - override 'validation_value' => sub { - return length(super()); - }; + requires 'compare'; - override 'error_message' => sub { - my $self = shift; - return super() . ' ' . $self->units; - }; + sub equal_to { + my ($self, $other) = @_; + $self->compare($other) == 0; + } - package Constraint::AtLeast; - use strict; - use warnings; - use Moose; + sub greater_than { + my ($self, $other) = @_; + $self->compare($other) == 1; + } - with 'Constraint'; - - sub validate { - my ($self, $field) = @_; - ($field >= $self->value); + sub less_than { + my ($self, $other) = @_; + $self->compare($other) == -1; } - sub error_message { 'must be at least ' . (shift)->value; } - - package Constraint::NoMoreThan; - use strict; - use warnings; - use Moose; - - with 'Constraint'; + sub greater_than_or_equal_to { + my ($self, $other) = @_; + $self->greater_than($other) || $self->equal_to($other); + } - sub validate { - my ($self, $field) = @_; - ($field <= $self->value); - } + sub less_than_or_equal_to { + my ($self, $other) = @_; + $self->less_than($other) || $self->equal_to($other); + } - sub error_message { 'must be no more than ' . (shift)->value; } - - package Constraint::LengthNoMoreThan; + package US::Currency; use strict; use warnings; use Moose; - extends 'Constraint::NoMoreThan'; - with 'Constraint::OnLength'; - - package Constraint::LengthAtLeast; - use strict; - use warnings; - use Moose; + with 'Ord'; - extends 'Constraint::AtLeast'; - with 'Constraint::OnLength'; + has 'amount' => (is => 'rw', isa => 'Int', default => 0); + + sub compare { + my ($self, $other) = @_; + $self->amount <=> $other->amount; + } =head1 DESCRIPTION diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 21ce718..a958a82 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -41,7 +41,7 @@ sub new { } else { # otherwise assume it is a constraint - my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options{isa}); + my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options{isa}); # if the constraing it not found .... unless (defined $constraint) { # assume it is a foreign class, and make diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 4ac9ef2..dd6b796 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -7,7 +7,7 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed'; -our $VERSION = '0.03'; +our $VERSION = '0.04'; use Moose::Meta::TypeConstraint; use Moose::Meta::TypeCoercion; @@ -24,13 +24,22 @@ sub import { { my %TYPES; - sub find_type_constraint { $TYPES{$_[0]}->[1] } - + sub find_type_constraint { + return $TYPES{$_[0]}->[1] + if exists $TYPES{$_[0]}; + return; + } + + sub _dump_type_constraints { + require Data::Dumper; + Data::Dumper::Dumper \%TYPES; + } + sub _create_type_constraint { my ($name, $parent, $check, $message) = @_; my $pkg_defined_in = scalar(caller(1)); ($TYPES{$name}->[0] eq $pkg_defined_in) - || confess "The type constraint '$name' has already been created" + || confess "The type constraint '$name' has already been created " if defined $name && exists $TYPES{$name}; $parent = find_type_constraint($parent) if defined $parent; my $constraint = Moose::Meta::TypeConstraint->new( diff --git a/t/006_basic.t b/t/006_basic.t index 75b416f..52efb19 100644 --- a/t/006_basic.t +++ b/t/006_basic.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 21; +use Test::More tests => 52; use Test::Exception; BEGIN { @@ -13,130 +13,152 @@ BEGIN { ## Roles { - package Constraint; + package Eq; use strict; use warnings; use Moose::Role; - - has 'value' => (isa => 'Int', is => 'ro'); - - around 'validate' => sub { - my $c = shift; - my ($self, $field) = @_; - return undef if $c->($self, $self->validation_value($field)); - return $self->error_message; - }; - sub validation_value { - my ($self, $field) = @_; - return $field; - } + requires 'equal_to'; - sub error_message { confess "Abstract method!" } + sub not_equal_to { + my ($self, $other) = @_; + !$self->equal_to($other); + } - package Constraint::OnLength; + package Ord; use strict; use warnings; use Moose::Role; - - has 'units' => (isa => 'Str', is => 'ro'); - - override 'validation_value' => sub { - return length(super()); - }; - - override 'error_message' => sub { - my $self = shift; - return super() . ' ' . $self->units; - }; - + + with 'Eq'; + + requires 'compare'; + + sub equal_to { + my ($self, $other) = @_; + $self->compare($other) == 0; + } + + sub greater_than { + my ($self, $other) = @_; + $self->compare($other) == 1; + } + + sub less_than { + my ($self, $other) = @_; + $self->compare($other) == -1; + } + + sub greater_than_or_equal_to { + my ($self, $other) = @_; + $self->greater_than($other) || $self->equal_to($other); + } + + sub less_than_or_equal_to { + my ($self, $other) = @_; + $self->less_than($other) || $self->equal_to($other); + } } -## Classes +## Classes { - package Constraint::AtLeast; + package US::Currency; use strict; use warnings; use Moose; + + with 'Ord'; + + has 'amount' => (is => 'rw', isa => 'Int', default => 0); + + sub compare { + my ($self, $other) = @_; + $self->amount <=> $other->amount; + } +} - with 'Constraint'; +ok(US::Currency->does('Ord'), '... US::Currency does Ord'); +ok(US::Currency->does('Eq'), '... US::Currency does Eq'); - sub validate { - my ($self, $field) = @_; - ($field >= $self->value); - } +my $hundred = US::Currency->new(amount => 100.00); +isa_ok($hundred, 'US::Currency'); - sub error_message { 'must be at least ' . (shift)->value; } +can_ok($hundred, 'amount'); +is($hundred->amount, 100, '... got the right amount'); - package Constraint::NoMoreThan; - use strict; - use warnings; - use Moose; +ok($hundred->does('Ord'), '... US::Currency does Ord'); +ok($hundred->does('Eq'), '... US::Currency does Eq'); - with 'Constraint'; +my $fifty = US::Currency->new(amount => 50.00); +isa_ok($fifty, 'US::Currency'); - sub validate { - my ($self, $field) = @_; - ($field <= $self->value); - } +can_ok($fifty, 'amount'); +is($fifty->amount, 50, '... got the right amount'); - sub error_message { 'must be no more than ' . (shift)->value; } +ok($hundred->greater_than($fifty), '... 100 gt 50'); +ok($hundred->greater_than_or_equal_to($fifty), '... 100 ge 50'); +ok(!$hundred->less_than($fifty), '... !100 lt 50'); +ok(!$hundred->less_than_or_equal_to($fifty), '... !100 le 50'); +ok(!$hundred->equal_to($fifty), '... !100 eq 50'); +ok($hundred->not_equal_to($fifty), '... 100 ne 50'); - package Constraint::LengthNoMoreThan; - use strict; - use warnings; - use Moose; +ok(!$fifty->greater_than($hundred), '... !50 gt 100'); +ok(!$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100'); +ok($fifty->less_than($hundred), '... 50 lt 100'); +ok($fifty->less_than_or_equal_to($hundred), '... 50 le 100'); +ok(!$fifty->equal_to($hundred), '... !50 eq 100'); +ok($fifty->not_equal_to($hundred), '... 50 ne 100'); - extends 'Constraint::NoMoreThan'; - with 'Constraint::OnLength'; - - package Constraint::LengthAtLeast; - use strict; - use warnings; - use Moose; - - extends 'Constraint::AtLeast'; - with 'Constraint::OnLength'; -} +ok(!$fifty->greater_than($fifty), '... !50 gt 50'); +ok($fifty->greater_than_or_equal_to($fifty), '... !50 ge 50'); +ok(!$fifty->less_than($fifty), '... 50 lt 50'); +ok($fifty->less_than_or_equal_to($fifty), '... 50 le 50'); +ok($fifty->equal_to($fifty), '... 50 eq 50'); +ok(!$fifty->not_equal_to($fifty), '... !50 ne 50'); -my $no_more_than_10 = Constraint::NoMoreThan->new(value => 10); -isa_ok($no_more_than_10, 'Constraint::NoMoreThan'); +## ... check some meta-stuff -ok($no_more_than_10->does('Constraint'), '... Constraint::NoMoreThan does Constraint'); +# Eq -ok(!defined($no_more_than_10->validate(1)), '... validated correctly'); -is($no_more_than_10->validate(11), 'must be no more than 10', '... validation failed correctly'); +my $eq_meta = Eq->meta; +isa_ok($eq_meta, 'Moose::Meta::Role'); -my $at_least_10 = Constraint::AtLeast->new(value => 10); -isa_ok($at_least_10, 'Constraint::AtLeast'); +ok($eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to'); +ok($eq_meta->requires_method('equal_to'), '... Eq requires_method not_equal_to'); -ok($at_least_10->does('Constraint'), '... Constraint::AtLeast does Constraint'); +# Ord -ok(!defined($at_least_10->validate(11)), '... validated correctly'); -is($at_least_10->validate(1), 'must be at least 10', '... validation failed correctly'); +my $ord_meta = Ord->meta; +isa_ok($ord_meta, 'Moose::Meta::Role'); -# onlength +ok($ord_meta->does_role('Eq'), '... Ord does Eq'); -my $no_more_than_10_chars = Constraint::LengthNoMoreThan->new(value => 10, units => 'chars'); -isa_ok($no_more_than_10_chars, 'Constraint::LengthNoMoreThan'); -isa_ok($no_more_than_10_chars, 'Constraint::NoMoreThan'); +foreach my $method_name (qw( + equal_to not_equal_to + greater_than greater_than_or_equal_to + less_than less_than_or_equal_to + )) { + ok($ord_meta->has_method($method_name), '... Ord has_method ' . $method_name); +} -ok($no_more_than_10_chars->does('Constraint'), '... Constraint::LengthNoMoreThan does Constraint'); -ok($no_more_than_10_chars->does('Constraint::OnLength'), '... Constraint::LengthNoMoreThan does Constraint::OnLength'); +ok($ord_meta->requires_method('compare'), '... Ord requires_method compare'); -ok(!defined($no_more_than_10_chars->validate('foo')), '... validated correctly'); -is($no_more_than_10_chars->validate('foooooooooo'), - 'must be no more than 10 chars', - '... validation failed correctly'); +# US::Currency -my $at_least_10_chars = Constraint::LengthAtLeast->new(value => 10, units => 'chars'); -isa_ok($at_least_10_chars, 'Constraint::LengthAtLeast'); -isa_ok($at_least_10_chars, 'Constraint::AtLeast'); +my $currency_meta = US::Currency->meta; +isa_ok($currency_meta, 'Moose::Meta::Class'); -ok($at_least_10_chars->does('Constraint'), '... Constraint::LengthAtLeast does Constraint'); -ok($at_least_10_chars->does('Constraint::OnLength'), '... Constraint::LengthAtLeast does Constraint::OnLength'); +ok($currency_meta->does_role('Ord'), '... US::Currency does Ord'); +ok($currency_meta->does_role('Eq'), '... US::Currency does Eq'); -ok(!defined($at_least_10_chars->validate('barrrrrrrrr')), '... validated correctly'); -is($at_least_10_chars->validate('bar'), 'must be at least 10 chars', '... validation failed correctly'); +foreach my $method_name (qw( + amount + equal_to not_equal_to + compare + greater_than greater_than_or_equal_to + less_than less_than_or_equal_to + )) { + ok($currency_meta->has_method($method_name), '... US::Currency has_method ' . $method_name); +} diff --git a/t/007_basic.t b/t/007_basic.t index bcafd6b..75b416f 100644 --- a/t/007_basic.t +++ b/t/007_basic.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 52; +use Test::More tests => 21; use Test::Exception; BEGIN { @@ -13,151 +13,130 @@ BEGIN { ## Roles { - package Eq; + package Constraint; use strict; use warnings; use Moose::Role; + + has 'value' => (isa => 'Int', is => 'ro'); + + around 'validate' => sub { + my $c = shift; + my ($self, $field) = @_; + return undef if $c->($self, $self->validation_value($field)); + return $self->error_message; + }; - requires 'equal_to'; - - sub not_equal_to { - my ($self, $other) = @_; - !$self->equal_to($other); + sub validation_value { + my ($self, $field) = @_; + return $field; } - package Ord; + sub error_message { confess "Abstract method!" } + + package Constraint::OnLength; use strict; use warnings; use Moose::Role; - - with 'Eq'; - - requires 'compare'; - - sub equal_to { - my ($self, $other) = @_; - $self->compare($other) == 0; - } - - sub greater_than { - my ($self, $other) = @_; - $self->compare($other) == 1; - } - - sub less_than { - my ($self, $other) = @_; - $self->compare($other) == -1; - } - - sub greater_than_or_equal_to { - my ($self, $other) = @_; - $self->greater_than($other) || $self->equal_to($other); - } - - sub less_than_or_equal_to { - my ($self, $other) = @_; - $self->less_than($other) || $self->equal_to($other); - } + + has 'units' => (isa => 'Str', is => 'ro'); + + override 'validation_value' => sub { + return length(super()); + }; + + override 'error_message' => sub { + my $self = shift; + return super() . ' ' . $self->units; + }; + } -## Classes +## Classes { - package US::Currency; + package Constraint::AtLeast; use strict; use warnings; use Moose; - - with 'Ord'; - - has 'amount' => (is => 'rw', isa => 'Int', default => 0); - - sub compare { - my ($self, $other) = @_; - $self->amount <=> $other->amount; - } -} -ok(US::Currency->does('Ord'), '... US::Currency does Ord'); -ok(US::Currency->does('Eq'), '... US::Currency does Eq'); + with 'Constraint'; -my $hundred = US::Currency->new(amount => 100.00); -isa_ok($hundred, 'US::Currency'); + sub validate { + my ($self, $field) = @_; + ($field >= $self->value); + } -can_ok($hundred, 'amount'); -is($hundred->amount, 100, '... got the right amount'); + sub error_message { 'must be at least ' . (shift)->value; } -ok($hundred->does('Ord'), '... US::Currency does Ord'); -ok($hundred->does('Eq'), '... US::Currency does Eq'); + package Constraint::NoMoreThan; + use strict; + use warnings; + use Moose; + + with 'Constraint'; -my $fifty = US::Currency->new(amount => 50.00); -isa_ok($fifty, 'US::Currency'); + sub validate { + my ($self, $field) = @_; + ($field <= $self->value); + } -can_ok($fifty, 'amount'); -is($fifty->amount, 50, '... got the right amount'); + sub error_message { 'must be no more than ' . (shift)->value; } -ok($hundred->greater_than($fifty), '... 100 gt 50'); -ok($hundred->greater_than_or_equal_to($fifty), '... 100 ge 50'); -ok(!$hundred->less_than($fifty), '... !100 lt 50'); -ok(!$hundred->less_than_or_equal_to($fifty), '... !100 le 50'); -ok(!$hundred->equal_to($fifty), '... !100 eq 50'); -ok($hundred->not_equal_to($fifty), '... 100 ne 50'); + package Constraint::LengthNoMoreThan; + use strict; + use warnings; + use Moose; -ok(!$fifty->greater_than($hundred), '... !50 gt 100'); -ok(!$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100'); -ok($fifty->less_than($hundred), '... 50 lt 100'); -ok($fifty->less_than_or_equal_to($hundred), '... 50 le 100'); -ok(!$fifty->equal_to($hundred), '... !50 eq 100'); -ok($fifty->not_equal_to($hundred), '... 50 ne 100'); + extends 'Constraint::NoMoreThan'; + with 'Constraint::OnLength'; + + package Constraint::LengthAtLeast; + use strict; + use warnings; + use Moose; + + extends 'Constraint::AtLeast'; + with 'Constraint::OnLength'; +} -ok(!$fifty->greater_than($fifty), '... !50 gt 50'); -ok($fifty->greater_than_or_equal_to($fifty), '... !50 ge 50'); -ok(!$fifty->less_than($fifty), '... 50 lt 50'); -ok($fifty->less_than_or_equal_to($fifty), '... 50 le 50'); -ok($fifty->equal_to($fifty), '... 50 eq 50'); -ok(!$fifty->not_equal_to($fifty), '... !50 ne 50'); +my $no_more_than_10 = Constraint::NoMoreThan->new(value => 10); +isa_ok($no_more_than_10, 'Constraint::NoMoreThan'); -## ... check some meta-stuff +ok($no_more_than_10->does('Constraint'), '... Constraint::NoMoreThan does Constraint'); -# Eq +ok(!defined($no_more_than_10->validate(1)), '... validated correctly'); +is($no_more_than_10->validate(11), 'must be no more than 10', '... validation failed correctly'); -my $eq_meta = Eq->meta; -isa_ok($eq_meta, 'Moose::Meta::Role'); +my $at_least_10 = Constraint::AtLeast->new(value => 10); +isa_ok($at_least_10, 'Constraint::AtLeast'); -ok($eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to'); -ok($eq_meta->requires_method('equal_to'), '... Eq requires_method not_equal_to'); +ok($at_least_10->does('Constraint'), '... Constraint::AtLeast does Constraint'); -# Ord +ok(!defined($at_least_10->validate(11)), '... validated correctly'); +is($at_least_10->validate(1), 'must be at least 10', '... validation failed correctly'); -my $ord_meta = Ord->meta; -isa_ok($ord_meta, 'Moose::Meta::Role'); +# onlength -ok($ord_meta->does_role('Eq'), '... Ord does Eq'); +my $no_more_than_10_chars = Constraint::LengthNoMoreThan->new(value => 10, units => 'chars'); +isa_ok($no_more_than_10_chars, 'Constraint::LengthNoMoreThan'); +isa_ok($no_more_than_10_chars, 'Constraint::NoMoreThan'); -foreach my $method_name (qw( - equal_to not_equal_to - greater_than greater_than_or_equal_to - less_than less_than_or_equal_to - )) { - ok($ord_meta->has_method($method_name), '... Ord has_method ' . $method_name); -} +ok($no_more_than_10_chars->does('Constraint'), '... Constraint::LengthNoMoreThan does Constraint'); +ok($no_more_than_10_chars->does('Constraint::OnLength'), '... Constraint::LengthNoMoreThan does Constraint::OnLength'); -ok($ord_meta->requires_method('compare'), '... Ord requires_method compare'); +ok(!defined($no_more_than_10_chars->validate('foo')), '... validated correctly'); +is($no_more_than_10_chars->validate('foooooooooo'), + 'must be no more than 10 chars', + '... validation failed correctly'); -# US::Currency +my $at_least_10_chars = Constraint::LengthAtLeast->new(value => 10, units => 'chars'); +isa_ok($at_least_10_chars, 'Constraint::LengthAtLeast'); +isa_ok($at_least_10_chars, 'Constraint::AtLeast'); -my $currency_meta = US::Currency->meta; -isa_ok($currency_meta, 'Moose::Meta::Class'); +ok($at_least_10_chars->does('Constraint'), '... Constraint::LengthAtLeast does Constraint'); +ok($at_least_10_chars->does('Constraint::OnLength'), '... Constraint::LengthAtLeast does Constraint::OnLength'); -ok($currency_meta->does_role('Ord'), '... US::Currency does Ord'); -ok($currency_meta->does_role('Eq'), '... US::Currency does Eq'); +ok(!defined($at_least_10_chars->validate('barrrrrrrrr')), '... validated correctly'); +is($at_least_10_chars->validate('bar'), 'must be at least 10 chars', '... validation failed correctly'); -foreach my $method_name (qw( - amount - equal_to not_equal_to - compare - greater_than greater_than_or_equal_to - less_than less_than_or_equal_to - )) { - ok($currency_meta->has_method($method_name), '... US::Currency has_method ' . $method_name); -} diff --git a/t/101_subtype_conflict_bug.t b/t/101_subtype_conflict_bug.t new file mode 100644 index 0000000..095213c --- /dev/null +++ b/t/101_subtype_conflict_bug.t @@ -0,0 +1,15 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; + +use Test::More tests => 3; + +BEGIN { + use_ok('Moose'); +} + +use_ok('MyMooseA'); +use_ok('MyMooseB'); \ No newline at end of file diff --git a/t/lib/MyMooseA.pm b/t/lib/MyMooseA.pm new file mode 100644 index 0000000..1dbdd3a --- /dev/null +++ b/t/lib/MyMooseA.pm @@ -0,0 +1,9 @@ +package MyMooseA; + +use strict; +use warnings; +use Moose; + +has 'b' => (is => 'rw', isa => 'MyMooseB'); + +1; \ No newline at end of file diff --git a/t/lib/MyMooseB.pm b/t/lib/MyMooseB.pm new file mode 100644 index 0000000..b3d4c59 --- /dev/null +++ b/t/lib/MyMooseB.pm @@ -0,0 +1,7 @@ +package MyMooseB; + +use strict; +use warnings; +use Moose; + +1; \ No newline at end of file