From: Yuval Kogman Date: Tue, 3 Jun 2008 17:19:42 +0000 (+0000) Subject: Fix Evan's required/writer/accessor bug X-Git-Tag: 0_55~126 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b6af66f87bc717379256caa495a1c5223c524431;p=gitmo%2FMoose.git Fix Evan's required/writer/accessor bug --- diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index a2bbfdb..6759ec9 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -390,13 +390,13 @@ sub _set_initial_slot_value { } sub set_value { - my ($self, $instance, $value) = @_; + my ($self, $instance, @args) = @_; + my $value = $args[0]; my $attr_name = $self->name; - if ($self->is_required) { - defined($value) - || confess "Attribute ($attr_name) is required, so cannot be set to undef"; + if ($self->is_required and not @args) { + confess "Attribute ($attr_name) is required"; } if ($self->has_type_constraint) { diff --git a/lib/Moose/Meta/Method/Accessor.pm b/lib/Moose/Meta/Method/Accessor.pm index e429d99..455cec0 100644 --- a/lib/Moose/Meta/Method/Accessor.pm +++ b/lib/Moose/Meta/Method/Accessor.pm @@ -145,7 +145,7 @@ sub _inline_check_required { my $attr_name = $attr->name; return '' unless $attr->is_required; - return qq{defined(\$_[1]) || confess "Attribute ($attr_name) is required, so cannot be set to undef";} + return qq{(\@_ >= 2) || confess "Attribute ($attr_name) is required, so cannot be set to undef";} # defined $_[1] is not good enough } sub _inline_check_lazy { diff --git a/t/020_attributes/002_attribute_writer_generation.t b/t/020_attributes/002_attribute_writer_generation.t index 8b5e0e2..e803775 100644 --- a/t/020_attributes/002_attribute_writer_generation.t +++ b/t/020_attributes/002_attribute_writer_generation.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 29; +use Test::More tests => 30; use Test::Exception; use Scalar::Util 'isweak'; @@ -81,8 +81,12 @@ BEGIN { is($foo->get_foo_required(), 100, '... got the correct set value'); dies_ok { + $foo->set_foo_required(); + } '... set_foo_required died successfully with no value'; + + lives_ok { $foo->set_foo_required(undef); - } '... set_foo_required died successfully'; + } '... set_foo_required did accept undef'; ok(!isweak($foo->{foo_required}), '... it is not a weak reference'); diff --git a/t/020_attributes/003_attribute_accessor_generation.t b/t/020_attributes/003_attribute_accessor_generation.t index 1a24860..d8b3638 100644 --- a/t/020_attributes/003_attribute_accessor_generation.t +++ b/t/020_attributes/003_attribute_accessor_generation.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 57; +use Test::More tests => 58; use Test::Exception; use Scalar::Util 'isweak'; @@ -113,9 +113,11 @@ BEGIN { } '... foo_required wrote successfully'; is($foo->foo_required(), 100, '... got the correct set value'); - dies_ok { + lives_ok { $foo->foo_required(undef); - } '... foo_required died successfully'; + } '... foo_required did not die with undef'; + + is($foo->foo_required, undef, "value is undef"); ok(!isweak($foo->{foo_required}), '... it is not a weak reference');