From: Shawn M Moore Date: Sun, 21 Oct 2007 04:11:55 +0000 (+0000) Subject: Add tests for enum X-Git-Tag: 0_27~16 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c4fe165f59754f765c60f046d084049005550fd8;p=gitmo%2FMoose.git Add tests for enum Switch to using a hash which is certainly faster and actually works The regex was broken in a few ways: improper anchoring, no escaping of metachars --- diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index e160ee3..156d4c6 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -224,11 +224,11 @@ sub enum ($;@) { my ($type_name, @values) = @_; (scalar @values >= 2) || confess "You must have at least two values to enumerate through"; - my $regexp = join '|' => @values; + my %valid = map { $_ => 1 } @values; _create_type_constraint( $type_name, 'Str', - sub { qr/^$regexp$/i } + sub { $valid{$_} } ); } diff --git a/t/040_type_constraints/015_enum.t b/t/040_type_constraints/015_enum.t new file mode 100644 index 0000000..28e73d9 --- /dev/null +++ b/t/040_type_constraints/015_enum.t @@ -0,0 +1,43 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 97; + +use Scalar::Util (); + +BEGIN { + use_ok('Moose::Util::TypeConstraints'); +} + +enum Letter => 'a'..'z', 'A'..'Z'; +enum Language => 'Perl 5', 'Perl 6', 'PASM', 'PIR'; # any others? ;) +enum Metacharacter => '*', '+', '?', '.', '|', '(', ')', '[', ']', '\\'; + +my @valid_letters = ('a'..'z', 'A'..'Z'); + +my @invalid_letters = qw/ab abc abcd/; +push @invalid_letters, qw/0 4 9 ~ @ $ %/; +push @invalid_letters, qw/l33t st3v4n 3num/; + +my @valid_languages = ('Perl 5', 'Perl 6', 'PASM', 'PIR'); +my @invalid_languages = ('Python', 'Ruby', 'Perl 666', 'PASM++'); + +my @valid_metacharacters = (qw/* + ? . | ( ) [ ] /, '\\'); +my @invalid_metacharacters = qw/< > & % $ @ ! ~ `/; +push @invalid_metacharacters, qw/.* fish(sticks)? atreides/; +push @invalid_metacharacters, '^1?$|^(11+?)\1+$'; + +Moose::Util::TypeConstraints->export_type_constraints_as_functions(); + +ok(Letter($_), "'$_' is a letter") for @valid_letters; +ok(!Letter($_), "'$_' is not a letter") for @invalid_letters; + +ok(Language($_), "'$_' is a language") for @valid_languages; +ok(!Language($_), "'$_' is not a language") for @invalid_languages; + +ok(Metacharacter($_), "'$_' is a metacharacter") for @valid_metacharacters; +ok(!Metacharacter($_), "'$_' is not a metacharacter") + for @invalid_metacharacters; +