BEGIN {
use strict;
use warnings;
- use Test::More tests=>25;
+ use Test::More tests=>35;
use Test::Exception;
}
use Moose;
use Moose::Util::TypeConstraints;
- use MooseX::Meta::TypeConstraint::Structured;
+ use MooseX::Meta::TypeConstraint::Structured::Named;
+ use MooseX::Meta::TypeConstraint::Structured::Positional;
subtype 'MyString',
as 'Str',
where { $_=~m/abc/};
sub Tuple {
- my @args = @{shift @_};
- return MooseX::Meta::TypeConstraint::Structured->new(
+ my ($args, $optional) = @_;
+ my @args = @$args;
+ my @optional = ref $optional eq 'ARRAY' ? @$optional : ();
+
+ return MooseX::Meta::TypeConstraint::Structured::Positional->new(
name => 'Tuple',
parent => find_type_constraint('ArrayRef'),
package_defined_in => __PACKAGE__,
signature => [map {
_normalize_type_constraint($_);
} @args],
+ optional_signature => [map {
+ _normalize_type_constraint($_);
+ } @optional],
);
}
sub Dict {
- my %args = @{shift @_};
- return MooseX::Meta::TypeConstraint::Structured->new(
+ my ($args, $optional) = @_;
+ my %args = @$args;
+ my %optional = ref $optional eq 'ARRAY' ? @$optional : ();
+
+ return MooseX::Meta::TypeConstraint::Structured::Named->new(
name => 'Dict',
parent => find_type_constraint('HashRef'),
package_defined_in => __PACKAGE__,
signature => {map {
$_ => _normalize_type_constraint($args{$_});
} keys %args},
+ optional_signature => {map {
+ $_ => _normalize_type_constraint($optional{$_});
+ } keys %optional},
);
}
has 'tuple_with_param' => (is=>'rw', isa=>Tuple['Int', 'Str', 'ArrayRef[Int]']);
has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple['Int', 'Str', 'Maybe[Int]']);
has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>'Str', key2=>Tuple['Int','Str']]);
+ has 'optional_tuple' => (is=>'rw', isa=>Tuple(['Int', 'Int'],['Int']) );
+ has 'optional_dict' => (is=>'rw', isa=>Dict([key1=>'Int'],[key2=>'Int']) );
}
## Instantiate a new test object
isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured'
=> 'Created correct object type.';
-
+
## Test Tuple type constraint
lives_ok sub {
}, qr/Validation failed for 'Int'/
=> 'Threw error on bad constraint';
+## Test optional_tuple
+
+lives_ok sub {
+ $record->optional_tuple([1,2,3]);
+} => 'Set tuple attribute with optional bits';
+
+is_deeply $record->optional_tuple, [1,2,3]
+ => 'correct values set';
+
+lives_ok sub {
+ $record->optional_tuple([4,5]);
+} => 'Set tuple attribute withOUT optional bits';
+is_deeply $record->optional_tuple, [4,5]
+ => 'correct values set again';
+
+throws_ok sub {
+ $record->optional_tuple([1,2,'bad']);
+}, qr/Validation failed for 'Int'/
+ => 'Properly failed for bad value in optional bit';
+# Test optional_dict
+
+lives_ok sub {
+ $record->optional_dict({key1=>1,key2=>2});
+} => 'Set tuple attribute with optional bits';
+
+is_deeply $record->optional_dict, {key1=>1,key2=>2}
+ => 'correct values set';
+
+lives_ok sub {
+ $record->optional_dict({key1=>3});
+} => 'Set tuple attribute withOUT optional bits';
+
+is_deeply $record->optional_dict, {key1=>3}
+ => 'correct values set again';
+
+throws_ok sub {
+ $record->optional_dict({key1=>1,key2=>'bad'});
+}, qr/Validation failed for 'Int'/
+ => 'Properly failed for bad value in optional bit';
+
+
+
\ No newline at end of file