From: Stevan Little Date: Mon, 20 Mar 2006 22:38:38 +0000 (+0000) Subject: what-a-mess X-Git-Tag: 0_05~77 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7415b2cb4557d036bd6be89954fc4682cdedc5d5;p=gitmo%2FMoose.git what-a-mess --- diff --git a/lib/Moose.pm b/lib/Moose.pm index d8444b5..6f972bc 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -1,6 +1,4 @@ -use lib '/Users/stevan/Projects/CPAN/Class-MOP/Class-MOP/lib'; - package Moose; use strict; @@ -18,9 +16,10 @@ use Class::MOP; use Moose::Meta::Class; use Moose::Meta::Attribute; +use Moose::Meta::TypeConstraint; use Moose::Object; -use Moose::Util::TypeConstraints ':no_export'; +use Moose::Util::TypeConstraints; sub import { shift; @@ -32,10 +31,9 @@ sub import { Moose::Util::TypeConstraints->import($pkg); # make a subtype for each Moose class - Moose::Util::TypeConstraints::subtype($pkg - => Moose::Util::TypeConstraints::as Object - => Moose::Util::TypeConstraints::where { $_->isa($pkg) } - ); + subtype $pkg + => as Object + => where { $_->isa($pkg) }; my $meta; if ($pkg->can('meta')) { @@ -79,28 +77,26 @@ sub import { if (exists $options{isa}) { # allow for anon-subtypes here ... if (reftype($options{isa}) && reftype($options{isa}) eq 'CODE') { - $options{type_constraint} = $options{isa}; + $options{type_constraint} = Moose::Meta::TypeConstraint->new( + name => '__ANON__', + constraint_code => $options{isa} + ); } else { # otherwise assume it is a constraint - my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options{isa})->constraint_code; + 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 # an anon constraint for it - $constraint = Moose::Util::TypeConstraints::subtype( - Object => Moose::Util::TypeConstraints::where { $_->isa($constraint) } - ); - } + $constraint = Moose::Meta::TypeConstraint->new( + name => '__ANON__', + constraint_code => subtype Object => where { $_->isa($constraint) } + ); + } $options{type_constraint} = $constraint; } } - if (exists $options{coerce} && $options{coerce} && $options{isa}) { - my $coercion = Moose::Util::TypeConstraints::find_type_coercion($options{isa}); - (defined $coercion) - || confess "Cannot find coercion for type " . $options{isa}; - $options{coerce} = $coercion; - } $meta->add_attribute($name, %options) }); diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 332af9e..5d6213b 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -16,7 +16,9 @@ use base 'Class::MOP::Attribute'; Moose::Meta::Attribute->meta->add_attribute( Class::MOP::Attribute->new('coerce' => ( reader => 'coerce', - predicate => 'has_coercion' + predicate => { + 'has_coercion' => sub { $_[0]->coerce() ? 1 : 0 } + } )) ); @@ -43,10 +45,7 @@ Moose::Meta::Attribute->meta->add_before_method_modifier('new' => sub { || confess "You cannot have coercion without specifying a type constraint"; confess "You cannot have a weak reference to a coerced value" if $options{weak_ref}; - } - (reftype($options{type_constraint}) && reftype($options{type_constraint}) eq 'CODE') - || confess "Type cosntraint parameter must be a code-ref, not " . $options{type_constraint} - if exists $options{type_constraint}; + } }); sub generate_accessor_method { @@ -55,7 +54,7 @@ sub generate_accessor_method { if ($self->has_weak_ref) { return sub { if (scalar(@_) == 2) { - (defined $self->type_constraint->($_[1])) + (defined $self->type_constraint->constraint_code->($_[1])) || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'" if defined $_[1]; $_[0]->{$attr_name} = $_[1]; @@ -68,8 +67,8 @@ sub generate_accessor_method { if ($self->has_coercion) { return sub { if (scalar(@_) == 2) { - my $val = $self->coerce->($_[1]); - (defined $self->type_constraint->($val)) + my $val = $self->type_constraint->coercion_code->($_[1]); + (defined $self->type_constraint->constraint_code->($val)) || confess "Attribute ($attr_name) does not pass the type contraint with '$val'" if defined $val; $_[0]->{$attr_name} = $val; @@ -80,7 +79,7 @@ sub generate_accessor_method { else { return sub { if (scalar(@_) == 2) { - (defined $self->type_constraint->($_[1])) + (defined $self->type_constraint->constraint_code->($_[1])) || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'" if defined $_[1]; $_[0]->{$attr_name} = $_[1]; @@ -114,7 +113,7 @@ sub generate_writer_method { if ($self->has_type_constraint) { if ($self->has_weak_ref) { return sub { - (defined $self->type_constraint->($_[1])) + (defined $self->type_constraint->constraint_code->($_[1])) || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'" if defined $_[1]; $_[0]->{$attr_name} = $_[1]; @@ -124,8 +123,8 @@ sub generate_writer_method { else { if ($self->has_coercion) { return sub { - my $val = $self->coerce->($_[1]); - (defined $self->type_constraint->($val)) + my $val = $self->type_constraint->coercion_code->($_[1]); + (defined $self->type_constraint->constraint_code->($val)) || confess "Attribute ($attr_name) does not pass the type contraint with '$val'" if defined $val; $_[0]->{$attr_name} = $val; @@ -133,7 +132,7 @@ sub generate_writer_method { } else { return sub { - (defined $self->type_constraint->($_[1])) + (defined $self->type_constraint->constraint_code->($_[1])) || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'" if defined $_[1]; $_[0]->{$attr_name} = $_[1]; diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index f2fe062..014dc7b 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -22,12 +22,12 @@ sub construct_instance { # attribute's default value (if it has one) $val ||= $attr->default($instance) if $attr->has_default; if (defined $val) { - if ($attr->has_coercion) { - $val = $attr->coerce->($val); - } if ($attr->has_type_constraint) { - (defined($attr->type_constraint->($val))) - || confess "Attribute () does not pass the type contraint with"; + if ($attr->has_coercion && $attr->type_constraint->has_coercion) { + $val = $attr->type_constraint->coercion_code->($val); + } + (defined($attr->type_constraint->constraint_code->($val))) + || confess "Attribute (" . $attr->name . ") does not pass the type contraint with"; } } $instance->{$attr->name} = $val; diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm index 785ba5c..651b1bf 100644 --- a/lib/Moose/Meta/TypeConstraint.pm +++ b/lib/Moose/Meta/TypeConstraint.pm @@ -25,9 +25,7 @@ Moose::Meta::TypeConstraint->meta->add_attribute( )) ); -sub new { (shift)->meta->new_object(@_) } -sub check { (shift)->constraint_code->(@_) } -sub coerce { (shift)->coercion_code->(@_) } +sub new { return (shift)->meta->new_object(@_) } 1; diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index eb5524d..e32da46 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -39,12 +39,6 @@ sub import { ); } - sub dump_type_constraints { - require Data::Dumper; - $Data::Dumper::Deparse = 1; - Data::Dumper::Dumper(\%TYPES); - } - sub export_type_contstraints_as_functions { my $pkg = caller(); no strict 'refs'; diff --git a/t/001_basic.t b/t/001_basic.t index 49430ff..7fc3718 100644 --- a/t/001_basic.t +++ b/t/001_basic.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 43; +use Test::More tests => 55; use Test::Exception; BEGIN { @@ -144,6 +144,14 @@ foreach my $method (@Point_methods) { ok(Point->meta->has_method($method), '... Point has the method "' . $method . '"'); } +foreach my $attr_name (@Point_attrs ) { + ok(Point->meta->has_attribute($attr_name), '... Point has the attribute "' . $attr_name . '"'); + my $attr = Point->meta->get_attribute($attr_name); + ok($attr->has_type_constraint, '... Attribute ' . $attr_name . ' has a type constraint'); + isa_ok($attr->type_constraint, 'Moose::Meta::TypeConstraint'); + is($attr->type_constraint->name, 'Int', '... Attribute ' . $attr_name . ' has an Int type constraint'); +} + # poke at Point3D is_deeply( @@ -167,3 +175,11 @@ is_deeply( foreach my $method (@Point3D_methods) { ok(Point3D->meta->has_method($method), '... Point3D has the method "' . $method . '"'); } + +foreach my $attr_name (@Point3D_attrs ) { + ok(Point3D->meta->has_attribute($attr_name), '... Point3D has the attribute "' . $attr_name . '"'); + my $attr = Point3D->meta->get_attribute($attr_name); + ok($attr->has_type_constraint, '... Attribute ' . $attr_name . ' has a type constraint'); + isa_ok($attr->type_constraint, 'Moose::Meta::TypeConstraint'); + is($attr->type_constraint->name, 'Int', '... Attribute ' . $attr_name . ' has an Int type constraint'); +}