diff -Nurp Mouse-0.97-ZRkQgT/MANIFEST Mouse-0.97-ZRkQgT-copy/MANIFEST
--- Mouse-0.97-ZRkQgT/MANIFEST 2011-10-03 17:11:08.000000000 -0700
+++ Mouse-0.97-ZRkQgT-copy/MANIFEST 2012-01-02 09:34:09.000000000 -0800
@@ -345,6 +345,7 @@ t/900_mouse_bugs/009_RT57144.t
t/900_mouse_bugs/010_use_mouse_before_tb2.t
t/900_mouse_bugs/011_RT61852.t
t/900_mouse_bugs/012_RT61906.t
+t/900_mouse_bugs/013_RT73592_tied_.t
t/990_deprecated/001-export_to_level.t
t/lib/Bar.pm
t/lib/Bar7/Meta/Trait.pm
diff -Nurp Mouse-0.97-ZRkQgT/lib/Mouse/Meta/TypeConstraint.pm Mouse-0.97-ZRkQgT-copy/lib/Mouse/Meta/TypeConstraint.pm
--- Mouse-0.97-ZRkQgT/lib/Mouse/Meta/TypeConstraint.pm 2011-10-09 14:46:03.000000000 -0700
+++ Mouse-0.97-ZRkQgT-copy/lib/Mouse/Meta/TypeConstraint.pm 2012-01-02 09:28:30.000000000 -0800
@@ -149,8 +149,7 @@ sub _compiled_type_coercion {
foreach my $pair (@coercions) {
#my ($constraint, $converter) = @$pair;
if ($pair->[0]->($thing)) {
- local $_ = $thing;
- return $pair->[1]->($thing);
+ return $pair->[1]->($thing) for $thing;
}
}
return $thing;
@@ -190,8 +189,7 @@ sub coerce {
sub get_message {
my ($self, $value) = @_;
if ( my $msg = $self->message ) {
- local $_ = $value;
- return $msg->($value);
+ return $msg->($value) for $value;
}
else {
if(not defined $value) {
diff -Nurp Mouse-0.97-ZRkQgT/lib/Mouse/PurePerl.pm Mouse-0.97-ZRkQgT-copy/lib/Mouse/PurePerl.pm
--- Mouse-0.97-ZRkQgT/lib/Mouse/PurePerl.pm 2011-10-09 14:46:03.000000000 -0700
+++ Mouse-0.97-ZRkQgT-copy/lib/Mouse/PurePerl.pm 2012-01-02 09:35:15.000000000 -0800
@@ -653,12 +653,13 @@ sub compile_type_constraint{
}
else{
$self->{compiled_type_constraint} = sub{
- my(@args) = @_;
- local $_ = $args[0];
+ my(@args) = @_;
+ for ($args[0]) {
foreach my $c(@checks){
return undef if !$c->(@args);
}
- return 1;
+ }
+ return 1;
};
}
return;
diff -Nurp Mouse-0.97-ZRkQgT/t/900_mouse_bugs/013_RT73592_tied_.t Mouse-0.97-ZRkQgT-copy/t/900_mouse_bugs/013_RT73592_tied_.t
--- Mouse-0.97-ZRkQgT/t/900_mouse_bugs/013_RT73592_tied_.t 1969-12-31 16:00:00.000000000 -0800
+++ Mouse-0.97-ZRkQgT-copy/t/900_mouse_bugs/013_RT73592_tied_.t 2012-01-02 09:35:31.000000000 -0800
@@ -0,0 +1,56 @@
+#!perl
+#
https://rt.cpan.org/Ticket/Display.html?id=73592
+use Test::More tests => 2;
+
+sub TIESCALAR { bless [] }
+# Load Carp before tying as it uses Exporter, and Exporter < 5.66 has the
+# local $_ bug.
+require Carp;
+eval { require Carp::Heavy };
+tie $_, "";
+
+{
+ package Human;
+
+ use Mouse;
+ use Mouse::Util::TypeConstraints;
+
+ coerce 'Human::EyeColor'
+ => from 'ArrayRef'
+ => via { return Human::EyeColor->new(); };
+
+ has 'eye_color' => (
+ is => 'ro',
+ isa => 'Human::EyeColor',
+ coerce => 1,
+ );
+
+ subtype 'NonemptyStr'
+ => as 'Str'
+ => where { length $_ }
+ => message { "The string is empty!" };
+
+ has name => (
+ is => 'ro',
+ isa => 'NonemptyStr',
+ );
+}
+
+{
+ package Human::EyeColor;
+
+ use Mouse;
+}
+
+ok eval {
+ my $person = Human->new(
+ eye_color => [ qw( blue blue blue blue ) ],
+ );
+ 1
+ }, 'coercion does not interfere with $_';
+
+eval {
+ my $person = Human->new(name => '');
+};
+like $@, qr/The string is empty/,
+ 'type constraint messages do not interfere with $_';
