From: gfx <gfuji@cpan.org>
Date: Thu, 24 Sep 2009 02:36:29 +0000 (+0900)
Subject: Move features used only for testing to t/lib/Test/Mouse.pm
X-Git-Tag: 0.35~33^2~8
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=993e62a7ae7e1e7711e8f603e69641bd131c47ff;p=gitmo%2FMouse.git

Move features used only for testing to t/lib/Test/Mouse.pm
---

diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm
index adda8f1..9755115 100644
--- a/lib/Mouse/Util/TypeConstraints.pm
+++ b/lib/Mouse/Util/TypeConstraints.pm
@@ -32,21 +32,8 @@ sub message (&) {
 sub from    { @_ }
 sub via (&) { $_[0] }
 
-sub export_type_constraints_as_functions {
-    my $into = caller;
-
-    foreach my $constraint ( values %TYPE ) {
-        my $tc = $constraint->{_compiled_type_constraint};
-        my $as = $into . '::' . $constraint->{name};
-
-        no strict 'refs';
-        *{$as} = sub{ &{$tc} || undef };
-    }
-    return;
-}
-
 BEGIN {
-    %TYPE = (
+    my %builtins = (
         Any        => sub { 1 },
         Item       => sub { 1 },
 
@@ -77,7 +64,8 @@ BEGIN {
         ClassName  => sub { Mouse::Util::is_class_loaded($_[0]) },
         RoleName   => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') },
     );
-    while (my ($name, $code) = each %TYPE) {
+
+    while (my ($name, $code) = each %builtins) {
         $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
             name                      => $name,
             _compiled_type_constraint => $code,
@@ -87,8 +75,10 @@ BEGIN {
 
     sub optimized_constraints { \%TYPE }
 
-    my @TYPE_KEYS = keys %TYPE;
-    sub list_all_builtin_type_constraints { @TYPE_KEYS }
+    my @builtins = keys %TYPE;
+    sub list_all_builtin_type_constraints { @builtins }
+
+    sub list_all_type_constraints         { keys %TYPE }
 }
 
 sub type {
@@ -361,8 +351,13 @@ sub _build_type_constraint {
 }
 
 sub find_type_constraint {
-    my $type_constraint = shift;
-    return $TYPE{$type_constraint};
+    my($type) = @_;
+    if(blessed($type) && $type->isa('Mouse::Meta::TypeConstraint')){
+        return $type;
+    }
+    else{
+        return $TYPE{$type};
+    }
 }
 
 sub find_or_create_isa_type_constraint {
diff --git a/t/040_type_constraints/003_util_std_type_constraints.t b/t/040_type_constraints/003_util_std_type_constraints.t
index f0a77ce..6340227 100644
--- a/t/040_type_constraints/003_util_std_type_constraints.t
+++ b/t/040_type_constraints/003_util_std_type_constraints.t
@@ -1,11 +1,14 @@
 #!/usr/bin/perl
 
+use lib 't/lib';
 use strict;
 use warnings;
 
 use Test::More tests => 277;
 use Test::Exception;
 
+use Test::Mouse;
+
 use Scalar::Util ();
 
 BEGIN {
diff --git a/t/lib/Test/Mouse.pm b/t/lib/Test/Mouse.pm
index c166c7b..a538ec3 100644
--- a/t/lib/Test/Mouse.pm
+++ b/t/lib/Test/Mouse.pm
@@ -53,6 +53,25 @@ sub has_attribute_ok ($$;$) {
     }
 }
 
+# Moose compatible methods/functions
+
+package Mouse::Util::TypeConstraints;
+
+use Mouse::Util::TypeConstraints ();
+
+sub export_type_constraints_as_functions { # TEST ONLY
+    my $into = caller;
+
+    foreach my $type( list_all_type_constraints() ) {
+        my $tc = find_type_constraint($type)->{_compiled_type_constraint};
+        my $as = $into . '::' . $type;
+
+        no strict 'refs';
+        *{$as} = sub{ &{$tc} || undef };
+    }
+    return;
+}
+
 1;
 
 __END__