t/040_type_constraints/021_maybe_type_constraint.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 31;
   7 use Test::Exception;
   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 Foo;
  30     use Moose;
  31
  32     has 'bar' => (is => 'rw', isa => 'Maybe[ArrayRef]', required => 1);
  33 }
  34
  35 lives_ok {
  36     Foo->new(bar => []);
  37 } '... it worked!';
  38
  39 lives_ok {
  40     Foo->new(bar => undef);
  41 } '... it worked!';
  42
  43 dies_ok {
  44     Foo->new(bar => 100);
  45 } '... failed the type check';
  46
  47 dies_ok {
  48     Foo->new(bar => 'hello world');
  49 } '... failed the type check';
  50
  51
  52 {
  53     package Test::MooseX::Types::Maybe;
  54     use Moose;
  55
  56     has 'Maybe_Int' => (is=>'rw', isa=>'Maybe[Int]');
  57     has 'Maybe_ArrayRef' => (is=>'rw', isa=>'Maybe[ArrayRef]');
  58     has 'Maybe_HashRef' => (is=>'rw', isa=>'Maybe[HashRef]');
  59     has 'Maybe_ArrayRefInt' => (is=>'rw', isa=>'Maybe[ArrayRef[Int]]');
  60     has 'Maybe_HashRefInt' => (is=>'rw', isa=>'Maybe[HashRef[Int]]');
  61 }
  62
  63 ok my $obj = Test::MooseX::Types::Maybe->new
  64  => 'Create good test object';
  65
  66 ##  Maybe[Int]
  67
  68 ok my $Maybe_Int  = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]')
  69  => 'made TC Maybe[Int]';
  70
  71 ok $Maybe_Int->check(1)
  72  => 'passed (1)';
  73
  74 ok $obj->Maybe_Int(1)
  75  => 'assigned (1)';
  76
  77 ok $Maybe_Int->check()
  78  => 'passed ()';
  79
  80 ok $obj->Maybe_Int()
  81  => 'assigned ()';
  82
  83 ok $Maybe_Int->check(0)
  84  => 'passed (0)';
  85
  86 ok defined $obj->Maybe_Int(0)
  87  => 'assigned (0)';
  88
  89 ok $Maybe_Int->check(undef)
  90  => 'passed (undef)';
  91
  92 ok sub {$obj->Maybe_Int(undef); 1}->()
  93  => 'assigned (undef)';
  94
  95 ok !$Maybe_Int->check("")
  96  => 'failed ("")';
  97
  98 throws_ok sub { $obj->Maybe_Int("") },
  99  qr/Attribute \(Maybe_Int\) does not pass the type constraint/
 100  => 'failed assigned ("")';
 101
 102 ok !$Maybe_Int->check("a")
 103  => 'failed ("a")';
 104
 105 throws_ok sub { $obj->Maybe_Int("a") },
 106  qr/Attribute \(Maybe_Int\) does not pass the type constraint/
 107  => 'failed assigned ("a")';