1use strict;
2use warnings;
3use Test::More;
4use Test::Fatal;
5
6use Moose::Util::TypeConstraints;
7
8{
9    package Types;
10    use Moose::Util::TypeConstraints;
11
12    type 'Foo1';
13    subtype 'Foo2', as 'Str';
14    class_type 'Foo3';
15    role_type 'Foo4';
16
17    { package Foo5;     use Moose; }
18    { package Foo6;     use Moose::Role; }
19    { package IsaAttr;  use Moose; has foo => (is => 'ro', isa  => 'Foo7'); }
20    { package DoesAttr; use Moose; has foo => (is => 'ro', does => 'Foo8'); }
21}
22
23{
24    my $anon = 0;
25    my @checks = (
26        [1, sub { type $_[0] }, 'type'],
27        [1, sub { subtype $_[0], as 'Str' }, 'subtype'],
28        [1, sub { class_type $_[0] }, 'class_type'],
29        [1, sub { role_type $_[0] }, 'role_type'],
30        # should these two die?
31        [0, sub { eval "package $_[0]; use Moose; 1" || die $@ }, 'use Moose'],
32        [0, sub { eval "package $_[0]; use Moose::Role; 1" || die $@ }, 'use Moose::Role'],
33        [0, sub {
34            $anon++;
35            eval <<CLASS || die $@;
36            package Anon$anon;
37            use Moose;
38            has foo => (is => 'ro', isa => '$_[0]');
39            1
40CLASS
41        }, 'isa => "Thing"'],
42        [0, sub {
43            $anon++;
44            eval <<CLASS || die $@;
45            package Anon$anon;
46            use Moose;
47            has foo => (is => 'ro', does => '$_[0]');
48            1
49CLASS
50        }, 'does => "Thing"'],
51    );
52
53    sub check_conflicts {
54        my ($type_name) = @_;
55        my $type = find_type_constraint($type_name);
56        for my $check (@checks) {
57            my ($should_fail, $code, $desc) = @$check;
58
59            $should_fail = 0
60                if overriding_with_equivalent_type($type, $desc);
61            unload_class($type_name);
62
63            if ($should_fail) {
64                like(
65                    exception { $code->($type_name) },
66                    qr/^The type constraint '$type_name' has already been created in [\w:]+ and cannot be created again in [\w:]+/,
67                    "trying to override $type_name via '$desc' should die"
68                );
69            }
70            else {
71                is(
72                    exception { $code->($type_name) },
73                    undef,
74                    "trying to override $type_name via '$desc' should do nothing"
75                );
76            }
77            is($type, find_type_constraint($type_name), "type didn't change");
78        }
79    }
80
81    sub unload_class {
82        my ($class) = @_;
83        my $meta = Class::MOP::class_of($class);
84        return unless $meta;
85        $meta->add_package_symbol('@ISA', []);
86        $meta->remove_package_symbol('&'.$_)
87            for $meta->list_all_package_symbols('CODE');
88        undef $meta;
89        Class::MOP::remove_metaclass_by_name($class);
90    }
91
92    sub overriding_with_equivalent_type {
93        my ($type, $desc) = @_;
94        if ($type->isa('Moose::Meta::TypeConstraint::Class')) {
95            return 1 if $desc eq 'use Moose'
96                     || $desc eq 'class_type'
97                     || $desc eq 'isa => "Thing"';
98        }
99        if ($type->isa('Moose::Meta::TypeConstraint::Role')) {
100            return 1 if $desc eq 'use Moose::Role'
101                     || $desc eq 'role_type'
102                     || $desc eq 'does => "Thing"';
103        }
104        return;
105    }
106}
107
108{
109    check_conflicts($_) for map { "Foo$_" } 1..8;
110}
111
112done_testing;
113