t/type_constraints/maybe_type_constraint.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   8
   9 use Moose::Util::TypeConstraints;
  10
  11 my $type = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]');
  12 isa_ok($type, 'Moose::Meta::TypeConstraint');
  13 isa_ok($type, 'Moose::Meta::TypeConstraint::Parameterized');
  14
  15 ok( $type->equals($type), "equals self" );
  16 ok( !$type->equals($type->parent), "not equal to parent" );
  17 ok( !$type->equals(find_type_constraint("Maybe")), "not equal to Maybe" );
  18 ok( $type->parent->equals(find_type_constraint("Maybe")), "parent is Maybe" );
  19 ok( $type->equals( Moose::Meta::TypeConstraint::Parameterized->new( name => "__ANON__", parent => find_type_constraint("Maybe"), type_parameter => find_type_constraint("Int") ) ), "equal to clone" );
  20 ok( !$type->equals( Moose::Meta::TypeConstraint::Parameterized->new( name => "__ANON__", parent => find_type_constraint("Maybe"), type_parameter => find_type_constraint("Str") ) ), "not equal to clone with diff param" );
  21 ok( !$type->equals( Moose::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Str]') ), "not equal to declarative version of diff param" );
  22
  23 ok($type->check(10), '... checked type correctly (pass)');
  24 ok($type->check(undef), '... checked type correctly (pass)');
  25 ok(!$type->check('Hello World'), '... checked type correctly (fail)');
  26 ok(!$type->check([]), '... checked type correctly (fail)');
  27
  28 {
  29     package Bar;
  30     use Moose;
  31
  32     package Foo;
  33     use Moose;
  34     use Moose::Util::TypeConstraints;
  35
  36     has 'arr' => (is => 'rw', isa => 'Maybe[ArrayRef]', required => 1);
  37     has 'bar' => (is => 'rw', isa => class_type('Bar'));
  38     has 'maybe_bar' => (is => 'rw', isa => maybe_type(class_type('Bar')));
  39 }
  40
  41 is( exception {
  42     Foo->new(arr => [], bar => Bar->new);
  43 }, undef, '... Bar->new isa Bar' );
  44
  45 isnt( exception {
  46     Foo->new(arr => [], bar => undef);
  47 }, undef, '... undef isnta Bar' );
  48
  49 is( exception {
  50     Foo->new(arr => [], maybe_bar => Bar->new);
  51 }, undef, '... Bar->new isa maybe(Bar)' );
  52
  53 is( exception {
  54     Foo->new(arr => [], maybe_bar => undef);
  55 }, undef, '... undef isa maybe(Bar)' );
  56
  57 isnt( exception {
  58     Foo->new(arr => [], maybe_bar => 1);
  59 }, undef, '... 1 isnta maybe(Bar)' );
  60
  61 is( exception {
  62     Foo->new(arr => []);
  63 }, undef, '... it worked!' );
  64
  65 is( exception {
  66     Foo->new(arr => undef);
  67 }, undef, '... it worked!' );
  68
  69 isnt( exception {
  70     Foo->new(arr => 100);
  71 }, undef, '... failed the type check' );
  72
  73 isnt( exception {
  74     Foo->new(arr => 'hello world');
  75 }, undef, '... failed the type check' );
  76
  77
  78 {
  79     package Test::MooseX::Types::Maybe;
  80     use Moose;
  81
  82     has 'Maybe_Int' => (is=>'rw', isa=>'Maybe[Int]');
  83     has 'Maybe_ArrayRef' => (is=>'rw', isa=>'Maybe[ArrayRef]');
  84     has 'Maybe_HashRef' => (is=>'rw', isa=>'Maybe[HashRef]');
  85     has 'Maybe_ArrayRefInt' => (is=>'rw', isa=>'Maybe[ArrayRef[Int]]');
  86     has 'Maybe_HashRefInt' => (is=>'rw', isa=>'Maybe[HashRef[Int]]');
  87 }
  88
  89 ok my $obj = Test::MooseX::Types::Maybe->new
  90  => 'Create good test object';
  91
  92 ##  Maybe[Int]
  93
  94 ok my $Maybe_Int  = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]')
  95  => 'made TC Maybe[Int]';
  96
  97 ok $Maybe_Int->check(1)
  98  => 'passed (1)';
  99
 100 ok $obj->Maybe_Int(1)
 101  => 'assigned (1)';
 102
 103 ok $Maybe_Int->check()
 104  => 'passed ()';
 105
 106 ok $obj->Maybe_Int()
 107  => 'assigned ()';
 108
 109 ok $Maybe_Int->check(0)
 110  => 'passed (0)';
 111
 112 ok defined $obj->Maybe_Int(0)
 113  => 'assigned (0)';
 114
 115 ok $Maybe_Int->check(undef)
 116  => 'passed (undef)';
 117
 118 ok sub {$obj->Maybe_Int(undef); 1}->()
 119  => 'assigned (undef)';
 120
 121 ok !$Maybe_Int->check("")
 122  => 'failed ("")';
 123
 124 like( exception { $obj->Maybe_Int("") }, qr/Attribute \(Maybe_Int\) does not pass the type constraint/, 'failed assigned ("")' );
 125
 126 ok !$Maybe_Int->check("a")
 127  => 'failed ("a")';
 128
 129 like( exception { $obj->Maybe_Int("a") }, qr/Attribute \(Maybe_Int\) does not pass the type constraint/, 'failed assigned ("a")' );
 130
 131 done_testing;