The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use Test::More 0.88;

{
  package Foo::Subsystem;
  use Moose;
  with 'Role::Subsystem' => {
    ident     => 'obj-subsystem',
    type      => 'Foo',
    what      => 'foo',
    id_method => 'id',
    weak_ref  => 0,
  };
}

{
  package Foo;
  use Moose;
  my $counter = 0;
  has id     => (is => 'ro',                    default => sub { ++$counter });
  has abs_id => (is => 'ro', init_arg => undef, default => sub { ++$counter });

  sub subsystem {
    my ($self) = @_;
    Foo::Subsystem->for_foo($self);
  }
}

my $id  = 123;
my $foo = Foo->new({ id => $id });
my $fid = $foo->abs_id;
my $sys = $foo->subsystem;

isa_ok($sys, 'Foo::Subsystem');
ok($sys->foo == $foo,      'subsystem->foo and foo are identical');
is($sys->foo_id, $foo->id, 'ids match');

undef $foo;
isnt($sys->_foo, undef, 'our obj is still there'); # glass box testing
is($sys->foo->abs_id, $fid, '...and we are not just regetting');

done_testing;