From: Florian Ragwitz <rafl@debian.org>
Date: Thu, 25 Aug 2011 13:19:12 +0000 (+0200)
Subject: Fix duck_type constraint generators
X-Git-Tag: 2.0204~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=78a3757db6b8bc439db13dcaf0d916fc915e9df5;p=gitmo%2FMoose.git

Fix duck_type constraint generators

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.
---

diff --git a/Changes b/Changes
index ed69dc3..6a6d325 100644
--- 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)
+
 2.0203 Tue, Aug 23, 2011
 
   [BUG FIXES]
diff --git a/lib/Moose/Meta/TypeConstraint/DuckType.pm b/lib/Moose/Meta/TypeConstraint/DuckType.pm
index 8957156..a6b13b4 100644
--- a/lib/Moose/Meta/TypeConstraint/DuckType.pm
+++ b/lib/Moose/Meta/TypeConstraint/DuckType.pm
@@ -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;