X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Faccessor-isa.t;h=8f445001fbe12da11924aaea9d9eed473acab3eb;hb=0d931f8a92552b142000bd5a4886e0c3d7d1a553;hp=1529bc17340c54509f59157c0c54ed9a6b5eb658;hpb=b1eebd55fe3d34b6afa73a4880737dc91379b71e;p=gitmo%2FMoo.git

diff --git a/t/accessor-isa.t b/t/accessor-isa.t
index 1529bc1..8f44500 100644
--- a/t/accessor-isa.t
+++ b/t/accessor-isa.t
@@ -7,29 +7,31 @@ sub run_for {
 
   my $obj = $class->new(less_than_three => 1);
 
-  is($obj->less_than_three, 1, 'initial value set');
+  is($obj->less_than_three, 1, "initial value set (${class})");
 
   like(
     exception { $obj->less_than_three(4) },
-    qr/4 is not less than three/, 'exception thrown on bad set'
+    qr/isa check for "less_than_three" failed: 4 is not less than three/,
+    "exception thrown on bad set (${class})"
   );
 
-  is($obj->less_than_three, 1, 'initial value remains after bad set');
+  is($obj->less_than_three, 1, "initial value remains after bad set (${class})");
 
   my $ret;
 
   is(
     exception { $ret = $obj->less_than_three(2) },
-    undef, 'no exception on correct set'
+    undef, "no exception on correct set (${class})"
   );
 
-  is($ret, 2, 'correct setter return');
-  is($obj->less_than_three, 2, 'correct getter return');
+  is($ret, 2, "correct setter return (${class})");
+  is($obj->less_than_three, 2, "correct getter return (${class})");
 
-  is(exception { $class->new }, undef, 'no exception with no value');
+  is(exception { $class->new }, undef, "no exception with no value (${class})");
   like(
     exception { $class->new(less_than_three => 12) },
-    qr/12 is not less than three/, 'exception thrown on bad constructor arg'
+    qr/isa check for "less_than_three" failed: 12 is not less than three/,
+    "exception thrown on bad constructor arg (${class})"
   );
 }
 
@@ -54,7 +56,10 @@ run_for 'Foo';
 
   has less_than_three => (
     is => 'rw',
-    isa => quote_sub q{ die "$_[0] is not less than three" unless $_[0] < 3 }
+    isa => quote_sub q{
+      my ($x) = @_;
+      die "$x is not less than three" unless $x < 3
+    }
   );
 }
 
@@ -69,7 +74,10 @@ run_for 'Bar';
   has less_than_three => (
     is => 'rw',
     isa => quote_sub(
-      q{ die "$_[0] is not less than ${word}" unless $_[0] < $limit },
+      q{
+        my ($value) = @_;
+        die "$value is not less than ${word}" unless $value < $limit
+      },
       { '$limit' => \3, '$word' => \'three' }
     )
   );
@@ -77,4 +85,73 @@ run_for 'Bar';
 
 run_for 'Baz';
 
+my $lt3;
+
+{
+  package LazyFoo;
+
+  use Sub::Quote;
+  use Moo;
+
+  has less_than_three => (
+    is => 'lazy',
+    isa => quote_sub(q{ die "$_[0] is not less than three" unless $_[0] < 3 })
+  );
+
+  sub _build_less_than_three { $lt3 }
+}
+
+$lt3 = 4;
+
+my $lazyfoo = LazyFoo->new;
+like(
+  exception { $lazyfoo->less_than_three },
+  qr/isa check for "less_than_three" failed: 4 is not less than three/,
+  "exception thrown on bad builder return value (LazyFoo)"
+);
+
+$lt3 = 2;
+
+is(
+  exception { $lazyfoo->less_than_three },
+  undef,
+  'Corrected builder value on existing object returned ok'
+);
+
+is(LazyFoo->new->less_than_three, 2, 'Correct builder value returned ok');
+
+{
+  package Fizz;
+
+  use Moo;
+
+  has attr1 => (
+    is => 'ro',
+    isa => sub {
+      no warnings 'once';
+      my $attr = $Method::Generate::Accessor::CurrentAttribute;
+      die bless [@$attr{'name', 'init_arg', 'step'}], 'MyException';
+    },
+    init_arg => 'attr_1',
+  );
+}
+
+my $e = exception { Fizz->new(attr_1 => 5) };
+is(
+  ref($e),
+  'MyException',
+  'Exception objects passed though correctly',
+);
+
+is($e->[0], 'attr1', 'attribute name available in isa check');
+is($e->[1], 'attr_1', 'attribute init_arg available in isa check');
+is($e->[2], 'isa check', 'step available in isa check');
+
+{
+  my $called;
+  local $SIG{__DIE__} = sub { $called++; die $_[0] };
+  my $e = exception { Fizz->new(attr_1 => 5) };
+  is($called, 1, '__DIE__ handler called if set')
+}
+
 done_testing;