t-failing/040_type_constraints/021_maybe_type_constraint.t

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