use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
{
use Moose::Util::TypeConstraints;
subtype 'H3', as 'HashRef[Int]',
where { ( sum( values %{$_} ) || 0 ) < 5 };
+ subtype 'H5', as 'HashRef';
+ coerce 'H5', from 'Str', via { { key => $_ } };
+
no Moose::Util::TypeConstraints;
}
set_h3 => 'set',
},
);
+
+ has h4 => (
+ traits => ['Hash'],
+ is => 'rw',
+ isa => 'HashRef',
+ lazy => 1,
+ default => 'invalid',
+ clearer => '_clear_h4',
+ handles => {
+ get_h4 => 'get',
+ accessor_h4 => 'accessor',
+ },
+ );
+
+ has h5 => (
+ traits => ['Hash'],
+ is => 'rw',
+ isa => 'H5',
+ coerce => 1,
+ lazy => 1,
+ default => 'invalid',
+ clearer => '_clear_h5',
+ handles => {
+ get_h5 => 'get',
+ accessor_h5 => 'accessor',
+ },
+ );
}
my $foo = Foo->new;
$foo->hash_int( {} );
is_deeply( $foo->hash_int, {}, "hash_int - correct contents" );
- dies_ok { $foo->set_hash_int( x => 'foo' ) }
- "hash_int - can't set wrong type";
+ isnt( exception { $foo->set_hash_int( x => 'foo' ) }, undef, "hash_int - can't set wrong type" );
is_deeply( $foo->hash_int, {}, "hash_int - correct contents" );
$foo->set_hash_int( x => 1 );
}
{
- dies_ok { $foo->set_h1('foo') } "h1 - can't set onto undef";
+ isnt( exception { $foo->set_h1('foo') }, undef, "h1 - can't set onto undef" );
$foo->h1( {} );
is_deeply( $foo->h1, {}, "h1 - correct contents" );
- dies_ok { $foo->set_h1( x => 'foo' ) } "h1 - can't set wrong type";
+ isnt( exception { $foo->set_h1( x => 'foo' ) }, undef, "h1 - can't set wrong type" );
is_deeply( $foo->h1, {}, "h1 - correct contents" );
}
{
- dies_ok { $foo->set_h2('foo') } "h2 - can't set onto undef";
+ isnt( exception { $foo->set_h2('foo') }, undef, "h2 - can't set onto undef" );
$foo->h2( {} );
is_deeply( $foo->h2, {}, "h2 - correct contents" );
$foo->set_h2( x => 'foo' );
is_deeply( $foo->h2, { x => 'foo' }, "h2 - correct contents" );
- dies_ok { $foo->set_h2( y => 'bar' ) }
- "h2 - can't set more than one element";
+ isnt( exception { $foo->set_h2( y => 'bar' ) }, undef, "h2 - can't set more than one element" );
is_deeply( $foo->h2, { x => 'foo' }, "h2 - correct contents" );
}
{
- dies_ok { $foo->set_h3(1) } "h3 - can't set onto undef";
+ isnt( exception { $foo->set_h3(1) }, undef, "h3 - can't set onto undef" );
$foo->h3( {} );
is_deeply( $foo->h3, {}, "h3 - correct contents" );
- dies_ok { $foo->set_h3( x => 'foo' ) } "h3 - can't set non-int";
+ isnt( exception { $foo->set_h3( x => 'foo' ) }, undef, "h3 - can't set non-int" );
- dies_ok { $foo->set_h3( x => 100 ) }
- "h3 - can't violate overall type constraint";
+ isnt( exception { $foo->set_h3( x => 100 ) }, undef, "h3 - can't violate overall type constraint" );
is_deeply( $foo->h3, {}, "h3 - correct contents" );
$foo->set_h3( x => 1 );
is_deeply( $foo->h3, { x => 1 }, "h3 - correct contents" );
- dies_ok { $foo->set_h3( x => 100 ) }
- "h3 - can't violate overall type constraint";
+ isnt( exception { $foo->set_h3( x => 100 ) }, undef, "h3 - can't violate overall type constraint" );
is_deeply( $foo->h3, { x => 1 }, "h3 - correct contents" );
is_deeply( $foo->h3, { x => 1, y => 3 }, "h3 - correct contents" );
}
+{
+ my $expect
+ = qr/\QAttribute (h4) does not pass the type constraint because: Validation failed for 'HashRef' with value invalid/;
+
+ like(
+ exception { $foo->accessor_h4('key'); },
+ $expect,
+ 'invalid default is caught when trying to read via accessor'
+ );
+
+ like(
+ exception { $foo->accessor_h4( size => 42 ); },
+ $expect,
+ 'invalid default is caught when trying to write via accessor'
+ );
+
+ like(
+ exception { $foo->get_h4(42); },
+ $expect,
+ 'invalid default is caught when trying to get'
+ );
+}
+
+{
+ my $foo = Foo->new;
+
+ is(
+ $foo->accessor_h5('key'), 'invalid',
+ 'lazy default is coerced when trying to read via accessor'
+ );
+
+ $foo->_clear_h5;
+
+ $foo->accessor_h5( size => 42 );
+
+ is_deeply(
+ $foo->h5,
+ { key => 'invalid', size => 42 },
+ 'lazy default is coerced when trying to write via accessor'
+ );
+
+ $foo->_clear_h5;
+
+ is(
+ $foo->get_h5('key'), 'invalid',
+ 'lazy default is coerced when trying to get'
+ );
+}
+
done_testing;