Correct error message to include 'Maybe' as implemented parametric type.
[gitmo/Mouse.git] / t / 025-more-isa.t
CommitLineData
3301fa54 1#!/usr/bin/env perl
2use strict;
3use warnings;
285764da 4use Test::More tests => 30;
eab81545 5use Test::Exception;
3301fa54 6
7do {
8 package Class;
9 use Mouse;
10
11 has tb => (
12 is => 'rw',
13 isa => 'Test::Builder',
14 );
285764da 15
16 package Test::Builder::Subclass;
17 our @ISA = qw(Test::Builder);
3301fa54 18};
19
20can_ok(Class => 'tb');
21
22lives_ok {
23 Class->new(tb => Test::Builder->new);
24};
25
26lives_ok {
285764da 27 # Test::Builder was a bizarre choice, because it's a singleton. Because of
28 # that calling new on T:B:S won't work. Blessing directly -- rjbs,
29 # 2008-12-04
30 Class->new(tb => (bless {} => 'Test::Builder::Subclass'));
31};
32
33lives_ok {
3301fa54 34 my $class = Class->new;
35 $class->tb(Test::Builder->new);
36 isa_ok($class->tb, 'Test::Builder');
37};
38
39throws_ok {
40 Class->new(tb => 3);
41} qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' failed with value 3/;
42
43throws_ok {
44 my $class = Class->new;
45 $class->tb(3);
46} qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' failed with value 3/;
47
48throws_ok {
49 Class->new(tb => Class->new);
50} qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' failed with value Class=HASH\(\w+\)/;
51
e3d9dc7b 52do {
53 package Other;
54 use Mouse;
55
56 has oops => (
57 isa => 'Int',
58 default => "yikes",
59 );
60};
61
62throws_ok {
63 Other->new;
64} qr/Attribute \(oops\) does not pass the type constraint because: Validation failed for 'Int' failed with value yikes/;
65
66lives_ok {
67 Other->new(oops => 10);
68};
69
6feb83f1 70# ClassName coverage tests
71
72do {
73 package A;
3e8e32b5 74 our @VERSION;
6feb83f1 75
76 package B;
3e8e32b5 77 our $VERSION = 1;
6feb83f1 78
79 package C;
3e8e32b5 80 our %ISA;
6feb83f1 81
3e8e32b5 82 package D;
83 our @ISA = 'Mouse::Object';
6feb83f1 84
85 package E;
3e8e32b5 86 sub foo {}
6feb83f1 87
88 package F;
3e8e32b5 89
90 package G::H;
91 sub bar {}
92
93 package I;
6feb83f1 94 our $NOT_CODE = 1;
95};
96
97do {
98 package ClassNameTests;
99 use Mouse;
100
101 has class => (
102 is => 'rw',
103 isa => 'ClassName',
104 );
105};
106
2a902f4c 107for ('B'..'E', 'G::H') {
6feb83f1 108 lives_ok {
109 ClassNameTests->new(class => $_);
110 };
111
112 lives_ok {
113 my $obj = ClassNameTests->new;
114 $obj->class($_);
115 };
116}
117
2a902f4c 118TODO: {
119 local $TODO = "Moose throws errors here. Mouse does not";
120 throws_ok {
121 ClassNameTests->new(class => 'A');
122 } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value A/;
123
124 throws_ok {
125 my $obj = ClassNameTests->new;
126 $obj->class('A');
127 } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value A/;
128}
129
3e8e32b5 130for ('F', 'G', 'I', 'Z') {
6feb83f1 131 throws_ok {
132 ClassNameTests->new(class => $_);
133 } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/;
134
135 throws_ok {
136 my $obj = ClassNameTests->new;
137 $obj->class($_);
138 } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/;
139};
140