t/002_dynamic.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 12;
   7
   8 BEGIN {
   9     use_ok('Moose::Policy');
  10 }
  11
  12 BEGIN {
  13     package My::Plain::Attribute;
  14     use Moose;
  15     extends 'Moose::Meta::Attribute';
  16 }
  17 BEGIN {
  18     package My::Bar::Attribute;
  19     use Moose;
  20     extends 'Moose::Meta::Attribute';
  21 }
  22 BEGIN {
  23     package My::Plain::Class;
  24     use Moose;
  25     extends 'Moose::Meta::Class';
  26 }
  27 BEGIN {
  28     package My::Bar::Class;
  29     use Moose;
  30     extends 'Moose::Meta::Class';
  31 }
  32 BEGIN {
  33     package My::Moose::Policy;
  34     # because writing subs is hard
  35     my %pkg_map = (
  36         qw(metaclass Class),
  37         qw(attribute_metaclass  Attribute),
  38         # TODO these:
  39         # qw(method_metaclass Method),
  40         # qw(instance_metaclass Instance),
  41     );
  42     foreach my $subname (keys(%pkg_map)) {
  43         my $pkg = $pkg_map{$subname};
  44         my $sub = sub {
  45             my $self = shift;
  46             my ($caller) = @_;
  47             return('My::Bar::' . $pkg)
  48                 if($caller =~ m/^Bar(?:::|$)/);
  49             return 'My::Plain::' . $pkg;
  50         };
  51         no strict 'refs';
  52         *{$subname} = $sub;
  53     }
  54 }
  55 {
  56     package Foo;
  57     use Moose::Policy 'My::Moose::Policy';
  58 }
  59 {
  60     package Bar;
  61     use Moose::Policy 'My::Moose::Policy';
  62 }
  63 {
  64     package Bars;
  65     use Moose::Policy 'My::Moose::Policy';
  66 }
  67 {
  68     package Bar::None;
  69     use Moose::Policy 'My::Moose::Policy';
  70 }
  71
  72 isa_ok(Foo->meta, 'Moose::Meta::Class');
  73 is(Foo->meta->attribute_metaclass, 'My::Plain::Attribute',
  74     '... got our custom attr metaclass');
  75
  76 isa_ok(Bar->meta, 'Moose::Meta::Class');
  77 isa_ok(Bar->meta, 'My::Bar::Class');
  78 is(Bar->meta->attribute_metaclass, 'My::Bar::Attribute',
  79     '... got our custom attr metaclass');
  80
  81 isa_ok(Bars->meta, 'Moose::Meta::Class');
  82 isa_ok(Bars->meta, 'My::Plain::Class');
  83 is(Bars->meta->attribute_metaclass, 'My::Plain::Attribute',
  84     '... got our custom attr metaclass');
  85
  86 isa_ok(Bar::None->meta, 'Moose::Meta::Class');
  87 isa_ok(Bar::None->meta, 'My::Bar::Class');
  88 is(Bar::None->meta->attribute_metaclass, 'My::Bar::Attribute',
  89     '... got our custom attr metaclass');