#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 8;
use Perl6::MetaModel;
=pod
from http://www.nntp.perl.org/group/perl.perl6.language/23474
class Host {
my $.plugInClass;
}
role PlugIn {
method initWithHost (Host $h:) { ... }
}
role FeatureA {}
role FeatureB {}
role FeatureC {}
class AB {
does PlugIn;
does FeatureA;
does FeatureB;
}
class ABC {
does AB;
does FeatureC;
}
if ($host.plugInClass.does('FeatureB')) {
# ... do something with FeatureB
}
=cut
my $Host = class 'Host' => {
is => [ $::Object ],
attributes => [ '$.plugInClass' ],
methods => {
'plugInClass' => sub {
my $self = shift;
_('$.plugInClass' => shift) if @_;
_('$.plugInClass');
}
}
};
my $PlugIn = role 'PlugIn' => {
methods => {
'initWithHost' => sub { 'initing with Host' }
}
};
my $FeatureA = role 'FeatureA' => {};
my $FeatureB = role 'FeatureB' => {};
my $FeatureC = role 'FeatureC' => {};
my $AB = class 'AB' => {
is => [ $::Object ],
does => [ $PlugIn, $FeatureA, $FeatureB ]
};
my $ABC = class 'ABC' => {
is => [ $::Object ],
does => [ $AB, $FeatureC ]
};
# now test it all
my $host = $Host->new();
$host->plugInClass($AB);
ok($host->plugInClass->does('PlugIn'), '... AB does PlugIn');
ok($host->plugInClass->does('FeatureA'), '... AB does FeatureA');
ok($host->plugInClass->does('FeatureB'), '... AB does FeatureB');
my $host2 = $Host->new();
$host2->plugInClass($ABC);
ok($host2->plugInClass->does('PlugIn'), '... ABC does PlugIn');
ok($host2->plugInClass->does('FeatureA'), '... ABC does FeatureA');
ok($host2->plugInClass->does('FeatureB'), '... ABC does FeatureB');
ok($host2->plugInClass->does('FeatureC'), '... ABC does FeatureC');
# we can even check that one plugin is capable of "doing" another plugin
ok($host2->plugInClass->does('AB'), '... ABC does AB');