Permalink
Browse files

fixing stuff

  • Loading branch information...
1 parent 0e0709e commit a0f8153dc5f0032469d14b8f96ba0a7be56839e3 Stevan Little committed Nov 23, 2007
View
@@ -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
View
@@ -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
@@ -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__',
@@ -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();
@@ -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');
+}
+

0 comments on commit a0f8153

Please sign in to comment.