#!/usr/bin/env perl
use strict;
use warnings;
-use Test::More tests => 24;
-use t::Exception;
+use Test::More tests => 28;
+use Test::Exception;
do {
package Person;
handles => [qw/name age/],
);
- ::throws_ok {
- has error => (
- handles => "string",
- );
- } qr/Unable to canonicalize the 'handles' option with string/;
-
- ::throws_ok {
- has error2 => (
- handles => \"ref_to_string",
- );
- } qr/Unable to canonicalize the 'handles' option with SCALAR\(\w+\)/;
-
- ::throws_ok {
- has error3 => (
- handles => qr/regex/,
- );
- } qr/Unable to canonicalize the 'handles' option with \(\?-xism:regex\)/;
-
- ::throws_ok {
- has error4 => (
- handles => sub { "code" },
- );
- } qr/Unable to canonicalize the 'handles' option with CODE\(\w+\)/;
+ TODO: {
+ local our $TODO = "Mouse lacks this";
+ eval {
+ has error => (
+ handles => "string",
+ );
+ };
+ ::ok(!$@, "handles => role");
+ }
+
+ TODO: {
+ local our $TODO = "Mouse lacks this";
+ eval {
+ has error2 => (
+ handles => \"ref_to_string",
+ );
+ };
+ ::ok(!$@, "handles => \\str");
+ }
+
+ TODO: {
+ local our $TODO = "Mouse lacks this";
+ eval {
+ has error3 => (
+ handles => qr/regex/,
+ );
+ };
+ ::ok(!$@, "handles => qr/re/");
+ }
+
+ TODO: {
+ local our $TODO = "Mouse lacks this";
+ eval {
+ has error4 => (
+ handles => sub { "code" },
+ );
+ };
+ ::ok(!$@, "handles => sub { code }");
+ }
};
can_ok(Class => qw(person has_person person_name person_age name age quid));
"correct handles layout for 'person'",
);
+
+{
+ local $TODO = "failed on some environment, but I don't know why it happens (gfx)";
+ 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();
+};
+like $@, qr/Cannot delegate person_name to name because the value of person is not defined/;
+
+eval{
+ $object->person([]);
+ $object->person_age();
+};
+like $@, qr/Cannot delegate person_age to age because the value of person is not an object/;
+
+