t/positional.t

   1 BEGIN {
   2         use strict;
   3         use warnings;
   4         use Test::More tests=>8;
   5         use Test::Exception;
   6 }
   7
   8 {
   9     package Test::MooseX::Meta::TypeConstraint::Structured::Positional;
  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     has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str', 'MyString']);
  30 }
  31
  32 ## Instantiate a new test object
  33
  34 ok my $record = Test::MooseX::Meta::TypeConstraint::Structured::Positional->new
  35  => 'Instantiated new Record test class.';
  36
  37 isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured::Positional'
  38  => 'Created correct object type.';
  39
  40 lives_ok sub {
  41     $record->tuple([1,'hello', 'test.abc.test']);
  42 } => 'Set tuple attribute without error';
  43
  44 is $record->tuple->[0], 1
  45  => 'correct set the tuple attribute index 0';
  46
  47 is $record->tuple->[1], 'hello'
  48  => 'correct set the tuple attribute index 1';
  49
  50 is $record->tuple->[2], 'test.abc.test'
  51  => 'correct set the tuple attribute index 2';
  52
  53 throws_ok sub {
  54     $record->tuple([1,'hello', 'test.xxx.test']);
  55 }, qr/Validation failed for 'MyString'/
  56  => 'Properly failed for bad value in custom type constraint';
  57
  58 throws_ok sub {
  59     $record->tuple(['asdasd',2, 'test.abc.test']);
  60 }, qr/Validation failed for 'Int'/
  61  => 'Got Expected Error for violating constraints';
  62