t/type_constraints/enum.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   8
   9 use Scalar::Util ();
  10
  11 use Moose::Util::TypeConstraints;
  12
  13 enum Letter => 'a'..'z', 'A'..'Z';
  14 enum Language => 'Perl 5', 'Perl 6', 'PASM', 'PIR'; # any others? ;)
  15 enum Metacharacter => ['*', '+', '?', '.', '|', '(', ')', '[', ']', '\\'];
  16
  17 my @valid_letters = ('a'..'z', 'A'..'Z');
  18
  19 my @invalid_letters = qw/ab abc abcd/;
  20 push @invalid_letters, qw/0 4 9 ~ @ $ %/;
  21 push @invalid_letters, qw/l33t st3v4n 3num/;
  22
  23 my @valid_languages = ('Perl 5', 'Perl 6', 'PASM', 'PIR');
  24 my @invalid_languages = ('perl 5', 'Python', 'Ruby', 'Perl 666', 'PASM++');
  25 # note that "perl 5" is invalid because case now matters
  26
  27 my @valid_metacharacters = (qw/* + ? . | ( ) [ ] /, '\\');
  28 my @invalid_metacharacters = qw/< > & % $ @ ! ~ `/;
  29 push @invalid_metacharacters, qw/.* fish(sticks)? atreides/;
  30 push @invalid_metacharacters, '^1?$|^(11+?)\1+$';
  31
  32 Moose::Util::TypeConstraints->export_type_constraints_as_functions();
  33
  34 ok(Letter($_), "'$_' is a letter") for @valid_letters;
  35 ok(!Letter($_), "'$_' is not a letter") for @invalid_letters;
  36
  37 ok(Language($_), "'$_' is a language") for @valid_languages;
  38 ok(!Language($_), "'$_' is not a language") for @invalid_languages;
  39
  40 ok(Metacharacter($_), "'$_' is a metacharacter") for @valid_metacharacters;
  41 ok(!Metacharacter($_), "'$_' is not a metacharacter")
  42     for @invalid_metacharacters;
  43
  44 # check anon enums
  45
  46 my $anon_enum = enum \@valid_languages;
  47 isa_ok($anon_enum, 'Moose::Meta::TypeConstraint');
  48
  49 is($anon_enum->name, '__ANON__', '... got the right name');
  50 is($anon_enum->parent->name, 'Str', '... got the right parent name');
  51
  52 ok($anon_enum->check($_), "'$_' is a language") for @valid_languages;
  53
  54
  55 ok( !$anon_enum->equals( enum [qw(foo bar)] ), "doesn't equal a diff enum" );
  56 ok( $anon_enum->equals( $anon_enum ), "equals itself" );
  57 ok( $anon_enum->equals( enum \@valid_languages ), "equals duplicate" );
  58
  59 ok( !$anon_enum->is_subtype_of('Object'), 'enum not a subtype of Object');
  60 ok( !$anon_enum->is_a_type_of('Object'), 'enum not type of Object');
  61
  62 ok( !$anon_enum->is_subtype_of('ThisTypeDoesNotExist'), 'enum not a subtype of nonexistant type');
  63 ok( !$anon_enum->is_a_type_of('ThisTypeDoesNotExist'), 'enum not type of nonexistant type');
  64
  65 # validation
  66 like( exception { Moose::Meta::TypeConstraint::Enum->new(name => 'ZeroValues', values => []) }, qr/You must have at least one value to enumerate through/ );
  67
  68 is( exception { Moose::Meta::TypeConstraint::Enum->new(name => 'OneValue', values => [ 'a' ]) }, undef);
  69
  70 like( exception { Moose::Meta::TypeConstraint::Enum->new(name => 'ReferenceInEnum', values => [ 'a', {} ]) }, qr/Enum values must be strings, not 'HASH\(0x\w+\)'/ );
  71
  72 like( exception { Moose::Meta::TypeConstraint::Enum->new(name => 'UndefInEnum', values => [ 'a', undef ]) }, qr/Enum values must be strings, not undef/ );
  73
  74 like( exception {
  75     package Foo;
  76     use Moose;
  77     use Moose::Util::TypeConstraints;
  78
  79     has error => (
  80         is      => 'ro',
  81         isa     => enum ['a', 'aa', 'aaa'], # should be parenthesized!
  82         default => 'aa',
  83     );
  84 }, qr/enum called with an array reference and additional arguments\. Did you mean to parenthesize the enum call's parameters\?/ );
  85
  86
  87 done_testing;