t/011-reference-parameters.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 8;
   5
   6 do {
   7     package MyRole::Delegator;
   8     use MooseX::Role::Parameterized;
   9
  10     parameter handles => (
  11         is       => 'rw',
  12         required => 1,
  13     );
  14
  15     role {
  16         my $p = shift;
  17
  18         has attr => (
  19             is      => 'rw',
  20             isa     => 'MyClass::WithMethods',
  21             handles => $p->handles,
  22         );
  23     };
  24 };
  25
  26 do {
  27     package MyClass::WithMethods;
  28
  29     sub foo { "foo" }
  30     sub bar { "bar" }
  31     sub baz { "baz" }
  32 };
  33
  34 do {
  35     package MyArrayConsumer;
  36     use Moose;
  37     with 'MyRole::Delegator' => {
  38         handles => ['foo', 'bar'],
  39     };
  40 };
  41
  42 can_ok(MyArrayConsumer => 'foo', 'bar');
  43 cant_ok(MyArrayConsumer => 'baz');
  44
  45 do {
  46     package MyRegexConsumer;
  47     use Moose;
  48     with 'MyRole::Delegator' => {
  49         handles => qr/^ba/,
  50     };
  51 };
  52
  53 can_ok(MyRegexConsumer => 'bar', 'baz');
  54 cant_ok(MyRegexConsumer => 'foo');
  55
  56 do {
  57     package MyHashConsumer;
  58     use Moose;
  59     with 'MyRole::Delegator' => {
  60         handles => {
  61             my_foo => 'foo',
  62             his_baz => 'baz',
  63         },
  64     };
  65 };
  66
  67 can_ok(MyHashConsumer => 'my_foo', 'his_baz');
  68 cant_ok(MyHashConsumer => qw/foo bar baz/);
  69
  70 sub cant_ok {
  71     local $Test::Builder::Level = $Test::Builder::Level + 1;
  72     my $instance = shift;
  73     for my $method (@_) {
  74         ok(!$instance->can($method), "$instance cannot $method");
  75     }
  76 }
  77