overload fix
Stevan Little [Thu, 6 Sep 2007 20:53:11 +0000 (20:53 +0000)]
lib/Moose/Meta/Attribute.pm
lib/Moose/Meta/Method/Accessor.pm
lib/Moose/Meta/Method/Constructor.pm
t/071_misc_attribute_tests.t

index f3d8967..35aef25 100644 (file)
@@ -240,7 +240,7 @@ sub initialize_instance_slot {
                            $type_constraint->name .
                            ") with '" . 
                            (defined $val 
-                               ? (overload::Overloaded($val) 
+                               ? (blessed($val) && overload::Overloaded($val) 
                                     ? overload::StrVal($val) 
                                     : $val) 
                                : 'undef') . 
@@ -277,7 +277,11 @@ sub set_value {
                . $type_constraint->name 
                . ") with " 
                . (defined($value) 
-                    ? ("'" . (overload::Overloaded($value) ? overload::StrVal($value) : $value) . "'") 
+                    ? ("'" . 
+                        (blessed($value) && overload::Overloaded($value) 
+                            ? overload::StrVal($value) 
+                            : $value) 
+                        . "'") 
                     : "undef")
           if defined($value);
     }
index 4a16288..6e7e71c 100644 (file)
@@ -114,11 +114,11 @@ sub _inline_check_constraint {
        
        return '' unless $attr->has_type_constraint;
        
-       return sprintf <<'EOF', $value, $value, $value, $value, $value, $value
+       return sprintf <<'EOF', $value, $value, $value, $value, $value, $value, $value
 defined($type_constraint->(%s))
        || confess "Attribute (" . $attr->name . ") does not pass the type constraint ("
        . $attr->type_constraint->name . ") with " 
-       . (defined(%s) ? (overload::Overloaded(%s) ? overload::StrVal(%s) : %s) : "undef")
+       . (defined(%s) ? (Scalar::Util::blessed(%s) && overload::Overloaded(%s) ? overload::StrVal(%s) : %s) : "undef")
   if defined(%s);
 EOF
 }
@@ -154,7 +154,7 @@ sub _inline_check_lazy {
                       : '') .
                '        (defined($type_constraint->($default)))' .
                '               || confess "Attribute (" . $attr->name . ") does not pass the type constraint ("' .
-               '               . $attr->type_constraint->name . ") with " . (defined($default) ? (overload::Overloaded($default) ? overload::StrVal($default) : $default) : "undef")' .               
+               '               . $attr->type_constraint->name . ") with " . (defined($default) ? (Scalar::Util::blessed($default) && overload::Overloaded($default) ? overload::StrVal($default) : $default) : "undef")' .               
                '          if defined($default);' .                     
                   '        $_[0]->{$attr_name} = $default; ' .
                   '    }' .
index 1fcc5ab..6ee165d 100644 (file)
@@ -203,7 +203,7 @@ sub _generate_type_constraint_check {
         'defined(' . $type_constraint_name . '->_compiled_type_constraint->(' . $value_name . '))'
        . "\n\t" . '|| confess "Attribute (' . $attr->name . ') does not pass the type constraint ('
         . $attr->type_constraint->name 
-        . ') with " . (defined(' . $value_name . ') ? (overload::Overloaded(' . $value_name . ') ? overload::StrVal(' . $value_name . ') : ' . $value_name . ') : "undef");'
+        . ') with " . (defined(' . $value_name . ') ? (Scalar::Util::blessed(' . $value_name . ') && overload::Overloaded(' . $value_name . ') ? overload::StrVal(' . $value_name . ') : ' . $value_name . ') : "undef");'
     );    
 }
 
index 79391d1..b123e0f 100644 (file)
@@ -3,11 +3,11 @@
 use strict;
 use warnings;
 
-use Test::More tests => 12;
+use Test::More tests => 14;
 use Test::Exception;
 
 BEGIN {
-    use_ok('Moose');           
+    use_ok('Moose');
 }
 
 {
@@ -17,18 +17,18 @@ BEGIN {
 
         has 'foo' => (
             documentation => q{
-                The 'foo' attribute is my favorite 
+                The 'foo' attribute is my favorite
                 attribute in the whole wide world.
             }
         );
     }
-    
+
     my $foo_attr = Test::Attribute::Inline::Documentation->meta->get_attribute('foo');
-    
+
     ok($foo_attr->has_documentation, '... the foo has docs');
     is($foo_attr->documentation,
             q{
-                The 'foo' attribute is my favorite 
+                The 'foo' attribute is my favorite
                 attribute in the whole wide world.
             },
     '... got the foo docs');
@@ -43,29 +43,29 @@ BEGIN {
         has 'bad_lazy_attr' => (
             is => 'rw',
             isa => 'ArrayRef',
-            lazy => 1, 
+            lazy => 1,
             default => sub { "test" },
         );
-        
+
         has 'good_lazy_attr' => (
             is => 'rw',
             isa => 'ArrayRef',
-            lazy => 1, 
+            lazy => 1,
             default => sub { [] },
-        );        
+        );
 
     }
 
     my $test = Test::For::Lazy::TypeConstraint->new;
     isa_ok($test, 'Test::For::Lazy::TypeConstraint');
-    
+
     dies_ok {
         $test->bad_lazy_attr;
     } '... this does not work';
-    
+
     lives_ok {
         $test->good_lazy_attr;
-    } '... this does not work';    
+    } '... this does not work';
 }
 
 {
@@ -76,13 +76,13 @@ BEGIN {
         has [qw(foo bar baz)] => (
             is => 'rw',
         );
-        
+
     }
 
     my $test = Test::Arrayref::Attributes->new;
     isa_ok($test, 'Test::Arrayref::Attributes');
     can_ok($test, qw(foo bar baz));
-    
+
 }
 
 {
@@ -95,13 +95,13 @@ BEGIN {
             isa     => 'Str',
             default => sub { return }
         );
-        
+
     }
 
     dies_ok {
         Test::UndefDefault::Attributes->new;
     } '... default must return a value which passes the type constraint';
-    
+
 }
 
 {
@@ -118,11 +118,29 @@ BEGIN {
     is($moose_obj->a_str( 'foobar' ), 'foobar', 'setter took string');
     ok($moose_obj, 'this is a *not* a string');
 
-    throws_ok { 
-        $moose_obj->a_str( $moose_obj ) 
+    throws_ok {
+        $moose_obj->a_str( $moose_obj )
     } qr/Attribute \(a_str\) does not pass the type constraint \(Str\) with OverloadedStr\=HASH\(.*?\)/, '... dies without overloading the string';
 
 }
 
+{
+    {
+        package OverloadBreaker;
+        use Moose;
+
+        has 'a_num' => ( isa => 'Int' , is => 'rw', default => 7.5 );
+    }
+
+    throws_ok {
+        OverloadBreaker->new;
+    } qr/Attribute \(a_num\) does not pass the type constraint \(Int\) with \'7\.5\'/, '... this doesnt trip overload to break anymore ';
+
+    lives_ok {
+        OverloadBreaker->new(a_num => 5);
+    } '... this works fine though';
+
+}
+