my ($class, $type, $name) = @_;
return sub {
my $type_constraint;
- if(my $params = shift @_) {
- $type_constraint = $class->create_arged_type_constraint($name, @$params);
+ if(defined(my $params = shift @_)) {
+ if(ref $params eq 'ARRAY') {
+ $type_constraint = $class->create_arged_type_constraint($name, @$params);
+ } else {
+ croak 'Arguments must be an ArrayRef, not '. ref $params;
+ }
} else {
- $type_constraint = $class->create_base_type_constraint($name)
- || MooseX::Types::UndefinedType->new($name);
+ $type_constraint = $class->create_base_type_constraint($name);
+ }
+ $type_constraint = defined($type_constraint) ? $type_constraint
+ : MooseX::Types::UndefinedType->new($name);
+
+ if(my(@extra_args) = @_) {
+ return $class->create_type_decorator($type_constraint), @_;
+ } else {
+ return $class->create_type_decorator($type_constraint);
}
- return $class->create_type_decorator($type_constraint);
};
}
},
'|' => sub {
my @names = grep {$_} map {"$_"} @_;
- ## Don't know why I can't use the array version of this...
+ ## Don't know why I can't use the array version of this... If someone
+ ## knows would like to hear from you.
my $names = join('|', @names);
Moose::Util::TypeConstraints::create_type_constraint_union($names);
},
=head type_constraint ($type_constraint)
-Set/Get the type_constraint
+Set/Get the type_constraint.
=cut
sub type_constraint {
my $self = shift @_;
- if(my $tc = shift @_) {
+ if(defined(my $tc = shift @_)) {
$self->{type_constraint} = $tc;
}
return $self->{type_constraint};
=cut
-sub AUTOLOAD
-{
+sub AUTOLOAD {
my ($method) = (our $AUTOLOAD =~ /([^:]+)$/);
return shift->type_constraint->$method(@_);
}
use warnings;
use strict;
-use Test::More tests => 29;
+use Test::More tests => 33;
use Test::Exception;
use FindBin;
use lib "$FindBin::Bin/lib";
);
use DecoratorLibrary qw(
MyArrayRefBase MyArrayRefInt01 MyArrayRefInt02 StrOrArrayRef
+ AtLeastOneInt
);
has 'arrayrefbase' => (is=>'rw', isa=>MyArrayRefBase, coerce=>1);
has 'arrayrefint02' => (is=>'rw', isa=>MyArrayRefInt02, coerce=>1);
has 'arrayrefint03' => (is=>'rw', isa=>MyArrayRefBase[Int]);
has 'StrOrArrayRef' => (is=>'rw', isa=>StrOrArrayRef);
+ has 'AtLeastOneInt' => (is=>'rw', isa=>AtLeastOneInt);
}
## Make sure we have a 'create object sanity check'
throws_ok sub {
$type->StrOrArrayRef({a=>111});
-}, qr/Attribute \(StrOrArrayRef\) does not pass the type constraint/ => 'Correctly failed to use a hashref';
\ No newline at end of file
+}, qr/Attribute \(StrOrArrayRef\) does not pass the type constraint/ => 'Correctly failed to use a hashref';
+
+# Test AtLeastOneInt
+
+ok $type->AtLeastOneInt([1,2]),
+ => 'Good assignment';
+
+is_deeply $type->AtLeastOneInt, [1,2]
+ => "Got expected values.";
+
+throws_ok sub {
+ $type->AtLeastOneInt([]);
+}, qr/Attribute \(AtLeastOneInt\) does not pass the type constraint/ => 'properly fails';
+
+throws_ok sub {
+ $type->AtLeastOneInt(['a','b']);
+}, qr/Attribute \(AtLeastOneInt\) does not pass the type constraint/ => 'properly fails arrayref of strings';
+
MyHashRefOfInts
MyHashRefOfStr
StrOrArrayRef
+ AtLeastOneInt
)];
subtype MyArrayRefBase,
via {[sort values(%$_)]},
from MyHashRefOfStr,
via {[ sort map { length $_ } values(%$_) ]},
- ### Can't do HashRef[ArrayRef] here, need to force precidence I guess???
+ ## Can't do HashRef[ArrayRef] here since if I do HashRef get the via {}
+ ## Stuff passed as args.
from HashRef([ArrayRef]),
- via {[ sort map { @$_ } values(%$_)] };
+ via {[ sort map { @$_ } values(%$_) ]};
subtype StrOrArrayRef,
- from Str|ArrayRef;
+ as Str|ArrayRef;
+
+subtype AtLeastOneInt,
+ ## Same problem as MyArrayRefInt02, see above. Another way to solve it by
+ ## forcing some sort of context. Tried to fix this with method prototypes
+ ## but just couldn't make it work.
+ as (ArrayRef[Int]),
+ where { @$_ > 0 };
1;