Collapse magic lvalues in Str

Without this change, $object->str_attribute(substr($string,0,255))
will fail with a type constraint error.

diff --git a/Changes b/Changes
index cea646e..e6ded8e 100644 (file)
--- a/Changes
+++ b/Changes
@@ -4,6 +4,9 @@ for, noteworthy changes.
 0.94
     * Moose::Cookbook::Basics::Recipe4
       - Grammar error [rt.cpan.org #51791] (Amir E. Aharoni)
+    * Moose::Util::TypeConstraints
+      - Changed Str constraint to accept magic lvalue strings like one gets
+        from substr et al, again. (sorear)
 
 0.93 Thu, Nov 19, 2009
     * Moose::Object

diff --git a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm
index 1a82694..0fbd0ea 100644 (file)
--- a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm
@@ -14,7 +14,12 @@ sub Value { defined($_[0]) && !ref($_[0]) }
 
 sub Ref { ref($_[0]) }
 
-sub Str { defined($_[0]) && ref(\$_[0]) eq 'SCALAR' }
+# We need to use a temporary here to flatten LVALUEs, for instance as in
+# Str(substr($_,0,255)).
+sub Str {
+    my $value = $_[0];
+    defined($value) && ref(\$value) eq 'SCALAR'
+}
 
 sub Num { !ref($_[0]) && looks_like_number($_[0]) }
 

diff --git a/t/040_type_constraints/003_util_std_type_constraints.t b/t/040_type_constraints/003_util_std_type_constraints.t
index 7c3dae6..5f0e119 100644 (file)
--- a/t/040_type_constraints/003_util_std_type_constraints.t
+++ b/t/040_type_constraints/003_util_std_type_constraints.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 297;
+use Test::More tests => 298;
 use Test::Exception;
 
 use Scalar::Util ();
@@ -12,6 +12,8 @@ BEGIN {
     use_ok('Moose::Util::TypeConstraints');
 }
 
+my $STRING     = "foo";
+
 my $SCALAR_REF = \(my $var);
 
 no warnings 'once'; # << I *hates* that warning ...
@@ -169,6 +171,7 @@ ok(defined Str(0),                 '... Str accepts anything which is a Str');
 ok(defined Str(100),               '... Str accepts anything which is a Str');
 ok(defined Str(''),                '... Str accepts anything which is a Str');
 ok(defined Str('Foo'),             '... Str accepts anything which is a Str');
+ok(defined Str(substr($STRING,0,1)),'... Str accepts anything which is a Str');
 ok(!defined Str([]),               '... Str rejects anything which is not a Str');
 ok(!defined Str({}),               '... Str rejects anything which is not a Str');
 ok(!defined Str(sub {}),           '... Str rejects anything which is not a Str');