trAvis - MANAGER
Edit File: 024-isa.t
#!/usr/bin/perl use strict; use warnings; use Test::More; 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 FileHandle Object/; my @type_values = ( 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/], 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/], 'Test::More' => [qw/Any Item Defined Value Str ClassName/], \undef => [qw/Any Item Defined Ref ScalarRef/], \1 => [qw/Any Item Defined Ref ScalarRef/], \"foo" => [qw/Any Item Defined Ref ScalarRef/], [], => [qw/Any Item Defined Ref ArrayRef/], [undef, \1] => [qw/Any Item Defined Ref ArrayRef/], {} => [qw/Any Item Defined Ref HashRef/], sub { die } => [qw/Any Item Defined Ref CodeRef/], qr/.*/ => [qw/Any Item Defined Ref RegexpRef/], \*main::ok => [qw/Any Item Defined Ref GlobRef/], \*STDOUT => [qw/Any Item Defined Ref GlobRef FileHandle/], IO::Handle->new => [qw/Any Item Defined Ref Object FileHandle/], Test::Builder->new => [qw/Any Item Defined Ref Object/], ); my %values_for_type; for (my $i = 1; $i < @type_values; $i += 2) { my ($value, $valid_types) = @type_values[$i-1, $i]; my %is_invalid = map { $_ => 1 } @types; delete @is_invalid{@$valid_types}; push @{ $values_for_type{$_}{invalid} }, $value for grep { $is_invalid{$_} } @types; push @{ $values_for_type{$_}{valid} }, $value for grep { !$is_invalid{$_} } @types; } do { package Class; use Mouse; for my $type (@types) { has $type => ( is => 'rw', isa => $type, ); } }; 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} }) { my $display = defined($value) ? overload::StrVal($value) : 'undef'; my $via_new; 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") 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") or die; } } done_testing;