From: Fuji, Goro <gfuji@cpan.org>
Date: Mon, 27 Sep 2010 03:07:48 +0000 (+0900)
Subject: Tweaks
X-Git-Tag: 0.75~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4b58033d236a709a6b3ce901f29f601801329476;p=gitmo%2FMouse.git

Tweaks
---

diff --git a/lib/Mouse/Meta/Method/Accessor.pm b/lib/Mouse/Meta/Method/Accessor.pm
index 2c5920a..5ed42f3 100644
--- a/lib/Mouse/Meta/Method/Accessor.pm
+++ b/lib/Mouse/Meta/Method/Accessor.pm
@@ -95,7 +95,6 @@ sub _generate_accessor_any{
         }
         elsif(defined $constraint){
             $accessor .= "my \$tmp = $value;\n";
-
             $accessor .= "\$compiled_type_constraint->(\$tmp)";
             $accessor .= " || \$attribute->_throw_type_constraint_error(\$tmp, \$constraint);\n";
             $accessor .= "$slot = \$tmp;\n";
diff --git a/lib/Mouse/Meta/TypeConstraint.pm b/lib/Mouse/Meta/TypeConstraint.pm
index f2319fa..6813d32 100644
--- a/lib/Mouse/Meta/TypeConstraint.pm
+++ b/lib/Mouse/Meta/TypeConstraint.pm
@@ -7,7 +7,7 @@ sub new {
 
     $args{name} = '__ANON__' if !defined $args{name};
 
-    if($args{parent}) {
+    if(defined $args{parent}) {
         %args = (%{$args{parent}}, %args);
         # a child type must not inherit 'compiled_type_constraint'
         # and 'hand_optimized_type_constraint' from the parent
@@ -71,6 +71,11 @@ sub compile_type_constraint;
 sub _add_type_coercions { # ($self, @pairs)
     my $self = shift;
 
+    if(exists $self->{type_constraints}){ # union type
+        $self->throw_error(
+            "Cannot add additional type coercions to Union types '$self'");
+    }
+
     my $coercions = ($self->{coercion_map} ||= []);
     my %has       = map{ $_->[0] => undef } @{$coercions};
 
@@ -89,14 +94,7 @@ sub _add_type_coercions { # ($self, @pairs)
         push @{$coercions}, [ $type => $action ];
     }
 
-    # compile
-    if(exists $self->{type_constraints}){ # union type
-        $self->throw_error(
-            "Cannot add additional type coercions to Union types");
-    }
-    else{
-        $self->_compile_type_coercion();
-    }
+    $self->_compile_type_coercion();
     return;
 }
 
@@ -143,14 +141,10 @@ sub _compile_union_type_coercion {
 
 sub coerce {
     my $self = shift;
-
-    my $coercion = $self->_compiled_type_coercion;
-    if(!$coercion){
-        $self->throw_error("Cannot coerce without a type coercion");
-    }
-
     return $_[0] if $self->check(@_);
 
+    my $coercion = $self->{_compiled_type_coercion}
+        or $self->throw_error("Cannot coerce without a type coercion");
     return  $coercion->(@_);
 }
 
@@ -171,7 +165,7 @@ sub get_message {
     }
 }
 
-sub is_a_type_of{
+sub is_a_type_of {
     my($self, $other) = @_;
 
     # ->is_a_type_of('__ANON__') is always false
diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm
index a5eab76..80756cd 100644
--- a/lib/Mouse/PurePerl.pm
+++ b/lib/Mouse/PurePerl.pm
@@ -144,14 +144,17 @@ sub Undef      { !defined($_[0]) }
 sub Defined    {  defined($_[0])  }
 sub Value      {  defined($_[0]) && !ref($_[0]) }
 sub Num        {  looks_like_number($_[0]) }
-sub Int        {
-    my($value) = @_;
-    looks_like_number($value) && $value =~ /\A [+-]? [0-9]+  \z/xms;
-}
 sub Str        {
+    # We need to use a copy here to flatten MAGICs, for instance as in
+    # Str( substr($_, 0, 42) ).
     my($value) = @_;
     return defined($value) && ref(\$value) eq 'SCALAR';
 }
+sub Int        {
+    # We need to use a copy here to save the original internal SV flags.
+    my($value) = @_;
+    return defined($value) && $value =~ /\A -? [0-9]+  \z/xms;
+}
 
 sub Ref        { ref($_[0]) }
 sub ScalarRef  {