Import tc tests
[gitmo/Mouse.git] / t / 040_type_constraints / failing / 015_enum.t
CommitLineData
b2b106d7 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Test::More;
7
8use Scalar::Util ();
9
10use Mouse::Util::TypeConstraints;
11
12enum Letter => 'a'..'z', 'A'..'Z';
13enum Language => 'Perl 5', 'Perl 6', 'PASM', 'PIR'; # any others? ;)
14enum Metacharacter => ['*', '+', '?', '.', '|', '(', ')', '[', ']', '\\'];
15
16my @valid_letters = ('a'..'z', 'A'..'Z');
17
18my @invalid_letters = qw/ab abc abcd/;
19push @invalid_letters, qw/0 4 9 ~ @ $ %/;
20push @invalid_letters, qw/l33t st3v4n 3num/;
21
22my @valid_languages = ('Perl 5', 'Perl 6', 'PASM', 'PIR');
23my @invalid_languages = ('perl 5', 'Python', 'Ruby', 'Perl 666', 'PASM++');
24# note that "perl 5" is invalid because case now matters
25
26my @valid_metacharacters = (qw/* + ? . | ( ) [ ] /, '\\');
27my @invalid_metacharacters = qw/< > & % $ @ ! ~ `/;
28push @invalid_metacharacters, qw/.* fish(sticks)? atreides/;
29push @invalid_metacharacters, '^1?$|^(11+?)\1+$';
30
31plan tests => @valid_letters + @invalid_letters
32 + @valid_languages + @invalid_languages
33 + @valid_metacharacters + @invalid_metacharacters
34 + @valid_languages + 10;
35
36Mouse::Util::TypeConstraints->export_type_constraints_as_functions();
37
38ok(Letter($_), "'$_' is a letter") for @valid_letters;
39ok(!Letter($_), "'$_' is not a letter") for @invalid_letters;
40
41ok(Language($_), "'$_' is a language") for @valid_languages;
42ok(!Language($_), "'$_' is not a language") for @invalid_languages;
43
44ok(Metacharacter($_), "'$_' is a metacharacter") for @valid_metacharacters;
45ok(!Metacharacter($_), "'$_' is not a metacharacter")
46 for @invalid_metacharacters;
47
48# check anon enums
49
50my $anon_enum = enum \@valid_languages;
51isa_ok($anon_enum, 'Mouse::Meta::TypeConstraint');
52
53is($anon_enum->name, '__ANON__', '... got the right name');
54is($anon_enum->parent->name, 'Str', '... got the right parent name');
55
56ok($anon_enum->check($_), "'$_' is a language") for @valid_languages;
57
58
59ok( !$anon_enum->equals( enum [qw(foo bar)] ), "doesn't equal a diff enum" );
60ok( $anon_enum->equals( $anon_enum ), "equals itself" );
61ok( $anon_enum->equals( enum \@valid_languages ), "equals duplicate" );
62
63ok( !$anon_enum->is_subtype_of('Object'), 'enum not a subtype of Object');
64ok( !$anon_enum->is_a_type_of('Object'), 'enum not type of Object');
65
66ok( !$anon_enum->is_subtype_of('ThisTypeDoesNotExist'), 'enum not a subtype of nonexistant type');
67ok( !$anon_enum->is_a_type_of('ThisTypeDoesNotExist'), 'enum not type of nonexistant type');
68