From: Jesse Luehrs <doy@tozt.net>
Date: Sat, 17 Sep 2011 18:27:06 +0000 (-0500)
Subject: add some tests
X-Git-Tag: 2.0300~29
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=340ad0aa9b79ddfcf90e5884d60cd46c1013c0fb;p=gitmo%2FMoose.git

add some tests
---

diff --git a/t/attributes/default_class_role_types.t b/t/attributes/default_class_role_types.t
new file mode 100644
index 0000000..30073ba
--- /dev/null
+++ b/t/attributes/default_class_role_types.t
@@ -0,0 +1,48 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Fatal;
+
+use Moose::Util::TypeConstraints;
+
+{
+    package Foo;
+    use Moose;
+
+    has unknown_class => (
+        is  => 'ro',
+        isa => 'UnknownClass',
+    );
+
+    has unknown_role => (
+        is   => 'ro',
+        does => 'UnknownRole',
+    );
+}
+
+{
+    my $meta = Foo->meta;
+
+    my $class_tc = $meta->get_attribute('unknown_class')->type_constraint;
+    isa_ok($class_tc, 'Moose::Meta::TypeConstraint::Class');
+    is($class_tc, find_type_constraint('UnknownClass'),
+       "class type is registered");
+    like(
+        exception { subtype 'UnknownClass', as 'Str'; },
+        qr/The type constraint 'UnknownClass' has already been created in Foo and cannot be created again in main/,
+        "Can't redefine implicitly defined class types"
+    );
+
+    my $role_tc = $meta->get_attribute('unknown_role')->type_constraint;
+    isa_ok($role_tc, 'Moose::Meta::TypeConstraint::Role');
+    is($role_tc, find_type_constraint('UnknownRole'),
+       "role type is registered");
+    like(
+        exception { subtype 'UnknownRole', as 'Str'; },
+        qr/The type constraint 'UnknownRole' has already been created in Foo and cannot be created again in main/,
+        "Can't redefine implicitly defined class types"
+    );
+}
+
+done_testing;
diff --git a/t/type_constraints/name_conflicts.t b/t/type_constraints/name_conflicts.t
new file mode 100644
index 0000000..a03fdc1
--- /dev/null
+++ b/t/type_constraints/name_conflicts.t
@@ -0,0 +1,113 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Fatal;
+
+use Moose::Util::TypeConstraints;
+
+{
+    package Types;
+    use Moose::Util::TypeConstraints;
+
+    type 'Foo1';
+    subtype 'Foo2', as 'Str';
+    class_type 'Foo3';
+    role_type 'Foo4';
+
+    { package Foo5;     use Moose; }
+    { package Foo6;     use Moose::Role; }
+    { package IsaAttr;  use Moose; has foo => (is => 'ro', isa  => 'Foo7'); }
+    { package DoesAttr; use Moose; has foo => (is => 'ro', does => 'Foo8'); }
+}
+
+{
+    my $anon = 0;
+    my @checks = (
+        [1, sub { type $_[0] }, 'type'],
+        [1, sub { subtype $_[0], as 'Str' }, 'subtype'],
+        [1, sub { class_type $_[0] }, 'class_type'],
+        [1, sub { role_type $_[0] }, 'role_type'],
+        # should these two die?
+        [0, sub { eval "package $_[0]; use Moose; 1" || die $@ }, 'use Moose'],
+        [0, sub { eval "package $_[0]; use Moose::Role; 1" || die $@ }, 'use Moose::Role'],
+        [0, sub {
+            $anon++;
+            eval <<CLASS || die $@;
+            package Anon$anon;
+            use Moose;
+            has foo => (is => 'ro', isa => '$_[0]');
+            1
+CLASS
+        }, 'isa => "Thing"'],
+        [0, sub {
+            $anon++;
+            eval <<CLASS || die $@;
+            package Anon$anon;
+            use Moose;
+            has foo => (is => 'ro', does => '$_[0]');
+            1
+CLASS
+        }, 'does => "Thing"'],
+    );
+
+    sub check_conflicts {
+        my ($type_name) = @_;
+        my $type = find_type_constraint($type_name);
+        for my $check (@checks) {
+            my ($should_fail, $code, $desc) = @$check;
+
+            $should_fail = 0
+                if overriding_with_equivalent_type($type, $desc);
+            unload_class($type_name);
+
+            if ($should_fail) {
+                like(
+                    exception { $code->($type_name) },
+                    qr/^The type constraint '$type_name' has already been created in [\w:]+ and cannot be created again in [\w:]+/,
+                    "trying to override $type_name via '$desc' should die"
+                );
+            }
+            else {
+                is(
+                    exception { $code->($type_name) },
+                    undef,
+                    "trying to override $type_name via '$desc' should do nothing"
+                );
+            }
+            is($type, find_type_constraint($type_name), "type didn't change");
+        }
+    }
+
+    sub unload_class {
+        my ($class) = @_;
+        my $meta = Class::MOP::class_of($class);
+        return unless $meta;
+        $meta->add_package_symbol('@ISA', []);
+        $meta->remove_package_symbol('&'.$_)
+            for $meta->list_all_package_symbols('CODE');
+        undef $meta;
+        Class::MOP::remove_metaclass_by_name($class);
+    }
+
+    sub overriding_with_equivalent_type {
+        my ($type, $desc) = @_;
+        if ($type->isa('Moose::Meta::TypeConstraint::Class')) {
+            return 1 if $desc eq 'use Moose'
+                     || $desc eq 'class_type'
+                     || $desc eq 'isa => "Thing"';
+        }
+        if ($type->isa('Moose::Meta::TypeConstraint::Role')) {
+            return 1 if $desc eq 'use Moose::Role'
+                     || $desc eq 'role_type'
+                     || $desc eq 'does => "Thing"';
+        }
+        return;
+    }
+}
+
+{
+    check_conflicts($_) for map { "Foo$_" } 1..8;
+}
+
+done_testing;