fixing stuff

diff --git a/Changes b/Changes
index fcbdf40..96bd331 100644 (file)
--- a/Changes
+++ b/Changes
@@ -10,6 +10,10 @@ Revision history for Perl extension Moose
 
     * Moose::Util::TypeConstraints
       - fix ClassName constraint to introspect symbol table (mst)
+        - added more tests for this (mst)
+      - fixed it so that subtype 'Foo' => as 'HashRef[Int]' ...
+        with work correctly.
+        - added tests for this
 
     * t/ 
       - New tests for builder bug. Upon instantiation, if an

diff --git a/MANIFEST b/MANIFEST
index 814f814..d43b1b1 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -106,6 +106,7 @@ t/040_type_constraints/012_container_type_coercion.t
 t/040_type_constraints/013_advanced_type_creation.t
 t/040_type_constraints/014_type_notation_parser.t
 t/040_type_constraints/015_enum.t
+t/040_type_constraints/016_subtyping_parameterized_types.t
 t/050_metaclasses/001_custom_attr_meta_with_roles.t
 t/050_metaclasses/002_custom_attr_meta_as_role.t
 t/050_metaclasses/003_moose_w_metaclass.t

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 149c81b..f144a57 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -9,7 +9,7 @@ use Scalar::Util 'blessed', 'reftype';
 use B            'svref_2object';
 use Sub::Exporter;
 
-our $VERSION   = '0.15';
+our $VERSION   = '0.16';
 our $AUTHORITY = 'cpan:STEVAN';
 
 ## --------------------------------------------------------
@@ -93,10 +93,10 @@ sub list_all_type_constraints            { keys %{$REGISTRY->type_constraints} }
 sub export_type_constraints_as_functions {
     my $pkg = caller();
     no strict 'refs';
-        foreach my $constraint (keys %{$REGISTRY->type_constraints}) {
-                *{"${pkg}::${constraint}"} = $REGISTRY->get_type_constraint($constraint)
-                                                      ->_compiled_type_constraint;
-        }
+    foreach my $constraint (keys %{$REGISTRY->type_constraints}) {
+        *{"${pkg}::${constraint}"} = $REGISTRY->get_type_constraint($constraint)
+                                              ->_compiled_type_constraint;
+    }
 }
 
 sub create_type_constraint_union (@) {
@@ -190,7 +190,7 @@ sub find_type_constraint ($) { $REGISTRY->get_type_constraint(@_) }
 
 sub type ($$;$$) {
     splice(@_, 1, 0, undef);
-        goto &_create_type_constraint;
+    goto &_create_type_constraint;
 }
 
 sub subtype ($$;$$$) {
@@ -203,8 +203,8 @@ sub subtype ($$;$$$) {
     #   subtype(MyNumbers => as Num); # now MyNumbers is the same as Num
     # ... yeah I know it's ugly code
     # - SL
-        unshift @_ => undef if scalar @_ <= 2 && (reftype($_[1]) || '') eq 'CODE';
-        goto &_create_type_constraint;
+    unshift @_ => undef if scalar @_ <= 2 && (reftype($_[1]) || '') eq 'CODE';
+    goto &_create_type_constraint;
 }
 
 sub coerce ($@) {
@@ -225,11 +225,11 @@ sub enum ($;@) {
     (scalar @values >= 2)
         || confess "You must have at least two values to enumerate through";
     my %valid = map { $_ => 1 } @values;
-        _create_type_constraint(
-            $type_name,
-            'Str',
-            sub { $valid{$_} }
-        );
+    _create_type_constraint(
+        $type_name,
+        'Str',
+        sub { $valid{$_} }
+    );
 }
 
 ## --------------------------------------------------------
@@ -259,7 +259,7 @@ sub _create_type_constraint ($$$;$$) {
                  if defined $type;
     }
 
-    $parent = $REGISTRY->get_type_constraint($parent) if defined $parent;
+    $parent = find_or_create_type_constraint($parent) if defined $parent;
 
     my $constraint = Moose::Meta::TypeConstraint->new(
         name               => $name || '__ANON__',

diff --git a/t/040_type_constraints/005_util_type_coercion.t b/t/040_type_constraints/005_util_type_coercion.t
index 4fb8c55..e631309 100644 (file)
--- a/t/040_type_constraints/005_util_type_coercion.t
+++ b/t/040_type_constraints/005_util_type_coercion.t
@@ -28,20 +28,6 @@ coerce Header
     => from HashRef 
         => via { HTTPHeader->new(hash => $_[0]) };
 
-
-{
-       package Math::BigFloat;
-       sub new { bless { }, shift }; # not a moose class ;-)
-}
-
-subtype "Math::BigFloat"
-       => as "Math::BigFloat"
-       => where { 1 };
-
-coerce "Math::BigFloat"
-       => from Num
-               => via { Math::BigFloat->new( $_ ) };
-
         
 Moose::Util::TypeConstraints->export_type_constraints_as_functions();        
         

diff --git a/t/040_type_constraints/016_subtyping_parameterized_types.t b/t/040_type_constraints/016_subtyping_parameterized_types.t
new file mode 100644 (file)
index 0000000..2462c14
--- /dev/null
+++ b/t/040_type_constraints/016_subtyping_parameterized_types.t
@@ -0,0 +1,58 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 18;
+use Test::Exception;
+
+BEGIN {
+    use_ok("Moose::Util::TypeConstraints");
+}
+
+lives_ok {
+    subtype 'MySpecialHash' => as 'HashRef[Int]';
+} '... created the subtype special okay';
+
+{
+    my $t = find_type_constraint('MySpecialHash');
+    isa_ok($t, 'Moose::Meta::TypeConstraint');
+
+    is($t->name, 'MySpecialHash', '... name is correct');
+
+    my $p = $t->parent;
+    isa_ok($p, 'Moose::Meta::TypeConstraint::Parameterized');
+    isa_ok($p, 'Moose::Meta::TypeConstraint');
+
+    is($p->name, 'HashRef[Int]', '... parent name is correct');
+
+    ok($t->check({ one => 1, two => 2 }), '... validated it correctly');
+    ok(!$t->check({ one => "ONE", two => "TWO" }), '... validated it correctly');
+}
+
+lives_ok {
+    subtype 'MySpecialHashExtended' 
+        => as 'HashRef[Int]'
+        => where {
+            # all values are less then 10
+            (scalar grep { $_ < 10 } values %{$_}) ? 1 : undef
+        };
+} '... created the subtype special okay';
+
+{
+    my $t = find_type_constraint('MySpecialHashExtended');
+    isa_ok($t, 'Moose::Meta::TypeConstraint');
+
+    is($t->name, 'MySpecialHashExtended', '... name is correct');
+
+    my $p = $t->parent;
+    isa_ok($p, 'Moose::Meta::TypeConstraint::Parameterized');
+    isa_ok($p, 'Moose::Meta::TypeConstraint');
+
+    is($p->name, 'HashRef[Int]', '... parent name is correct');
+
+    ok($t->check({ one => 1, two => 2 }), '... validated it correctly');
+    ok(!$t->check({ zero => 10, one => 11, two => 12 }), '... validated it correctly');
+    ok(!$t->check({ one => "ONE", two => "TWO" }), '... validated it correctly');
+}
+