From: gfx <gfuji@cpan.org>
Date: Wed, 30 Sep 2009 12:46:52 +0000 (+0900)
Subject: Copy two test files from Moose
X-Git-Tag: 0.37_01~14
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=62225dfe344ee4caa7706570303159a775c07273;p=gitmo%2FMouse.git

Copy two test files from Moose
---

diff --git a/t/040_type_constraints/015_enum.t b/t/040_type_constraints/015_enum.t
new file mode 100755
index 0000000..48bdca6
--- /dev/null
+++ b/t/040_type_constraints/015_enum.t
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use Scalar::Util ();
+
+use lib 't/lib';
+use Mouse::Util::TypeConstraints;
+use Test::Mouse; # for export_type_constraints_as_functions()
+
+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 = ('perl 5', 'Python', 'Ruby', 'Perl 666', 'PASM++');
+# note that "perl 5" is invalid because case now matters
+
+my @valid_metacharacters = (qw/* + ? . | ( ) [ ] /, '\\');
+my @invalid_metacharacters = qw/< > & % $ @ ! ~ `/;
+push @invalid_metacharacters, qw/.* fish(sticks)? atreides/;
+push @invalid_metacharacters, '^1?$|^(11+?)\1+$';
+
+Mouse::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;
+
+# check anon enums
+
+my $anon_enum = enum \@valid_languages;
+isa_ok($anon_enum, 'Mouse::Meta::TypeConstraint');
+
+#is($anon_enum->name, '__ANON__', '... got the right name');
+#is($anon_enum->parent->name, 'Str', '... got the right parent name');
+
+ok($anon_enum->check($_), "'$_' is a language") for @valid_languages;
+
+
+#ok( !$anon_enum->equals( enum [qw(foo bar)] ), "doesn't equal a diff enum" );
+#ok( $anon_enum->equals( $anon_enum ), "equals itself" );
+#ok( $anon_enum->equals( enum \@valid_languages ), "equals duplicate" );
+
+#ok( !$anon_enum->is_subtype_of('Object'), 'enum not a subtype of Object');
+ok( !$anon_enum->is_a_type_of('Object'), 'enum not type of Object');
+
+#ok( !$anon_enum->is_subtype_of('ThisTypeDoesNotExist'), 'enum not a subtype of nonexistant type');
+ok( !$anon_enum->is_a_type_of('ThisTypeDoesNotExist'), 'enum not type of nonexistant type');
+
diff --git a/t/040_type_constraints/025_type_coersion_on_lazy_attributes.t b/t/040_type_constraints/025_type_coersion_on_lazy_attributes.t
new file mode 100755
index 0000000..9400f1a
--- /dev/null
+++ b/t/040_type_constraints/025_type_coersion_on_lazy_attributes.t
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+{
+    package SomeClass;
+    use Mouse;
+    use Mouse::Util::TypeConstraints;
+
+    subtype 'DigitSix' => as 'Num'
+        => where { /^6$/ };
+    subtype 'TextSix' => as 'Str'
+        => where { /Six/i };
+
+    coerce 'TextSix'
+        => from 'DigitSix'
+        => via { confess("Cannot live without 6 ($_)") unless /^6$/; 'Six' };
+
+    has foo => (
+        is      => 'ro',
+        isa     => 'TextSix',
+        coerce  => 1,
+        default => 6,
+        lazy    => 1
+    );
+}
+
+is(SomeClass->new()->foo, 'Six');
+
+