AHHHHHHHHHHHH attic/Sub-Compose-test
Stevan Little [Thu, 2 Nov 2006 13:50:42 +0000 (13:50 +0000)]
benchmarks/type_constraints.pl
lib/Moose/Meta/TypeConstraint.pm
lib/Moose/Util/TypeConstraints.pm

index dcc15cd..eb3d509 100644 (file)
@@ -20,7 +20,6 @@ all vs. a custom-created type.
     
     has 'baz' => (is => 'rw');
     has 'bar' => (is => 'rw', isa => 'Foo');
-    has 'boo' => (is => 'rw', isa => type 'CustomFoo' => where { blessed($_) && $_->isa('Foo') });
 }
 
 my $foo = Foo->new;
@@ -33,9 +32,6 @@ cmpthese(200_000,
         'w_constraint' => sub {
             $foo->bar($foo);            
         },
-        'w_custom_constraint' => sub {
-            $foo->boo($foo);            
-        },        
     }
 );
 
index e67e6f3..eeb69e5 100644 (file)
@@ -1,4 +1,6 @@
 
+use lib '/Users/stevan/Projects/Moose-CPAN/Sub-Compose/Sub-Compose/lib';
+
 package Moose::Meta::TypeConstraint;
 
 use strict;
@@ -9,6 +11,8 @@ use Sub::Name    'subname';
 use Carp         'confess';
 use Scalar::Util 'blessed';
 
+use Sub::Compose::Composer;
+
 our $VERSION = '0.06';
 
 __PACKAGE__->meta->add_attribute('name'       => (reader => 'name'      ));
@@ -63,14 +67,26 @@ sub compile_type_constraint {
         my @parents = map { $_->constraint } $self->_collect_all_parents;
         # then we compile them to run without
         # having to recurse as we did before
-               $self->_compiled_type_constraint(subname $self->name => sub {                   
-                       local $_ = $_[0];
-            foreach my $parent (@parents) {
-                return undef unless $parent->($_[0]);
-            }
-                       return undef unless $check->($_[0]);
-                       1;
-               });        
+        
+        my $composer = Sub::Compose::Composer->new(@parents, $check);
+        my $str = $composer->conjoin_code_string(
+            prefix  => 'local $_ = $_[0]',
+            around  => [ '(', ')'],
+            postfix => ' || undef',        
+        );
+        #warn "Compiling " . $self->name . " from\n" . $str . "\n\n";
+        my $code = eval $str;
+        confess "Something went wrong when evaling : \n $str \n\n $@" if $@;
+        $self->_compiled_type_constraint(subname $self->name => $code);
+        
+               #$self->_compiled_type_constraint(subname $self->name => sub {                  
+               #       local $_ = $_[0];
+        #    foreach my $parent (@parents) {
+        #        return undef unless $parent->($_[0]);
+        #    }
+               #       return undef unless $check->($_[0]);
+               #       1;
+               #});        
                 
     }
     else {
index 3df5fba..3cf04f3 100644 (file)
@@ -173,7 +173,7 @@ subtype 'FileHandle' => as 'GlobRef' => where { Scalar::Util::openhandle($_) };
 
 # NOTE: 
 # blessed(qr/.../) returns true,.. how odd
-subtype 'Object' => as 'Ref' => where { blessed($_) && blessed($_) ne 'Regexp' };
+subtype 'Object' => as 'Ref' => where { Scalar::Util::blessed($_) && Scalar::Util::blessed($_) ne 'Regexp' };
 
 subtype 'Role' => as 'Object' => where { $_->can('does') };