Fix duck_type constraint generators
Florian Ragwitz [Thu, 25 Aug 2011 13:19:12 +0000 (15:19 +0200)]
Both the regular constraint closure and its inlined variant called
Scalar::Util::all assuming that $_[0] would point to the value to be validated
within the all {} block, which of course it doesn't.

I don't know how this ever worked.

Changes
lib/Moose/Meta/TypeConstraint/DuckType.pm

diff --git a/Changes b/Changes
index f53c14e..4739b2f 100644 (file)
--- a/Changes
+++ b/Changes
@@ -3,6 +3,12 @@ for, noteworthy changes.
 
 {{$NEXT}}
 
+  [BUG FIXES]
+
+  * Validating duck_type type constraint turned out to work only by accident,
+    and only when not running under the debugger. This has been fixed.
+    (Florian Ragwitz)
+
   [DEPRECATIONS]
 
   * The optimize_as option for type constraints has been deprecated. Use the
index 8957156..a6b13b4 100644 (file)
@@ -22,10 +22,10 @@ my $inliner = sub {
     my $self = shift;
     my $val  = shift;
 
-    return 'Scalar::Util::blessed(' . $val . ') '
-             . '&& Scalar::Util::blessed(' . $val . ') ne "Regexp" '
+    return 'my $val = ' . $val . '; Scalar::Util::blessed($val) '
+             . '&& Scalar::Util::blessed($val) ne "Regexp" '
              . '&& &List::MoreUtils::all('
-                 . 'sub { ' . $val . '->can($_) }, '
+                 . 'sub { $val->can($_) }, '
                  . join(', ', map { B::perlstring($_) } @{ $self->methods })
              . ')';
 };
@@ -38,8 +38,9 @@ sub new {
 
     my @methods = @{ $args{methods} };
     $args{constraint} = sub {
-        blessed( $_[0] ) ne 'Regexp'
-            && all { $_[0]->can($_) } @methods;
+        my $val = $_[0];
+        blessed($val) ne 'Regexp'
+            && all { $val->can($_) } @methods;
     };
 
     $args{inlined} = $inliner;