From: ewilhelm <ewilhelm@3efe9002-19ed-0310-8735-a98156148065>
Date: Sat, 5 Aug 2006 23:24:24 +0000 (+0000)
Subject: t/002_dynamic.t - test for passing caller package to policy module
X-Git-Tag: 0_01~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a88576d4adc4a2a05aba1dc61544ff8edca0f1f9;p=gitmo%2FMoose-Policy.git

t/002_dynamic.t - test for passing caller package to policy module
---

diff --git a/t/002_dynamic.t b/t/002_dynamic.t
new file mode 100644
index 0000000..1005d7a
--- /dev/null
+++ b/t/002_dynamic.t
@@ -0,0 +1,89 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+BEGIN {
+    use_ok('Moose::Policy');
+}
+
+BEGIN {
+    package My::Plain::Attribute;
+    use Moose;
+    extends 'Moose::Meta::Attribute';
+}
+BEGIN {
+    package My::Bar::Attribute;
+    use Moose;
+    extends 'Moose::Meta::Attribute';
+}
+BEGIN {
+    package My::Plain::Class;
+    use Moose;
+    extends 'Moose::Meta::Class';
+}
+BEGIN {
+    package My::Bar::Class;
+    use Moose;
+    extends 'Moose::Meta::Class';
+}
+BEGIN {
+    package My::Moose::Policy;
+    # because writing subs is hard
+    my %pkg_map = (
+        qw(metaclass Class),
+        qw(attribute_metaclass  Attribute),
+        # TODO these:
+        # qw(method_metaclass Method),
+        # qw(instance_metaclass Instance),
+    );
+    foreach my $subname (keys(%pkg_map)) {
+        my $pkg = $pkg_map{$subname};
+        my $sub = sub {
+            my $self = shift;
+            my ($caller) = @_;
+            return('My::Bar::' . $pkg)
+                if($caller =~ m/^Bar(?:::|$)/);
+            return 'My::Plain::' . $pkg;
+        };
+        no strict 'refs';
+        *{$subname} = $sub;
+    }
+}
+{
+    package Foo;
+    use Moose::Policy 'My::Moose::Policy';
+}
+{
+    package Bar;
+    use Moose::Policy 'My::Moose::Policy';
+}
+{
+    package Bars;
+    use Moose::Policy 'My::Moose::Policy';
+}
+{
+    package Bar::None;
+    use Moose::Policy 'My::Moose::Policy';
+}
+
+isa_ok(Foo->meta, 'Moose::Meta::Class');
+is(Foo->meta->attribute_metaclass, 'My::Plain::Attribute',
+    '... got our custom attr metaclass');
+
+isa_ok(Bar->meta, 'Moose::Meta::Class');
+isa_ok(Bar->meta, 'My::Bar::Class');
+is(Bar->meta->attribute_metaclass, 'My::Bar::Attribute',
+    '... got our custom attr metaclass');
+
+isa_ok(Bars->meta, 'Moose::Meta::Class');
+isa_ok(Bars->meta, 'My::Plain::Class');
+is(Bars->meta->attribute_metaclass, 'My::Plain::Attribute',
+    '... got our custom attr metaclass');
+
+isa_ok(Bar::None->meta, 'Moose::Meta::Class');
+isa_ok(Bar::None->meta, 'My::Bar::Class');
+is(Bar::None->meta->attribute_metaclass, 'My::Bar::Attribute',
+    '... got our custom attr metaclass');