Also clean up a lot of whitespace.
+++ /dev/null
-
-# Avoid version control files.
-\bRCS\b
-\bCVS\b
-,v$
-\B\.svn\b
-\B\.git
-
-# Avoid Makemaker generated and utility files.
-\bMakefile$
-\bblib
-\bMakeMaker-\d
-\bpm_to_blib$
-\bblibdirs$
-^MANIFEST\.SKIP$
-
-# for developers only :)
-^TODO$
-^VERSIONING\.SKETCH$
-
-# Avoid Module::Build generated and utility files.
-\bBuild$
-\b_build
-
-# Avoid temp and backup files.
-~$
-\.tmp$
-\.old$
-\.bak$
-\#$
-\b\.#
-
-# avoid OS X finder files
-\.DS_Store$
-
-#skip komodo project files
-\.kpf$
-
-
-# Don't ship the last dist we built :)
-\.tar\.gz$
-
-# Skip maint stuff
-^maint/
+++ /dev/null
-use inc::Module::Install;
-
-## All the required meta information
-name 'MooseX-Types-Structured';
-all_from 'lib/MooseX/Types/Structured.pm';
-abstract 'Moose Type Constraint classes for Structured Types';
-author 'John Napiorkowski <jjnapiork@cpan.org>';
-license 'perl';
-
-## Module dependencies
-requires 'Moose' => '1.06';
-requires 'MooseX::Types' => '0.22';
-requires 'Devel::PartialDump' => '0.10';
-requires 'Sub::Exporter' => '0.982';
-
-## Testing dependencies
-build_requires 'Test::More' => '0.70';
-build_requires 'Test::Exception' => '0.27';
-
-## Author tests dependencies
-author_requires 'Test::Pod' => '1.14';
-author_requires 'Test::Pod::Coverage' => '1.08';
-
-## Build README
-system 'pod2text lib/MooseX/Types/Structured.pm > README'
- if -e 'MANIFEST.SKIP';
-
-## Instructions to Module::Install
-auto_install;
-tests_recursive;
-WriteAll;
-
-1;
--- /dev/null
+name = MooseX-Types-Structured
+version = 0.22
+author = John Napiorkowski <jjnapiork@cpan.org>
+author = Florian Ragwitz <rafl@debian.org>
+author = Yuval Kogman <nothingmuch@woobling.org>
+author = Tomas Doran <bobtfish@bobtfish.net>
+license = Perl_5
+copyright_holder = John Napiorkowski
+
+[@FLORA]
+dist = MooseX-Types-Structured
+authority = cpan:JJNAPIORK
+repository_at = gitmo
package ## Hide from PAUSE
MooseX::Meta::TypeCoercion::Structured;
+# ABSTRACT: MooseX::Meta::TypeCoercion::Structured - Coerce structured type constraints.
use Moose;
extends 'Moose::Meta::TypeCoercion';
-=head1 NAME
-
-MooseX::Meta::TypeCoercion::Structured - Coerce structured type constraints.
-
=head1 DESCRIPTION
We need to make sure we can properly coerce the structure elements inside a
structured type constraint. However requirements for the best way to allow
this are still in flux. For now this class is a placeholder.
-=head1 METHODS
-
-This class defines the following methods.
-
=head1 SEE ALSO
The following modules or resources may be of interest.
L<Moose>, L<Moose::Meta::TypeCoercion>
-=head1 AUTHOR
-
-John Napiorkowski, C<< <jjnapiork@cpan.org> >>
-
-=head1 COPYRIGHT & LICENSE
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
=cut
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
use Moose;
extends 'Moose::Meta::TypeCoercion';
+=method compile_type_coercion
+
+=cut
+
sub compile_type_coercion {
my ($self) = @_;
my $constraint = $self->type_constraint->type_parameter;
package ## Hide from PAUSE
MooseX::Meta::TypeConstraint::Structured;
+# ABSTRACT: MooseX::Meta::TypeConstraint::Structured - Structured type constraints.
use Moose;
use Devel::PartialDump;
use MooseX::Meta::TypeCoercion::Structured;
extends 'Moose::Meta::TypeConstraint';
-=head1 NAME
-
-MooseX::Meta::TypeConstraint::Structured - Structured type constraints.
=head1 DESCRIPTION
an Int and then a Str" and that this could be done so with a declaration like:
Tuple[Int,Int,Str]; ## Example syntax
-
+
So a structure is a list of Type constraints (the "Int,Int,Str" in the above
example) which are intended to function together.
-=head1 ATTRIBUTES
-
-This class defines the following attributes.
-
-=head2 type_constraints
+=attr type_constraints
A list of L<Moose::Meta::TypeConstraint> objects.
predicate=>'has_type_constraints',
);
-=head2 constraint_generator
+=attr constraint_generator
A subref or closure that contains the way we validate incoming values against
a set of type constraints.
builder => '_build_coercion',
);
-=head1 METHODS
-
-This class defines the following methods.
-
-=head2 new
-
-Initialization stuff.
-
-=cut
-
sub _build_coercion {
my ($self) = @_;
return MooseX::Meta::TypeCoercion::Structured->new(
);
}
-=head2 validate
+=method validate
Messing with validate so that we can support niced error messages.
+
=cut
override 'validate' => sub {
}
};
-=head2 generate_constraint_for ($type_constraints)
+=method generate_constraint_for ($type_constraints)
Given some type constraints, use them to generate validation rules for an ref
of values (to be passed at check time)
};
}
-=head2 parameterize (@type_constraints)
+=method parameterize (@type_constraints)
Given a ref of type constraints, create a structured type.
=cut
sub parameterize {
-
my ($self, @type_constraints) = @_;
my $class = ref $self;
my $name = $self->name .'['. join(',', map {"$_"} @type_constraints) .']';
);
}
-=head2 __infer_constraint_generator
+=method __infer_constraint_generator
This returns a CODEREF which generates a suitable constraint generator. Not
user servicable, you'll never call this directly.
## I'm not sure about this stuff but everything seems to work
my $tc = shift @_;
my $merged_tc = [@$tc, @{$self->parent->type_constraints}];
- $self->constraint->($merged_tc, @_);
+ $self->constraint->($merged_tc, @_);
};
- }
+ }
}
-=head2 compile_type_constraint
+=method compile_type_constraint
hook into compile_type_constraint so we can set the correct validation rules.
around 'compile_type_constraint' => sub {
my ($compile_type_constraint, $self, @args) = @_;
-
+
if($self->has_type_constraints) {
my $type_constraints = $self->type_constraints;
my $constraint = $self->generate_constraint_for($type_constraints);
- $self->_set_constraint($constraint);
+ $self->_set_constraint($constraint);
}
return $self->$compile_type_constraint(@args);
};
-=head2 create_child_type
+=method create_child_type
modifier to make sure we get the constraint_generator
);
};
-=head2 is_a_type_of
+=method is_a_type_of
-=head2 is_subtype_of
+=method is_subtype_of
-=head2 equals
+=method equals
Override the base class behavior.
my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
return unless $other->isa(__PACKAGE__);
-
+
return (
$self->parent->equals($other->parent)
and
}
}
-=head2 type_constraints_equals
+=method type_constraints_equals
Checks to see if the internal type constraints are equal.
while(@self_type_constraints) {
my $self_type_constraint = shift @self_type_constraints;
my $other_type_constraint = shift @other_type_constraints;
-
+
$_ = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_)
for $self_type_constraint, $other_type_constraint;
my $result = $self_type_constraint->$op($other_type_constraint);
return unless $result;
}
-
+
return 1; ##If we get this far, everything is good.
}
while(@self_type_constraints) {
my $self_type_constraint = shift @self_type_constraints;
my $other_type_constraint = shift @other_type_constraints;
-
+
$_ = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_)
for $self_type_constraint, $other_type_constraint;
-
+
return 1 if $self_type_constraint->$op($other_type_constraint);
}
return 0;
}
-=head2 get_message
+=method get_message
Give you a better peek into what's causing the error. For now we stringify the
incoming deep value with L<Devel::PartialDump> and pass that on to either your
L<Moose>, L<Moose::Meta::TypeConstraint>
-=head1 AUTHOR
-
-John Napiorkowski, C<< <jjnapiork@cpan.org> >>
-
-=head1 COPYRIGHT & LICENSE
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
=cut
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
package MooseX::Types::Structured;
+# ABSTRACT: MooseX::Types::Structured - Structured Type Constraints for Moose
use 5.008;
-use Moose::Util::TypeConstraints;
+use Moose::Util::TypeConstraints 1.06;
use MooseX::Meta::TypeConstraint::Structured;
use MooseX::Meta::TypeConstraint::Structured::Optional;
use MooseX::Types::Structured::OverflowHandler;
-use MooseX::Types -declare => [qw(Dict Map Tuple Optional)];
-use Sub::Exporter -setup => [ qw(Dict Map Tuple Optional slurpy) ];
-use Devel::PartialDump;
+use MooseX::Types 0.22 -declare => [qw(Dict Map Tuple Optional)];
+use Sub::Exporter 0.982 -setup => [ qw(Dict Map Tuple Optional slurpy) ];
+use Devel::PartialDump 0.10;
use Scalar::Util qw(blessed);
-our $VERSION = '0.22';
-our $AUTHORITY = 'cpan:JJNAPIORK';
-
-=head1 NAME
-
-MooseX::Types::Structured - Structured Type Constraints for Moose
-
=head1 SYNOPSIS
The following is example usage for this module.
],
);
- ## Remainder of your class attributes and methods
+ ## Remainder of your class attributes and methods
Then you can instantiate this class with something like:
use MooseX::Types -declare [qw(StringIntOptionalHashRef)];
use MooseX::Types::Moose qw(Str Int);
- use MooseX::Types::Structured qw(Tuple Optional);
+ use MooseX::Types::Structured qw(Tuple Optional);
subtype StringIntOptionalHashRef,
as Tuple[
allow both null and undefined, you should use the core Moose 'Maybe' type
constraint instead:
- package MyApp::Types;
+ package MyApp::Types;
use MooseX::Types -declare [qw(StringIntMaybeHashRef)];
use MooseX::Types::Moose qw(Str Int Maybe);
Which would match:
- [1, {name=>'John', age=>25},[10,11,12]];
+ [1, {name=>'John', age=>25},[10,11,12]];
Please notice how the type parameters can be visually arranged to your liking
and to improve the clarity of your meaning. You don't need to run then
altogether onto a single line. Additionally, since the 'Dict' type constraint
defines a hash constraint, the key order is not meaningful. For example:
- subtype AnyKeyOrder,
- as Dict[
- key1=>Int,
- key2=>Str,
- key3=>Int,
- ];
+ subtype AnyKeyOrder,
+ as Dict[
+ key1=>Int,
+ key2=>Str,
+ key3=>Int,
+ ];
Would validate both:
- {key1 => 1, key2 => "Hi!", key3 => 2};
- {key2 => "Hi!", key1 => 100, key3 => 300};
+ {key1 => 1, key2 => "Hi!", key3 => 2};
+ {key2 => "Hi!", key1 => 100, key3 => 300};
As you would expect, since underneath its just a plain old Perl hash at work.
you can include a type constraint as a contained type constraint of itself. For
example:
- subtype Person,
- as Dict[
- name=>Str,
- friends=>Optional[
- ArrayRef[Person]
- ],
- ];
+ subtype Person,
+ as Dict[
+ name=>Str,
+ friends=>Optional[
+ ArrayRef[Person]
+ ],
+ ];
This would declare a Person subtype that contains a name and an optional
ArrayRef of Persons who are friends as in:
- {
- name => 'Mike',
- friends => [
- { name => 'John' },
- { name => 'Vincent' },
- {
- name => 'Tracey',
- friends => [
- { name => 'Stephenie' },
- { name => 'Ilya' },
- ],
- },
- ],
- };
+ {
+ name => 'Mike',
+ friends => [
+ { name => 'John' },
+ { name => 'Vincent' },
+ {
+ name => 'Tracey',
+ friends => [
+ { name => 'Stephenie' },
+ { name => 'Ilya' },
+ ],
+ },
+ ],
+ };
Please take care to make sure the recursion node is either Optional, or declare
a Union with an non recursive option such as:
- subtype Value
- as Tuple[
- Str,
- Str|Tuple,
- ];
+ subtype Value
+ as Tuple[
+ Str,
+ Str|Tuple,
+ ];
Which validates:
- [
- 'Hello', [
- 'World', [
- 'Is', [
- 'Getting',
- 'Old',
- ],
- ],
- ],
- ];
+ [
+ 'Hello', [
+ 'World', [
+ 'Is', [
+ 'Getting',
+ 'Old',
+ ],
+ ],
+ ],
+ ];
Otherwise you will define a subtype thatis impossible to validate since it is
infinitely recursive. For more information about defining recursive types,
subtype Person,
as Dict[
- name=>Str,
- age=>Int,
+ name=>Str,
+ age=>Int,
];
coerce Person,
from Dict[
- first=>Str,
- last=>Str,
- years=>Int,
+ first=>Str,
+ last=>Str,
+ years=>Int,
], via { +{
name => "$_->{first} $_->{last}",
age => $_->{years},
}},
from Dict[
- fullname=>Dict[
- last=>Str,
- first=>Str,
- ],
- dob=>DateTime,
+ fullname=>Dict[
+ last=>Str,
+ first=>Str,
+ ],
+ dob=>DateTime,
],
## DateTime needs to be inside of single quotes here to disambiguate the
## class package from the DataTime type constraint imported via the
Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
- MooseX::Meta::TypeConstraint::Structured->new(
- name => "MooseX::Types::Structured::Tuple" ,
- parent => find_type_constraint('ArrayRef'),
- constraint_generator=> sub {
- ## Get the constraints and values to check
+ MooseX::Meta::TypeConstraint::Structured->new(
+ name => "MooseX::Types::Structured::Tuple" ,
+ parent => find_type_constraint('ArrayRef'),
+ constraint_generator=> sub {
+ ## Get the constraints and values to check
my ($type_constraints, $values) = @_;
- my @type_constraints = defined $type_constraints ?
+ my @type_constraints = defined $type_constraints ?
@$type_constraints : ();
my $overflow_handler;
$overflow_handler = pop @type_constraints;
}
- my @values = defined $values ? @$values: ();
- ## Perform the checking
- while(@type_constraints) {
- my $type_constraint = shift @type_constraints;
- if(@values) {
- my $value = shift @values;
- unless($type_constraint->check($value)) {
+ my @values = defined $values ? @$values: ();
+ ## Perform the checking
+ while(@type_constraints) {
+ my $type_constraint = shift @type_constraints;
+ if(@values) {
+ my $value = shift @values;
+ unless($type_constraint->check($value)) {
$_[2]->{message} = $type_constraint->get_message($value)
if ref $_[2];
- return;
- }
- } else {
+ return;
+ }
+ } else {
## Test if the TC supports null values
unless ($type_constraint->is_subtype_of($Optional)) {
$_[2]->{message} = $type_constraint->get_message('NULL')
if ref $_[2];
- return;
- }
- }
- }
- ## Make sure there are no leftovers.
- if(@values) {
+ return;
+ }
+ }
+ }
+ ## Make sure there are no leftovers.
+ if(@values) {
if($overflow_handler) {
return $overflow_handler->check([@values], $_[2]);
} else {
if ref $_[2];
return;
}
- } elsif(@type_constraints) {
+ } elsif(@type_constraints) {
$_[2]->{message} =
"Not enough values for all defined type constraints. Remaining: ". join(', ',@type_constraints)
if ref $_[2];
- return;
- } else {
- return 1;
- }
- }
- )
+ return;
+ } else {
+ return 1;
+ }
+ }
+ )
);
Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
- MooseX::Meta::TypeConstraint::Structured->new(
- name => "MooseX::Types::Structured::Dict",
- parent => find_type_constraint('HashRef'),
- constraint_generator=> sub {
- ## Get the constraints and values to check
+ MooseX::Meta::TypeConstraint::Structured->new(
+ name => "MooseX::Types::Structured::Dict",
+ parent => find_type_constraint('HashRef'),
+ constraint_generator=> sub {
+ ## Get the constraints and values to check
my ($type_constraints, $values) = @_;
- my @type_constraints = defined $type_constraints ?
+ my @type_constraints = defined $type_constraints ?
@$type_constraints : ();
my $overflow_handler;
$overflow_handler = pop @type_constraints;
}
my (%type_constraints) = @type_constraints;
- my %values = defined $values ? %$values: ();
- ## Perform the checking
- while(%type_constraints) {
- my($key, $type_constraint) = each %type_constraints;
- delete $type_constraints{$key};
- if(exists $values{$key}) {
- my $value = $values{$key};
- delete $values{$key};
- unless($type_constraint->check($value)) {
+ my %values = defined $values ? %$values: ();
+ ## Perform the checking
+ while(%type_constraints) {
+ my($key, $type_constraint) = each %type_constraints;
+ delete $type_constraints{$key};
+ if(exists $values{$key}) {
+ my $value = $values{$key};
+ delete $values{$key};
+ unless($type_constraint->check($value)) {
$_[2]->{message} = $type_constraint->get_message($value)
if ref $_[2];
- return;
- }
- } else {
+ return;
+ }
+ } else {
## Test to see if the TC supports null values
unless ($type_constraint->is_subtype_of($Optional)) {
$_[2]->{message} = $type_constraint->get_message('NULL')
if ref $_[2];
- return;
- }
- }
- }
- ## Make sure there are no leftovers.
- if(%values) {
+ return;
+ }
+ }
+ }
+ ## Make sure there are no leftovers.
+ if(%values) {
if($overflow_handler) {
return $overflow_handler->check(+{%values});
} else {
if ref $_[2];
return;
}
- } elsif(%type_constraints) {
+ } elsif(%type_constraints) {
$_[2]->{message} =
"Not enough values for all defined type constraints. Remaining: ". join(', ',values %values)
if ref $_[2];
- return;
- } else {
- return 1;
- }
- },
- )
+ return;
+ } else {
+ return 1;
+ }
+ },
+ )
);
Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
);
sub slurpy ($) {
- my ($tc) = @_;
- return MooseX::Types::Structured::OverflowHandler->new(
+ my ($tc) = @_;
+ return MooseX::Types::Structured::OverflowHandler->new(
type_constraint => $tc,
);
}
Here's a list of stuff I would be happy to get volunteers helping with:
- * All POD examples need test cases in t/documentation/*.t
- * Want to break out the examples section to a separate cookbook style POD.
- * Want more examples and best practice / usage guidance for authors
- * Need to clarify deep coercions,
-
-=head1 AUTHOR
-
-John Napiorkowski <jjnapiork@cpan.org>
-
-=head1 CONTRIBUTORS
-
-The following people have contributed to this module and agree with the listed
-Copyright & license information included below:
-
- Florian Ragwitz, <rafl@debian.org>
- Yuval Kogman, <nothingmuch@woobling.org>
- Tomas Doran, <bobtfish@bobtfish.net>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2008-2009, John Napiorkowski <jjnapiork@cpan.org>
-
-This program is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself.
+ * All POD examples need test cases in t/documentation/*.t
+ * Want to break out the examples section to a separate cookbook style POD.
+ * Want more examples and best practice / usage guidance for authors
+ * Need to clarify deep coercions,
=cut
use overload '""' => 'name', fallback => 1;
+=attr type_constraint
+
+=cut
+
has type_constraint => (
is => 'ro',
isa => 'Moose::Meta::TypeConstraint',
handles => [qw/check/],
);
+=method name
+
+=cut
+
sub name {
my ($self) = @_;
return 'slurpy ' . $self->type_constraint->name;
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod::Coverage
-my $min_tpc = 1.08;
-eval "use Test::Pod::Coverage $min_tpc";
-plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
- if $@;
-
-# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
-# but older versions don't recognize some common documentation styles
-my $min_pc = 0.18;
-eval "use Pod::Coverage $min_pc";
-plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
- if $@;
-
-all_pod_coverage_ok();
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod
-my $min_tp = 1.22;
-eval "use Test::Pod $min_tp";
-plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
-
-all_pod_files_ok();
BEGIN {
- use strict;
- use warnings;
- use Test::More tests=>32;
- use Test::Exception;
+ use strict;
+ use warnings;
+ use Test::More tests=>32;
+ use Test::Exception;
}
{
use Moose;
use MooseX::Types::Structured qw(Tuple);
- use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
- use MooseX::Types -declare => [qw(MyString MoreThanFive FiveByFive MyArrayRefMoreThanTwoInt)];
-
+ use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
+ use MooseX::Types -declare => [qw(MyString MoreThanFive FiveByFive MyArrayRefMoreThanTwoInt)];
+
subtype MyString,
as Str,
where { $_=~m/abc/};
-
+
subtype MoreThanFive,
as Int,
where { $_ > 5};
-
+
subtype MyArrayRefMoreThanTwoInt,
as ArrayRef[MoreThanFive],
where { scalar @$_ > 2 };
-
+
subtype FiveByFive,
as Tuple[MoreThanFive, MyArrayRefMoreThanTwoInt];
-
+
#use Data::Dump qw/dump/; warn dump Tuple;
has 'tuple' => (is=>'rw', isa=>Tuple[Int, Str, MyString]);
- has 'tuple_with_param' => (is=>'rw', isa=>Tuple[Int, Str, ArrayRef[Int]]);
- has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple[Int, Str, Maybe[Int], Object]);
- has 'tuple_with_maybe2' => (is=>'rw', isa=>Tuple[Int, Str, Maybe[Int]]);
- has 'tuple_with_union' => (is=>'rw', isa=>Tuple[Int,Str,Int|Object,Int]);
- has 'tuple2' => (is=>'rw', isa=>Tuple[Int,Str,Int]);
- has 'tuple_with_parameterized' => (is=>'rw', isa=>Tuple[Int,Str,Int,ArrayRef[Int]]);
+ has 'tuple_with_param' => (is=>'rw', isa=>Tuple[Int, Str, ArrayRef[Int]]);
+ has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple[Int, Str, Maybe[Int], Object]);
+ has 'tuple_with_maybe2' => (is=>'rw', isa=>Tuple[Int, Str, Maybe[Int]]);
+ has 'tuple_with_union' => (is=>'rw', isa=>Tuple[Int,Str,Int|Object,Int]);
+ has 'tuple2' => (is=>'rw', isa=>Tuple[Int,Str,Int]);
+ has 'tuple_with_parameterized' => (is=>'rw', isa=>Tuple[Int,Str,Int,ArrayRef[Int]]);
has 'FiveByFiveAttr' => (is=>'rw', isa=>FiveByFive);
}
ok my $record = Test::MooseX::Meta::TypeConstraint::Structured::Tuple->new
=> 'Instantiated new Record test class.';
-
+
isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured::Tuple'
=> 'Created correct object type.';
-
+
## Test Tuple type constraint
lives_ok sub {
=> 'correct set the tuple attribute index 2';
throws_ok sub {
- $record->tuple([1,'hello', 'test.xxx.test']);
+ $record->tuple([1,'hello', 'test.xxx.test']);
}, qr/Attribute \(tuple\) does not pass the type constraint/
=> 'Properly failed for bad value in custom type constraint';
-
+
throws_ok sub {
- $record->tuple(['asdasd',2, 'test.abc.test']);
+ $record->tuple(['asdasd',2, 'test.abc.test']);
}, qr/Attribute \(tuple\) does not pass the type constraint/
=> 'Got Expected Error for violating constraints';
=> "[1,'hello',3] properly suceeds";
throws_ok sub {
- $record->tuple2([1,2,'world']);
+ $record->tuple2([1,2,'world']);
}, qr/Attribute \(tuple2\) does not pass the type constraint/ => "[1,2,'world'] properly fails";
throws_ok sub {
- $record->tuple2(['hello1',2,3]);
+ $record->tuple2(['hello1',2,3]);
}, qr/Attribute \(tuple2\) does not pass the type constraint/ => "['hello',2,3] properly fails";
throws_ok sub {
- $record->tuple2(['hello2',2,'world']);
+ $record->tuple2(['hello2',2,'world']);
}, qr/Attribute \(tuple2\) does not pass the type constraint/ => "['hello',2,'world'] properly fails";
=> "[1,'hello',3,[1,2,3]] properly suceeds";
throws_ok sub {
- $record->tuple_with_parameterized([1,2,'world']);
+ $record->tuple_with_parameterized([1,2,'world']);
}, qr/Attribute \(tuple_with_parameterized\) does not pass the type constraint/
=> "[1,2,'world'] properly fails";
throws_ok sub {
- $record->tuple_with_parameterized(['hello1',2,3]);
+ $record->tuple_with_parameterized(['hello1',2,3]);
}, qr/Attribute \(tuple_with_parameterized\) does not pass the type constraint/
=> "['hello',2,3] properly fails";
throws_ok sub {
- $record->tuple_with_parameterized(['hello2',2,'world']);
+ $record->tuple_with_parameterized(['hello2',2,'world']);
}, qr/Attribute \(tuple_with_parameterized\) does not pass the type constraint/
=> "['hello',2,'world'] properly fails";
throws_ok sub {
- $record->tuple_with_parameterized([1,'hello',3,[1,2,'world']]);
+ $record->tuple_with_parameterized([1,'hello',3,[1,2,'world']]);
}, qr/Attribute \(tuple_with_parameterized\) does not pass the type constraint/
=> "[1,'hello',3,[1,2,'world']] properly fails";
} => 'Set FiveByFiveAttr correctly';
throws_ok sub {
- $record->FiveByFiveAttr([1,'hello', 'test']);
+ $record->FiveByFiveAttr([1,'hello', 'test']);
}, qr/Attribute \(FiveByFiveAttr\) does not pass the type constraint/
=> q{Properly failed for bad value in FiveByFiveAttr [1,'hello', 'test']};
throws_ok sub {
- $record->FiveByFiveAttr([1,[8,9,10]]);
+ $record->FiveByFiveAttr([1,[8,9,10]]);
}, qr/Attribute \(FiveByFiveAttr\) does not pass the type constraint/
=> q{Properly failed for bad value in FiveByFiveAttr [1,[8,9,10]]};
-
+
throws_ok sub {
- $record->FiveByFiveAttr([10,[11,12,0]]);
+ $record->FiveByFiveAttr([10,[11,12,0]]);
}, qr/Attribute \(FiveByFiveAttr\) does not pass the type constraint/
=> q{Properly failed for bad value in FiveByFiveAttr [10,[11,12,0]]};
-
+
throws_ok sub {
- $record->FiveByFiveAttr([1,[1,1,0]]);
+ $record->FiveByFiveAttr([1,[1,1,0]]);
}, qr/Attribute \(FiveByFiveAttr\) does not pass the type constraint/
=> q{Properly failed for bad value in FiveByFiveAttr [1,[1,1,0]]};
throws_ok sub {
- $record->FiveByFiveAttr([10,[11,12]]);
+ $record->FiveByFiveAttr([10,[11,12]]);
}, qr/Attribute \(FiveByFiveAttr\) does not pass the type constraint/
=> q{Properly failed for bad value in FiveByFiveAttr [10,[11,12]};
-
+
BEGIN {
- use strict;
- use warnings;
- use Test::More tests=>17;
- use Test::Exception;
+ use strict;
+ use warnings;
+ use Test::More tests=>17;
+ use Test::Exception;
}
{
use Moose;
use MooseX::Types::Structured qw(Dict Tuple);
- use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
- use MooseX::Types -declare => [qw(MyString)];
-
+ use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
+ use MooseX::Types -declare => [qw(MyString)];
+
subtype MyString,
as Str,
where { $_=~m/abc/};
-
+
has 'dict' => (is=>'rw', isa=>Dict[name=>Str, age=>Int]);
- has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>Str, age=>Maybe[Int]]);
+ has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>Str, age=>Maybe[Int]]);
has 'dict_with_tuple_with_union' => (is=>'rw', isa=>Dict[key1=>Str|Object, key2=>Tuple[Int,Str|Object]] );
}
ok my $record = Test::MooseX::Meta::TypeConstraint::Structured::Dict->new
=> 'Instantiated new Record test class.';
-
+
isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured::Dict'
=> 'Created correct object type.';
-
+
# Test dict Dict[name=>Str, age=>Int]
-
+
lives_ok sub {
$record->dict({name=>'frith', age=>23});
} => 'Set dict attribute without error';
is $record->dict->{age}, 23
=> 'correct set the dict attribute age';
-
+
throws_ok sub {
- $record->dict({name=>[1,2,3], age=>'sdfsdfsd'});
+ $record->dict({name=>[1,2,3], age=>'sdfsdfsd'});
}, qr/Attribute \(dict\) does not pass the type constraint/
=> 'Got Expected Error for bad value in dict';
-
+
## Test dict_with_maybe
lives_ok sub {
is $record->dict_with_maybe->{age}, 23
=> 'correct set the dict attribute age';
-
+
throws_ok sub {
- $record->dict_with_maybe({name=>[1,2,3], age=>'sdfsdfsd'});
+ $record->dict_with_maybe({name=>[1,2,3], age=>'sdfsdfsd'});
}, qr/Attribute \(dict_with_maybe\) does not pass the type constraint/
=> 'Got Expected Error for bad value in dict';
throws_ok sub {
- $record->dict_with_maybe({age=>30});
+ $record->dict_with_maybe({age=>30});
}, qr/Attribute \(dict_with_maybe\) does not pass the type constraint/
=> 'Got Expected Error for missing named parameter';
$record->dict_with_tuple_with_union({key1=>'Hello', key2=>['World',2]});
}, qr/Attribute \(dict_with_tuple_with_union\) does not pass the type constraint/
=> 'Threw error on bad constraint';
-
+
lives_ok sub {
$record->dict_with_tuple_with_union({key1=>$record, key2=>[1,'World']});
} => 'Set tuple attribute without error';
BEGIN {
- use strict;
- use warnings;
- use Test::More tests=>9;
- use Test::Exception;
+ use strict;
+ use warnings;
+ use Test::More tests=>9;
+ use Test::Exception;
}
{
use Moose;
use MooseX::Types::Structured qw(Dict Tuple);
- use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
-
- has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>Str, key2=>Tuple[Int,Str]]);
+ use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
+
+ has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>Str, key2=>Tuple[Int,Str]]);
has 'dict_with_tuple_with_union' => (is=>'rw', isa=>Dict[key1=>Str|Object, key2=>Tuple[Int,Str|Object]] );
}
ok my $record = Test::MooseX::Meta::TypeConstraint::Structured::Combined->new
=> 'Instantiated new Record test class.';
-
+
isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured::Combined'
=> 'Created correct object type.';
-
+
## Test dict_with_tuple
lives_ok sub {
$record->dict_with_tuple({key1=>'Hello', key2=>['World',2]});
}, qr/Attribute \(dict_with_tuple\) does not pass the type constraint/
=> 'Threw error on bad constraint';
-
+
## Test dict_with_tuple_with_union: Dict[key1=>'Str|Object', key2=>Tuple['Int','Str|Object']]
lives_ok sub {
$record->dict_with_tuple_with_union({key1=>'Hello', key2=>['World',2]});
}, qr/Attribute \(dict_with_tuple_with_union\) does not pass the type constraint/
=> 'Threw error on bad constraint';
-
+
lives_ok sub {
$record->dict_with_tuple_with_union({key1=>$record, key2=>[1,'World']});
} => 'Set tuple attribute without error';
BEGIN {
- use strict;
- use warnings;
- use Test::More tests=>16;
- use Test::Exception;
+ use strict;
+ use warnings;
+ use Test::More tests=>16;
+ use Test::Exception;
}
{
use Moose;
use MooseX::Types::Structured qw(Dict Tuple);
- use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
- use MooseX::Types -declare => [qw(
+ use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
+ use MooseX::Types -declare => [qw(
EqualLength MoreThanFive MoreLengthPlease PersonalInfo MorePersonalInfo
MinFiveChars
)];
-
+
subtype MoreThanFive,
as Int,
where { $_ > 5};
-
+
## Tuple contains two equal length Arrays
subtype EqualLength,
as Tuple[ArrayRef[MoreThanFive],ArrayRef[MoreThanFive]],
where { $#{$_->[0]} == $#{$_->[1]} };
-
+
## subclass the complex tuple
subtype MoreLengthPlease,
as EqualLength,
## Complexe Dict
subtype PersonalInfo,
as Dict[name=>Str, stats=>MoreLengthPlease|Object];
-
+
## Minimum 5 char string
subtype MinFiveChars,
as Str,
- where { length($_) > 5};
-
+ where { length($_) > 5};
+
## Dict key overloading
subtype MorePersonalInfo,
as PersonalInfo[name=>MinFiveChars, stats=>MoreLengthPlease|Object];
-
+
has 'EqualLengthAttr' => (is=>'rw', isa=>EqualLength);
has 'MoreLengthPleaseAttr' => (is=>'rw', isa=>MoreLengthPlease);
has 'PersonalInfoAttr' => (is=>'rw', isa=>PersonalInfo);
ok my $obj = Test::MooseX::Meta::TypeConstraint::Structured::Advanced->new
=> 'Instantiated new Record test class.';
-
+
isa_ok $obj => 'Test::MooseX::Meta::TypeConstraint::Structured::Advanced'
=> 'Created correct object type.';
-
+
## Test EqualLengthAttr
lives_ok sub {
} => 'Set EqualLengthAttr attribute without error';
throws_ok sub {
- $obj->EqualLengthAttr([1,'hello', 'test.xxx.test']);
+ $obj->EqualLengthAttr([1,'hello', 'test.xxx.test']);
}, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/
=> q{EqualLengthAttr correctly fails [1,'hello', 'test.xxx.test']};
-
+
throws_ok sub {
- $obj->EqualLengthAttr([[6,7],[9,10,11]]);
+ $obj->EqualLengthAttr([[6,7],[9,10,11]]);
}, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/
=> q{EqualLengthAttr correctly fails [[6,7],[9,10,11]]};
-
+
throws_ok sub {
- $obj->EqualLengthAttr([[6,7,1],[9,10,11]]);
+ $obj->EqualLengthAttr([[6,7,1],[9,10,11]]);
}, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/
=> q{EqualLengthAttr correctly fails [[6,7,1],[9,10,11]]};
-
+
## Test MoreLengthPleaseAttr
lives_ok sub {
} => 'Set MoreLengthPleaseAttr attribute without error';
throws_ok sub {
- $obj->MoreLengthPleaseAttr([[6,7,8,9],[11,12,13,14]]);
+ $obj->MoreLengthPleaseAttr([[6,7,8,9],[11,12,13,14]]);
}, qr/Attribute \(MoreLengthPleaseAttr\) does not pass the type constraint/
=> q{MoreLengthPleaseAttr correctly fails [[6,7,8,9],[11,12,13,14]]};
-
+
## Test PersonalInfoAttr
lives_ok sub {
} => 'Set PersonalInfoAttr attribute without error 2';
throws_ok sub {
- $obj->PersonalInfoAttr({name=>'John', stats=>[[6,7,8,9],[11,12,13,14]]});
+ $obj->PersonalInfoAttr({name=>'John', stats=>[[6,7,8,9],[11,12,13,14]]});
}, qr/Attribute \(PersonalInfoAttr\) does not pass the type constraint/
=> q{PersonalInfoAttr correctly fails name=>'John', stats=>[[6,7,8,9],[11,12,13,14]]};
throws_ok sub {
- $obj->PersonalInfoAttr({name=>'John', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
+ $obj->PersonalInfoAttr({name=>'John', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
}, qr/Attribute \(PersonalInfoAttr\) does not pass the type constraint/
=> q{PersonalInfoAttr correctly fails name=>'John', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]};
} => 'Set MorePersonalInfo attribute without error 1';
throws_ok sub {
- $obj->MorePersonalInfo({name=>'Johnnap', stats=>[[6,7,8,9],[11,12,13,14]]});
+ $obj->MorePersonalInfo({name=>'Johnnap', stats=>[[6,7,8,9],[11,12,13,14]]});
}, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/
=> q{MorePersonalInfo correctly fails name=>'Johnnap', stats=>[[6,7,8,9],[11,12,13,14]]};
throws_ok sub {
- $obj->MorePersonalInfo({name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
+ $obj->MorePersonalInfo({name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
}, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/
=> q{MorePersonalInfo correctly fails name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]};
throws_ok sub {
- $obj->MorePersonalInfo({name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
+ $obj->MorePersonalInfo({name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
}, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/
- => q{MorePersonalInfo correctly fails name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]};
+ => q{MorePersonalInfo correctly fails name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]};
BEGIN {
- use strict;
- use warnings;
- use Test::More tests=>88;
+ use strict;
+ use warnings;
+ use Test::More tests=>88;
}
{
PARAMETERIZE: {
ok (my $int = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Int'), 'Got Int');
- ok (my $str = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Str'), 'Got Str');
- ok (my $hashref = Moose::Util::TypeConstraints::find_or_parse_type_constraint('HashRef[Int]'), 'Got HashRef');
+ ok (my $str = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Str'), 'Got Str');
+ ok (my $hashref = Moose::Util::TypeConstraints::find_or_parse_type_constraint('HashRef[Int]'), 'Got HashRef');
## Test Dict->parameterize
ok (my $test_dict = Dict(), 'Created Test Dict');
ok (my $person = $test_dict->parameterize(name=>$str, age=>$int), 'Parameterized It');
ok ($person->check({name=>'John', age=>21}), 'Passed');
ok ($person->check({age=>25, name=>'User'}), 'Passed');
-
+
## Test Tuple->parameterize
ok (my $test_tuple = Tuple(), 'Created Test Tuple');
ok (my $int_and_hashref = $test_tuple->parameterize($int, $hashref), 'Parameterized It');
ok ($int_and_hashref->check([1, {key=>2, key2=>3}]), "Passed");
- ok (!$int_and_hashref->check(['a', {key=>2, key2=>3}]), "Not Passed");
+ ok (!$int_and_hashref->check(['a', {key=>2, key2=>3}]), "Not Passed");
ok (!$int_and_hashref->check([1, {key=>'a', key2=>3}]), "Not Passed");
}
BEGIN {
- use strict;
- use warnings;
- use Test::More tests=>16;
- use Test::Exception;
+ use strict;
+ use warnings;
+ use Test::More tests=>16;
+ use Test::Exception;
}
{
use Moose;
use MooseX::Types::Structured qw(Dict Tuple);
- use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef);
- use MooseX::Types -declare => [qw(
+ use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef);
+ use MooseX::Types -declare => [qw(
myDict myTuple Fullname
)];
-
+
subtype myDict,
as Dict[name=>Str, age=>Int];
-
+
subtype Fullname,
as Dict[first=>Str, last=>Str];
-
+
coerce Fullname,
from ArrayRef,
via { +{first=>$_->[0], last=>$_->[1]} };
-
+
subtype myTuple,
as Tuple[Str, Int];
## Create some coercions. Note the dob_epoch could be a more useful convert
## from a dob datetime object, I'm just lazy.
-
+
coerce myDict,
from Int,
via { +{name=>'JohnDoe', age=>$_} },
ok $person->stuff({aname=>{first=>"frank", last=>"herbert"},dob_in_years=>80}),
'{{first=>"frank", last=>"herbert"},80}';
-
+
is_deeply $person->stuff, {name=>"frank herbert",age=>80}, 'Correct set';
ok $person->stuff({bname=>{first=>"frankbbb", last=>"herbert"},dob_in_years=>84}),
'{{first=>"frankbbb", last=>"herbert"},84}';
-
+
is_deeply $person->stuff, {name=>"frankbbb herbert",age=>84}, 'Correct set';
ok $person->stuff(["mary",40]), 'Set Stuff ["mary",40]';
ok $person->stuff({fullname=>{first=>"frank", last=>"herbert1"},dob_epoch=>85}),
'{{first=>"frank", last=>"herbert1"},85}';
-
+
is_deeply $person->stuff, {name=>"frank herbert1",age=>85}, 'Correct set';
SKIP: {
skip 'deep coercions not yet supported', 2, 1;
-
+
ok $person->stuff({fullname=>["frank", "herbert2"],dob_epoch=>86}),
'{fullname=>["frank", "herbert2"],dob_epoch=>86}';
-
- is_deeply $person->stuff, {name=>"frank herbert2",age=>86}, 'Correct set';
+
+ is_deeply $person->stuff, {name=>"frank herbert2",age=>86}, 'Correct set';
}
BEGIN {
- use strict;
- use warnings;
- use Test::More;
-
+ use strict;
+ use warnings;
+ use Test::More;
+
eval "use MooseX::Types::DateTime";
plan $@
? ( skip_all => "Tests require MooseX::Types::DateTime" )
}
{
- ## Normalize a HashRef
+ ## Normalize a HashRef
package Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize;
use Moose;
- use DateTime;
+ use DateTime;
use MooseX::Types::Structured qw(Dict Tuple);
- use MooseX::Types::DateTime qw(DateTime);
- use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef);
- use MooseX::Types -declare => [qw(
+ use MooseX::Types::DateTime qw(DateTime);
+ use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef);
+ use MooseX::Types -declare => [qw(
Name Age Person FullName
)];
-
- ## So that our test works, we'll set Now to 2008.
- sub Now {
- return 'DateTime'->new(year=>2008);
- }
-
- subtype FullName,
- as Dict[last=>Str, first=>Str];
-
+
+ ## So that our test works, we'll set Now to 2008.
+ sub Now {
+ return 'DateTime'->new(year=>2008);
+ }
+
+ subtype FullName,
+ as Dict[last=>Str, first=>Str];
+
subtype Person,
- as Dict[name=>Str, age=>Int];
-
- coerce Person,
- from Dict[first=>Str, last=>Str, years=>Int],
- via { +{
- name => "$_->{first} $_->{last}",
- age=>$_->{years},
- }},
- from Dict[fullname=>FullName, dob=>DateTime],
- via { +{
- name => "$_->{fullname}{first} $_->{fullname}{last}",
- age => ($_->{dob} - Now)->years,
- }};
-
- has person => (is=>'rw', isa=>Person, coerce=>1);
+ as Dict[name=>Str, age=>Int];
+
+ coerce Person,
+ from Dict[first=>Str, last=>Str, years=>Int],
+ via { +{
+ name => "$_->{first} $_->{last}",
+ age=>$_->{years},
+ }},
+ from Dict[fullname=>FullName, dob=>DateTime],
+ via { +{
+ name => "$_->{fullname}{first} $_->{fullname}{last}",
+ age => ($_->{dob} - Now)->years,
+ }};
+
+ has person => (is=>'rw', isa=>Person, coerce=>1);
}
NORMALIZE: {
- ok my $normalize = Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize->new();
- isa_ok $normalize, 'Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize';
-
- ok $normalize->person({name=>'John', age=>25})
- => 'Set value';
-
- is_deeply $normalize->person, {name=>'John', age=>25}
- => 'Value is correct';
-
- ok $normalize->person({first=>'John', last=>'Napiorkowski', years=>35})
- => 'Set value';
-
- is_deeply $normalize->person, {name=>'John Napiorkowski', age=>35}
- => 'Value is correct';
-
- ok $normalize->person({years=>36, last=>'Napiorkowski', first=>'John'})
- => 'Set value';
-
- is_deeply $normalize->person, {name=>'John Napiorkowski', age=>36}
- => 'Value is correct';
-
- ok $normalize->person({fullname=>{first=>'Vanessa', last=>'Li'}, dob=>DateTime->new(year=>1974)})
- => 'Set value';
-
- is_deeply $normalize->person, {name=>'Vanessa Li', age=>34}
- => 'Value is correct';
+ ok my $normalize = Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize->new();
+ isa_ok $normalize, 'Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize';
+
+ ok $normalize->person({name=>'John', age=>25})
+ => 'Set value';
+
+ is_deeply $normalize->person, {name=>'John', age=>25}
+ => 'Value is correct';
+
+ ok $normalize->person({first=>'John', last=>'Napiorkowski', years=>35})
+ => 'Set value';
+
+ is_deeply $normalize->person, {name=>'John Napiorkowski', age=>35}
+ => 'Value is correct';
+
+ ok $normalize->person({years=>36, last=>'Napiorkowski', first=>'John'})
+ => 'Set value';
+
+ is_deeply $normalize->person, {name=>'John Napiorkowski', age=>36}
+ => 'Value is correct';
+
+ ok $normalize->person({fullname=>{first=>'Vanessa', last=>'Li'}, dob=>DateTime->new(year=>1974)})
+ => 'Set value';
+
+ is_deeply $normalize->person, {name=>'Vanessa Li', age=>34}
+ => 'Value is correct';
}
APITEST: {
- ok my $Optional = Moose::Util::TypeConstraints::find_or_parse_type_constraint('MooseX::Types::Structured::Optional')
- => 'Got Optional';
-
- isa_ok $Optional
- => 'Moose::Meta::TypeConstraint::Parameterizable';
-
- ok my $int = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Int')
- => 'Got Int';
-
- ok my $arrayref = Moose::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[Int]')
- => 'Got ArrayRef[Int]';
-
- BASIC: {
- ok my $Optional_Int = $Optional->parameterize($int), 'Parameterized Int';
- ok my $Optional_ArrayRef = $Optional->parameterize($arrayref), 'Parameterized ArrayRef';
-
- ok $Optional_Int->check() => 'Optional is allowed to not exist';
-
- ok !$Optional_Int->check(undef) => 'Optional is NOT allowed to be undef';
- ok $Optional_Int->check(199) => 'Correctly validates 199';
- ok !$Optional_Int->check("a") => 'Correctly fails "a"';
-
- ok $Optional_ArrayRef->check() => 'Optional is allowed to not exist';
- ok !$Optional_ArrayRef->check(undef) => 'Optional is NOT allowed to be undef';
- ok $Optional_ArrayRef->check([1,2,3]) => 'Correctly validates [1,2,3]';
- ok !$Optional_ArrayRef->check("a") => 'Correctly fails "a"';
- ok !$Optional_ArrayRef->check(["a","b"]) => 'Correctly fails ["a","b"]';
- }
-
- SUBREF: {
- ok my $Optional_Int = Optional->parameterize($int),'Parameterized Int';
- ok my $Optional_ArrayRef = Optional->parameterize($arrayref), 'Parameterized ArrayRef';
-
- ok $Optional_Int->check() => 'Optional is allowed to not exist';
-
- ok !$Optional_Int->check(undef) => 'Optional is NOT allowed to be undef';
- ok $Optional_Int->check(199) => 'Correctly validates 199';
- ok !$Optional_Int->check("a") => 'Correctly fails "a"';
-
- ok $Optional_ArrayRef->check() => 'Optional is allowed to not exist';
- ok !$Optional_ArrayRef->check(undef) => 'Optional is NOT allowed to be undef';
- ok $Optional_ArrayRef->check([1,2,3]) => 'Correctly validates [1,2,3]';
- ok !$Optional_ArrayRef->check("a") => 'Correctly fails "a"';
- ok !$Optional_ArrayRef->check(["a","b"]) => 'Correctly fails ["a","b"]';
- }
+ ok my $Optional = Moose::Util::TypeConstraints::find_or_parse_type_constraint('MooseX::Types::Structured::Optional')
+ => 'Got Optional';
+
+ isa_ok $Optional
+ => 'Moose::Meta::TypeConstraint::Parameterizable';
+
+ ok my $int = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Int')
+ => 'Got Int';
+
+ ok my $arrayref = Moose::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[Int]')
+ => 'Got ArrayRef[Int]';
+
+ BASIC: {
+ ok my $Optional_Int = $Optional->parameterize($int), 'Parameterized Int';
+ ok my $Optional_ArrayRef = $Optional->parameterize($arrayref), 'Parameterized ArrayRef';
+
+ ok $Optional_Int->check() => 'Optional is allowed to not exist';
+
+ ok !$Optional_Int->check(undef) => 'Optional is NOT allowed to be undef';
+ ok $Optional_Int->check(199) => 'Correctly validates 199';
+ ok !$Optional_Int->check("a") => 'Correctly fails "a"';
+
+ ok $Optional_ArrayRef->check() => 'Optional is allowed to not exist';
+ ok !$Optional_ArrayRef->check(undef) => 'Optional is NOT allowed to be undef';
+ ok $Optional_ArrayRef->check([1,2,3]) => 'Correctly validates [1,2,3]';
+ ok !$Optional_ArrayRef->check("a") => 'Correctly fails "a"';
+ ok !$Optional_ArrayRef->check(["a","b"]) => 'Correctly fails ["a","b"]';
+ }
+
+ SUBREF: {
+ ok my $Optional_Int = Optional->parameterize($int),'Parameterized Int';
+ ok my $Optional_ArrayRef = Optional->parameterize($arrayref), 'Parameterized ArrayRef';
+
+ ok $Optional_Int->check() => 'Optional is allowed to not exist';
+
+ ok !$Optional_Int->check(undef) => 'Optional is NOT allowed to be undef';
+ ok $Optional_Int->check(199) => 'Correctly validates 199';
+ ok !$Optional_Int->check("a") => 'Correctly fails "a"';
+
+ ok $Optional_ArrayRef->check() => 'Optional is allowed to not exist';
+ ok !$Optional_ArrayRef->check(undef) => 'Optional is NOT allowed to be undef';
+ ok $Optional_ArrayRef->check([1,2,3]) => 'Correctly validates [1,2,3]';
+ ok !$Optional_ArrayRef->check("a") => 'Correctly fails "a"';
+ ok !$Optional_ArrayRef->check(["a","b"]) => 'Correctly fails ["a","b"]';
+ }
}
OBJECTTEST: {
use Moose;
use MooseX::Types::Structured qw(Dict Tuple Optional);
- use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
- use MooseX::Types -declare => [qw(
+ use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
+ use MooseX::Types -declare => [qw(
MoreThanFive TupleOptional1 TupleOptional2 Gender DictOptional1 Insane
)];
-
+
subtype MoreThanFive,
as Int,
where { $_ > 5};
-
- enum Gender,
- qw/male female transgendered/;
-
+
+ enum Gender,
+ qw/male female transgendered/;
+
subtype TupleOptional1() =>
- as Tuple[Int, MoreThanFive, Optional[Str|Object]];
+ as Tuple[Int, MoreThanFive, Optional[Str|Object]];
subtype TupleOptional2,
- as Tuple[Int, MoreThanFive, Optional[HashRef[Int|Object]]];
-
- subtype DictOptional1,
- as Dict[name=>Str, age=>Int, gender=>Optional[Gender]];
-
- subtype Insane,
- as Tuple[
- Int,
- Optional[Str|Object],
- DictOptional1,
- Optional[ArrayRef[Int]]
- ];
-
+ as Tuple[Int, MoreThanFive, Optional[HashRef[Int|Object]]];
+
+ subtype DictOptional1,
+ as Dict[name=>Str, age=>Int, gender=>Optional[Gender]];
+
+ subtype Insane,
+ as Tuple[
+ Int,
+ Optional[Str|Object],
+ DictOptional1,
+ Optional[ArrayRef[Int]]
+ ];
+
has 'TupleOptional1Attr' => (is=>'rw', isa=>TupleOptional1);
has 'TupleOptional2Attr' => (is=>'rw', isa=>TupleOptional2);
- has 'DictOptional1Attr' => (is=>'rw', isa=>DictOptional1);
- has 'InsaneAttr' => (is=>'rw', isa=>Insane);
+ has 'DictOptional1Attr' => (is=>'rw', isa=>DictOptional1);
+ has 'InsaneAttr' => (is=>'rw', isa=>Insane);
}
ok my $obj = Test::MooseX::Meta::TypeConstraint::Structured::Optional->new
=> 'Instantiated new test class.';
-
+
isa_ok $obj => 'Test::MooseX::Meta::TypeConstraint::Structured::Optional'
=> 'Created correct object type.';
-
+
# Test Insane
lives_ok sub {
} => 'Set InsaneAttr attribute without error [1,$obj,{name=>"John",age=>39}]';
throws_ok sub {
- $obj->InsaneAttr([1,$obj,{name=>"John",age=>39},[qw/a b c/]]);
+ $obj->InsaneAttr([1,$obj,{name=>"John",age=>39},[qw/a b c/]]);
}, qr/Attribute \(InsaneAttr\) does not pass the type constraint/
=> q{InsaneAttr correctly fails [1,$obj,{name=>"John",age=>39},[qw/a b c/]]};
throws_ok sub {
- $obj->InsaneAttr([1,"hello",{name=>"John",age=>39,gender=>undef},[1,2,3]]);
+ $obj->InsaneAttr([1,"hello",{name=>"John",age=>39,gender=>undef},[1,2,3]]);
}, qr/Attribute \(InsaneAttr\) does not pass the type constraint/
=> q{InsaneAttr correctly fails [1,"hello",{name=>"John",age=>39,gender=>undef},[1,2,3]]};
-
+
# Test TupleOptional1Attr
lives_ok sub {
} => 'Set TupleOptional1Attr attribute without error [1,10]';
throws_ok sub {
- $obj->TupleOptional1Attr([1,10,[1,2,3]]);
+ $obj->TupleOptional1Attr([1,10,[1,2,3]]);
}, qr/Attribute \(TupleOptional1Attr\) does not pass the type constraint/
=> q{TupleOptional1Attr correctly fails [1,10,[1,2,3]]};
throws_ok sub {
- $obj->TupleOptional1Attr([1,10,undef]);
+ $obj->TupleOptional1Attr([1,10,undef]);
}, qr/Attribute \(TupleOptional1Attr\) does not pass the type constraint/
=> q{TupleOptional1Attr correctly fails [1,10,undef]};
-
+
# Test TupleOptional2Attr
lives_ok sub {
lives_ok sub {
$obj->TupleOptional2Attr([1,10]);
-} => 'Set TupleOptional2Attr attribute without error [1,10]';
+} => 'Set TupleOptional2Attr attribute without error [1,10]';
throws_ok sub {
- $obj->TupleOptional2Attr([1,10,[1,2,3]]);
+ $obj->TupleOptional2Attr([1,10,[1,2,3]]);
}, qr/Attribute \(TupleOptional2Attr\) does not pass the type constraint/
=> q{TupleOptional2Attr correctly fails [1,10,[1,2,3]]};
throws_ok sub {
- $obj->TupleOptional2Attr([1,10,undef]);
+ $obj->TupleOptional2Attr([1,10,undef]);
}, qr/Attribute \(TupleOptional2Attr\) does not pass the type constraint/
=> q{TupleOptional2Attr correctly fails [1,10,undef]};
-
+
# Test DictOptional1Attr: Dict[name=>Str, age=>Int, gender=>Optional[Gender]];
-
+
lives_ok sub {
$obj->DictOptional1Attr({name=>"John",age=>39,gender=>"male"});
} => 'Set DictOptional1Attr attribute without error {name=>"John",age=>39,gender=>"male"}';
} => 'Set DictOptional1Attr attribute without error {name=>"Vanessa",age=>34}';
throws_ok sub {
- $obj->DictOptional1Attr({name=>"John",age=>39,gender=>undef});
+ $obj->DictOptional1Attr({name=>"John",age=>39,gender=>undef});
}, qr/Attribute \(DictOptional1Attr\) does not pass the type constraint/
=> q{TupleOptional2Attr correctly fails {name=>"John",age=>39,gender=>undef}};
throws_ok sub {
- $obj->DictOptional1Attr({name=>"John",age=>39,gender=>"aaa"});
+ $obj->DictOptional1Attr({name=>"John",age=>39,gender=>"aaa"});
}, qr/Attribute \(DictOptional1Attr\) does not pass the type constraint/
=> q{TupleOptional2Attr correctly fails {name=>"John",age=>39,gender=>"aaa"}};
BEGIN {
- use strict;
- use warnings;
- use Test::More tests=>25;
+ use strict;
+ use warnings;
+ use Test::More tests=>25;
}
use Moose::Util::TypeConstraints;
BEGIN {
- use strict;
- use warnings;
- use Test::More tests=>11;
+ use strict;
+ use warnings;
+ use Test::More tests=>11;
}
{
projects / gitmo/MooseX-Types-Structured.git / commitdiff