From: gfx <gfuji@cpan.org>
Date: Sun, 12 Sep 2010 07:02:14 +0000 (+0900)
Subject: Tests
X-Git-Tag: 0.69~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e2962c13d0691299d1914fe3bb0e74511fcb420b;p=gitmo%2FMouse.git

Tests
---

diff --git a/t/001_mouse/024-isa.t b/t/001_mouse/024-isa.t
index 1a0e53d..eda0001 100644
--- a/t/001_mouse/024-isa.t
+++ b/t/001_mouse/024-isa.t
@@ -2,8 +2,8 @@
 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
@@ -13,8 +13,13 @@ 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/],
-    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/],
@@ -47,13 +52,6 @@ for (my $i = 1; $i < @type_values; $i += 2) {
         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;
@@ -69,18 +67,19 @@ do {
 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} }) {
@@ -89,14 +88,14 @@ for my $type (@types) {
         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;
diff --git a/t/001_mouse/025-more-isa.t b/t/001_mouse/025-more-isa.t
index c2b69a9..c2d6ba2 100644
--- a/t/001_mouse/025-more-isa.t
+++ b/t/001_mouse/025-more-isa.t
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 34;
+use Test::More;
 use Test::Exception;
 
 do {
@@ -13,6 +13,11 @@ do {
         isa => 'Test::Builder',
     );
 
+    has obj => (
+        is  => 'rw',
+        isa => 'UNIVERSAL',
+    );
+
     package Test::Builder::Subclass;
     our @ISA = qw(Test::Builder);
 };
@@ -24,6 +29,10 @@ lives_ok {
 };
 
 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
@@ -49,6 +58,10 @@ throws_ok {
     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;
@@ -180,3 +193,4 @@ throws_ok {
     $hs->sausage(Class->new);   
 } qr/^Attribute \(sausage\) does not pass the type constraint because: Validation failed for 'SausageRole' with value Class=/;
 
+done_testing;