-#!/usr/bin/perl
-
use strict;
use warnings;
-use Test::More tests => 11;
-use Test::Exception;
+use Test::More tests => 13;
+use Test::Deep;
+use Test::Fatal;
BEGIN {
use_ok('MooseX::Storage');
has 'bar' => (
metaclass => 'DoNotSerialize',
is => 'rw',
- default => sub { 'BAR' }
+ default => sub { 'BAR' }
);
-
+
has 'baz' => (
traits => [ 'DoNotSerialize' ],
is => 'rw',
- default => sub { 'BAZ' }
- );
-
+ default => sub { 'BAZ' }
+ );
+
has 'gorch' => (
- is => 'rw',
+ is => 'rw',
default => sub { 'GORCH' }
- );
+ );
1;
}
{ my $foo = Foo->new;
isa_ok($foo, 'Foo');
-
+
is($foo->bar, 'BAR', '... got the value we expected');
is($foo->baz, 'BAZ', '... got the value we expected');
is($foo->gorch, 'GORCH', '... got the value we expected');
-
- is_deeply(
+
+ cmp_deeply(
$foo->pack,
{
__CLASS__ => 'Foo',
metaclass => 'DoNotSerialize',
required => 1,
is => 'rw',
+ isa => 'Object', # type constraint is important
);
-
+
has zot => (
default => sub { $$ },
is => 'rw',
- );
+ );
}
-{ my $bar = Bar->new( foo => $$ );
-
+{ my $obj = bless {};
+ my $bar = Bar->new( foo => $obj );
+
ok( $bar, "New object created" );
- is( $bar->foo, $$, " ->foo => $$" );
+ is( $bar->foo, $obj, " ->foo => $obj" );
is( $bar->zot, $$, " ->zot => $$" );
-
+
my $bpack = $bar->pack;
- is_deeply(
+ cmp_deeply(
$bpack,
{ __CLASS__ => 'Bar',
zot => $$,
}, " Packed correctly" );
-
- my $bar2 = Bar->unpack({ %$bpack, foo => $$ });
- ok( $bar2, " Unpacked correctly by supplying foo => $$");
-}
-
-
-
-
+
+ eval { Bar->unpack( $bpack ) };
+ ok( $@, " Unpack without required attribute fails" );
+ like( $@, qr/foo/, " Proper error recorded" );
+
+ my $bar2 = Bar->unpack( $bpack, inject => { foo => bless {} } );
+ ok( $bar2, " Unpacked correctly with foo => Object");
+}
+
+
+
+