Note failures in 5.10.1, but I don't know why it happens
gfx [Tue, 22 Sep 2009 02:05:42 +0000 (11:05 +0900)]
lib/Mouse/Meta/Method/Accessor.pm
t/019-handles.t

index 3ae91a8..0fb563c 100755 (executable)
@@ -178,12 +178,12 @@ sub _install_handles {
             my $error = !defined($proxy)                ? ' is not defined'\r
                       : ref($proxy) && !blessed($proxy) ? qq{ is not an object (got '$proxy')}\r
                                                         : undef;\r
-            if ($error) {\r
+            if ($error) {
                 $instance->meta->throw_error(\r
                     "Cannot delegate $handle_name to $method_to_call because "\r
                         . "the value of "\r
                         . $attribute->name\r
-                        . $error,
+                        . $error
                  );\r
             }\r
             $proxy->$method_to_call(@_);\r
index 47abf58..10acf1e 100644 (file)
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 26;
+use Test::More tests => 28;
 use Test::Exception;
 
 do {
@@ -118,13 +118,30 @@ is_deeply(
     "correct handles layout for 'person'",
 );
 
-throws_ok{
+
+{
+    local $TODO = "failed in 5.10.1, but I don't know why (gfx)" if $] == 5.010_001;
+    throws_ok{
+        $object->person(undef);
+        $object->person_name();
+    } qr/Cannot delegate person_name to name because the value of person is not defined/;
+
+    throws_ok{
+        $object->person([]);
+        $object->person_age();
+    } qr/Cannot delegate person_age to age because the value of person is not an object/;
+}
+
+eval{
     $object->person(undef);
     $object->person_name();
-} qr/Cannot delegate person_name to name because the value of person is not defined/;
+};
+like $@, qr/Cannot delegate person_name to name because the value of person is not defined/;
 
-throws_ok{
+eval{
     $object->person([]);
     $object->person_age();
-} qr/Cannot delegate person_age to age because the value of person is not an object/;
+};
+like $@, qr/Cannot delegate person_age to age because the value of person is not an object/;
+