use strict;
use warnings;
use Test::More;
-use IO::Handle;
use Test::Exception;
+use IO::Handle;
my @types = qw/Any Item Bool Undef Defined Value Num Int Str ClassName
Ref ScalarRef ArrayRef HashRef CodeRef RegexpRef GlobRef
undef , [qw/Any Item Undef Bool/],
0 => [qw/Any Item Defined Bool Value Num Int Str/],
1 => [qw/Any Item Defined Bool Value Num Int Str/],
- 1.5 => [qw/Any Item Defined Value Num Str/],
- '' => [qw/Any Item Defined Bool Value Str/],
+ 42 => [qw/Any Item Defined Value Num Int Str/],
+ 1.5 => [qw/Any Item Defined Value Num Str/],
+ '' => [qw/Any Item Defined Bool Value Str/],
+ '0' => [qw/Any Item Defined Bool Value Num Int Str/],
+ '1' => [qw/Any Item Defined Bool Value Num Int Str/],
+ '42' => [qw/Any Item Defined Value Num Int Str/],
+ '1.5' => [qw/Any Item Defined Value Num Str/],
't' => [qw/Any Item Defined Value Str/],
'f' => [qw/Any Item Defined Value Str/],
'undef' => [qw/Any Item Defined Value Str/],
for grep { !$is_invalid{$_} } @types;
}
-my $plan = 0;
-$plan += 5 * @{ $values_for_type{$_}{valid} || [] } for @types;
-$plan += 4 * @{ $values_for_type{$_}{invalid} || [] } for @types;
-$plan++; # can_ok
-
-plan tests => $plan;
-
do {
package Class;
use Mouse;
can_ok(Class => @types);
for my $type (@types) {
+ note "For $type";
for my $value (@{ $values_for_type{$type}{valid} }) {
lives_ok {
my $via_new = Class->new($type => $value);
is_deeply($via_new->$type, $value, "correctly set a $type in the constructor");
- };
+ } or die;
lives_ok {
my $via_set = Class->new;
is($via_set->$type, undef, "initially unset");
$via_set->$type($value);
is_deeply($via_set->$type, $value, "correctly set a $type in the setter");
- };
+ } or die;
}
for my $value (@{ $values_for_type{$type}{invalid} }) {
throws_ok {
$via_new = Class->new($type => $value);
} qr/Attribute \($type\) does not pass the type constraint because: Validation failed for '$type' with value \Q$display\E/;
- is($via_new, undef, "no object created");
+ is($via_new, undef, "no object created") or die;
my $via_set = Class->new;
throws_ok {
$via_set->$type($value);
} qr/Attribute \($type\) does not pass the type constraint because: Validation failed for '$type' with value \Q$display\E/;
-
- is($via_set->$type, undef, "value for $type not set");
+ is($via_set->$type, undef, "value for $type not set") or die;
}
}
+done_testing;
#!/usr/bin/env perl
use strict;
use warnings;
-use Test::More tests => 34;
+use Test::More;
use Test::Exception;
do {
isa => 'Test::Builder',
);
+ has obj => (
+ is => 'rw',
+ isa => 'UNIVERSAL',
+ );
+
package Test::Builder::Subclass;
our @ISA = qw(Test::Builder);
};
};
lives_ok {
+ Class->new(obj => Test::Builder->new);
+};
+
+lives_ok {
# Test::Builder was a bizarre choice, because it's a singleton. Because of
# that calling new on T:B:S won't work. Blessing directly -- rjbs,
# 2008-12-04
Class->new(tb => Class->new);
} qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' with value Class=HASH\(\w+\)/;
+throws_ok {
+ Class->new(obj => 42);
+} qr/Attribute \(obj\) does not pass the type constraint because: Validation failed for 'UNIVERSAL' with value 42/;
+
do {
package Other;
use Mouse;
$hs->sausage(Class->new);
} qr/^Attribute \(sausage\) does not pass the type constraint because: Validation failed for 'SausageRole' with value Class=/;
+done_testing;