improve test by testing for explicit exception message

[gitmo/MooseX-UndefTolerant.git] / t / constructor.t

diff --git a/t/constructor.t b/t/constructor.t
index a638cbf..90e8ea1 100644 (file)
--- a/t/constructor.t
+++ b/t/constructor.t
@@ -11,12 +11,16 @@ use Test::Fatal;
         isa => 'Num',
         predicate => 'has_attr1',
     );
-
     has 'attr2' => (
         is => 'ro',
         isa => 'Num',
         predicate => 'has_attr2',
     );
+    has 'attr3' => (
+        is => 'ro',
+        isa => 'Maybe[Num]',
+        predicate => 'has_attr3',
+    );
 }
 
 {
@@ -34,6 +38,11 @@ use Test::Fatal;
         isa => 'Num',
         predicate => 'has_attr2',
     );
+    has 'attr3' => (
+        is => 'ro',
+        isa => 'Maybe[Num]',
+        predicate => 'has_attr3',
+    );
 }
 
 package main;
@@ -45,21 +54,32 @@ sub do_tests
         my $obj = Foo->new;
         ok(!$obj->has_attr1, 'attr1 has no value before it is assigned');
         ok(!$obj->has_attr2, 'attr2 has no value before it is assigned');
+        ok(!$obj->has_attr3, 'attr3 has no value before it is assigned');
     }
 
     {
         my $obj = Foo->new(attr1 => undef);
         ok(!$obj->has_attr1, 'UT attr1 has no value when assigned undef in constructor');
-        ok (exception { $obj = Foo->new(attr2 => undef) },
+        like(
+            exception { $obj = Foo->new(attr2 => undef) },
+            qr/\QAttribute (attr2) does not pass the type constraint because: Validation failed for 'Num' with value undef\E/,
             'But assigning undef to attr2 generates a type constraint error');
+
+        is (exception { $obj = Foo->new(attr3 => undef) }, undef,
+            'assigning undef to attr3 is acceptable');
+        ok($obj->has_attr3, 'attr3 retains its undef value when assigned undef in constructor');
     }
 
     {
-        my $obj = Foo->new(attr1 => 1234, attr2 => 5678);
+        my $obj = Foo->new(attr1 => 1234, attr2 => 5678, attr3 => 9012);
         is($obj->attr1, 1234, 'assigning a defined value during construction works as normal');
         ok($obj->has_attr1, '...and the predicate returns true as normal');
+
         is($obj->attr2, 5678, 'assigning a defined value during construction works as normal');
         ok($obj->has_attr2, '...and the predicate returns true as normal');
+
+        is($obj->attr3, 9012, 'assigning a defined value during construction works as normal');
+        ok($obj->has_attr3, '...and the predicate returns true as normal');
     }
 
 
@@ -68,20 +88,33 @@ sub do_tests
     {
         my $obj = Bar->new;
         ok(!$obj->has_attr1, 'attr1 has no value before it is assigned');
+        ok(!$obj->has_attr2, 'attr2 has no value before it is assigned');
+        ok(!$obj->has_attr3, 'attr3 has no value before it is assigned');
     }
 
     {
         my $obj = Bar->new(attr1 => undef);
         ok(!$obj->has_attr1, 'attr1 has no value when assigned undef in constructor');
-        ok (!exception { $obj = Bar->new(attr2 => undef) },
+        # note this test differs from the Foo case above
+        is (exception { $obj = Bar->new(attr2 => undef) }, undef,
             'assigning undef to attr2 does not produce an error');
         ok(!$obj->has_attr2, 'attr2 has no value when assigned undef in constructor');
+
+        is( exception { $obj = Foo->new(attr3 => undef) }, undef,
+            'assigning undef to attr3 is acceptable');
+        ok($obj->has_attr3, 'attr3 retains its undef value when assigned undef in constructor');
     }
 
     {
-        my $obj = Bar->new(attr1 => 1234);
+        my $obj = Bar->new(attr1 => 1234, attr2 => 5678, attr3 => 9012);
         is($obj->attr1, 1234, 'assigning a defined value during construction works as normal');
         ok($obj->has_attr1, '...and the predicate returns true as normal');
+
+        is($obj->attr2, 5678, 'assigning a defined value during construction works as normal');
+        ok($obj->has_attr2, '...and the predicate returns true as normal');
+
+        is($obj->attr3, 9012, 'assigning a defined value during construction works as normal');
+        ok($obj->has_attr3, '...and the predicate returns true as normal');
     }
 }
 
@@ -98,7 +131,7 @@ Bar->meta->make_immutable;
 TODO: {
     local $TODO = 'some immutable cases are not handled yet';
     # for now, catch errors
-    ok(! exception { do_tests }, 'tests do not die');
+    is(exception { do_tests }, undef, 'tests do not die');
 
     is(Test::More->builder->current_test, 28, 'if we got here, we can declare victory!');
 }