t/constraints.t

   1 BEGIN {
   2         use strict;
   3         use warnings;
   4         use Test::More tests=>12;
   5         use Test::Exception;
   6 }
   7
   8 {
   9     package Test::MooseX::Meta::TypeConstraint::Structured;
  10
  11     use Moose;
  12     use Moose::Util::TypeConstraints;
  13     use MooseX::Meta::TypeConstraint::Structured;
  14
  15     subtype 'MyString',
  16      as 'Str',
  17      where { $_=~m/abc/};
  18
  19     sub Tuple {
  20         my @args = @{shift @_};
  21         return MooseX::Meta::TypeConstraint::Structured->new(
  22             name => 'Tuple',
  23             parent => find_type_constraint('ArrayRef'),
  24             package_defined_in => __PACKAGE__,
  25             signature => [map {find_type_constraint($_)} @args],
  26         );
  27     }
  28
  29     sub Dict {
  30         my %args = @{shift @_};
  31         return MooseX::Meta::TypeConstraint::Structured->new(
  32             name => 'Tuple',
  33             parent => find_type_constraint('HashRef'),
  34             package_defined_in => __PACKAGE__,
  35             signature => {map { $_ => find_type_constraint($args{$_})} keys %args},
  36         );
  37     }
  38
  39     has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str', 'MyString']);
  40     has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']);
  41 }
  42
  43 ## Instantiate a new test object
  44
  45 ok my $record = Test::MooseX::Meta::TypeConstraint::Structured->new
  46  => 'Instantiated new Record test class.';
  47
  48 isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured'
  49  => 'Created correct object type.';
  50
  51 ## Test Tuple type constraint
  52
  53 lives_ok sub {
  54     $record->tuple([1,'hello', 'test.abc.test']);
  55 } => 'Set tuple attribute without error';
  56
  57 is $record->tuple->[0], 1
  58  => 'correct set the tuple attribute index 0';
  59
  60 is $record->tuple->[1], 'hello'
  61  => 'correct set the tuple attribute index 1';
  62
  63 is $record->tuple->[2], 'test.abc.test'
  64  => 'correct set the tuple attribute index 2';
  65
  66 throws_ok sub {
  67     $record->tuple([1,'hello', 'test.xxx.test']);
  68 }, qr/Validation failed for 'MyString'/
  69  => 'Properly failed for bad value in custom type constraint';
  70
  71 throws_ok sub {
  72     $record->tuple(['asdasd',2, 'test.abc.test']);
  73 }, qr/Validation failed for 'Int'/
  74  => 'Got Expected Error for violating constraints';
  75
  76 ## Test the Dictionary type constraint
  77
  78 lives_ok sub {
  79     $record->dict({name=>'frith', age=>23});
  80 } => 'Set dict attribute without error';
  81
  82 is $record->dict->{name}, 'frith'
  83  => 'correct set the dict attribute name';
  84
  85 is $record->dict->{age}, 23
  86  => 'correct set the dict attribute age';
  87
  88 throws_ok sub {
  89     $record->dict({name=>[1,2,3], age=>'sdfsdfsd'});
  90 }, qr/Validation failed for 'Str'/
  91  => 'Got Expected Error for bad value in dict';