| Subject: | Attribute names with metacharacters broken |
Moose no longer supports attributes with metacharacter in their names,
because the generated error messages for type constraints and
constructors use the attribute name in an interpolated string.
This is a regression; Moose 0.63 did not have this bug.
The attached test fails on Moose-0.93 (latest stable).
The attached patch allows the test to work.
perl -v
This is perl, v5.10.0 built for i686-linux
uname -a
Linux my.hostname.com 2.6.18-53.1.13.el5PAE #1 SMP Mon Feb 11 13:42:05
EST 2008 i686 athlon i386 GNU/Linux
| Subject: | 11-at-attrs.t |
#!perl
use strict;
use warnings;
use Test::More tests => 17;
use Test::NoWarnings 'warnings', 'clear_warnings';
ok(1, 'heartbeat');
# Package with @atat attribute (attribute contains metacharacter)
eval <<'END_OF_CODE';
package AtAttrs;
use Moose;
has '@atat' => (reader => 'get_atat',
isa => 'Str', required => 1);
no Moose;
package main;
END_OF_CODE
;
ok(!$@, 'valid class with @atat attribute');
diag $@ if $@;
eval {
my $atat = AtAttrs->new( '@atat' => 'foobar');
isa_ok($atat, 'AtAttrs');
is($atat->get_atat, 'foobar', 'reader for attribute works');
};
ok(!$@, 'able to use attribute class');
diag $@ if $@;
# With immutable:
eval <<'END_OF_CODE';
package AtAttrsImmutable;
use Moose;
has '@atat' => (reader => 'get_atat',
isa => 'Str', required => 1);
no Moose;
AtAttrsImmutable->meta->make_immutable;
package main;
END_OF_CODE
;
ok(!$@, 'immutable class with @atat attribute');
diag $@ if $@;
eval {
my $atat2 = AtAttrsImmutable->new( '@atat' => 'barfoo');
isa_ok($atat2, 'AtAttrsImmutable');
is($atat2->get_atat, 'barfoo', 'reader for immutable attribute works');
};
ok(!$@, 'able to use immutable attribute class');
diag $@ if $@;
# With writable attribute
eval <<'END_OF_CODE';
package AtAttrsWritable;
use Moose;
has '@atat' => (reader => 'get_atat',
writer => 'set_atat',
isa => 'Str', required => 1);
no Moose;
package main;
END_OF_CODE
;
ok(!$@, 'valid class with writable @atat attribute');
diag $@ if $@;
eval {
my $atat3 = AtAttrsWritable->new( '@atat' => 'barfoo');
isa_ok($atat3, 'AtAttrsWritable');
is($atat3->get_atat, 'barfoo', 'reader for writable attribute works');
ok($atat3->set_atat('foobar'), 'writer for writable attribute works');
is($atat3->get_atat, 'foobar', 'correct value set for writable attribute');
};
ok(!$@, 'able to use writable attribute class');
diag $@ if $@;
my @warnings = warnings();
clear_warnings();
ok(! @warnings, 'no warnings');
diag $_->getMessage for @warnings;
| Subject: | Moose-0.93.patch |
--- /sources/Moose-0.93/lib/Moose/Meta/Method/Accessor.pm 2009-11-18 16:11:43.000000000 -0800
+++ Moose/Meta/Method/Accessor.pm 2010-01-15 11:49:56.000000000 -0800
@@ -135,7 +135,7 @@
my $type_constraint_name = $attr->type_constraint->name;
- qq{\$type_constraint->($value) || } . $self->_inline_throw_error(qq{"Attribute ($attr_name) does not pass the type constraint because: " . \$type_constraint_obj->get_message($value)}, "data => $value") . ";";
+ qq{\$type_constraint->($value) || } . $self->_inline_throw_error(qq{'Attribute ($attr_name) does not pass the type constraint because: ' . \$type_constraint_obj->get_message($value)}, "data => $value") . ";";
}
sub _inline_check_coercion {
@@ -154,7 +154,7 @@
my $attr_name = $attr->name;
return '' unless $attr->is_required;
- return qq{(\@_ >= 2) || } . $self->_inline_throw_error(qq{"Attribute ($attr_name) is required, so cannot be set to undef"}) . ';' # defined $_[1] is not good enough
+ return qq{(\@_ >= 2) || } . $self->_inline_throw_error(qq{'Attribute ($attr_name) is required, so cannot be set to undef'}) . ';' # defined $_[1] is not good enough
}
sub _inline_check_lazy {
--- /sources/Moose-0.93/lib/Moose/Meta/Method/Constructor.pm 2009-11-18 16:11:43.000000000 -0800
+++ Moose/Meta/Method/Constructor.pm 2010-01-15 11:45:47.000000000 -0800
@@ -199,7 +199,7 @@
if ($is_moose && defined($attr->init_arg) && $attr->is_required && !$attr->has_default && !$attr->has_builder) {
push @source => ('(exists $params->{\'' . $attr->init_arg . '\'}) ' .
- '|| ' . $self->_inline_throw_error('"Attribute (' . $attr->name . ') is required"') .';');
+ '|| ' . $self->_inline_throw_error('\'Attribute (' . $attr->name . ') is required\'') .';');
}
if (($attr->has_default || $attr->has_builder) && !($is_moose && $attr->is_lazy)) {
@@ -325,9 +325,9 @@
sub _generate_type_constraint_check {
my ($self, $attr, $type_constraint_cv, $type_constraint_obj, $value_name) = @_;
return (
- $self->_inline_throw_error('"Attribute (' # FIXME add 'dad'
+ $self->_inline_throw_error('\'Attribute (' # FIXME add 'dad'
. $attr->name
- . ') does not pass the type constraint because: " . '
+ . ') does not pass the type constraint because: \' . '
. $type_constraint_obj . '->get_message(' . $value_name . ')')
. "\n\t unless " . $type_constraint_cv . '->(' . $value_name . ');'
);