a bunch more tests for the Maybe constraint that I wrote while trying to figure out...
[gitmo/Moose.git] / t / 040_type_constraints / 021_maybe_type_constraint.t
CommitLineData
7e4e1ad4 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
f805496a 6use Test::More tests => 31;
7e4e1ad4 7use Test::Exception;
8
7ff56534 9use Moose::Util::TypeConstraints;
7e4e1ad4 10
620db045 11my $type = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]');
7e4e1ad4 12isa_ok($type, 'Moose::Meta::TypeConstraint');
13isa_ok($type, 'Moose::Meta::TypeConstraint::Parameterized');
14
dabed765 15ok( $type->equals($type), "equals self" );
16ok( !$type->equals($type->parent), "not equal to parent" );
17ok( !$type->equals(find_type_constraint("Maybe")), "not equal to Maybe" );
18ok( $type->parent->equals(find_type_constraint("Maybe")), "parent is Maybe" );
19ok( $type->equals( Moose::Meta::TypeConstraint::Parameterized->new( name => "__ANON__", parent => find_type_constraint("Maybe"), type_parameter => find_type_constraint("Int") ) ), "equal to clone" );
20ok( !$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" );
620db045 21ok( !$type->equals( Moose::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Str]') ), "not equal to declarative version of diff param" );
dabed765 22
7e4e1ad4 23ok($type->check(10), '... checked type correctly (pass)');
24ok($type->check(undef), '... checked type correctly (pass)');
25ok(!$type->check('Hello World'), '... checked type correctly (fail)');
26ok(!$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
35lives_ok {
36 Foo->new(bar => []);
37} '... it worked!';
38
39lives_ok {
40 Foo->new(bar => undef);
41} '... it worked!';
42
43dies_ok {
44 Foo->new(bar => 100);
45} '... failed the type check';
46
47dies_ok {
48 Foo->new(bar => 'hello world');
49} '... failed the type check';
50
f805496a 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
63ok my $obj = Test::MooseX::Types::Maybe->new
64 => 'Create good test object';
65
66## Maybe[Int]
67
68ok my $Maybe_Int = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]')
69 => 'made TC Maybe[Int]';
70
71ok $Maybe_Int->check(1)
72 => 'passed (1)';
73
74ok $obj->Maybe_Int(1)
75 => 'assigned (1)';
76
77ok $Maybe_Int->check()
78 => 'passed ()';
79
80ok $obj->Maybe_Int()
81 => 'assigned ()';
82
83ok $Maybe_Int->check(0)
84 => 'passed (0)';
85
86ok defined $obj->Maybe_Int(0)
87 => 'assigned (0)';
88
89ok $Maybe_Int->check(undef)
90 => 'passed (undef)';
91
92ok sub {$obj->Maybe_Int(undef); 1}->()
93 => 'assigned (undef)';
94
95ok !$Maybe_Int->check("")
96 => 'failed ("")';
97
98throws_ok sub { $obj->Maybe_Int("") },
99 qr/Attribute \(Maybe_Int\) does not pass the type constraint/
100 => 'failed assigned ("")';
101
102ok !$Maybe_Int->check("a")
103 => 'failed ("a")';
104
105throws_ok sub { $obj->Maybe_Int("a") },
106 qr/Attribute \(Maybe_Int\) does not pass the type constraint/
107 => 'failed assigned ("a")';