From: Graham Knop Date: Fri, 1 Mar 2013 10:09:04 +0000 (-0500) Subject: allow non-ref defaults X-Git-Tag: v1.001000~17 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2a894d0c5d6add296846e53d37ec42661ec34ef5;p=gitmo%2FMoo.git allow non-ref defaults --- diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm index 3901043..3f2fa4a 100644 --- a/lib/Method/Generate/Accessor.pm +++ b/lib/Method/Generate/Accessor.pm @@ -60,10 +60,9 @@ sub generate_method { $spec->{trigger} = quote_sub('shift->_trigger_'.$name.'(@_)'); } - for my $setting (qw( default coerce )) { - next if !exists $spec->{$setting}; - my $value = $spec->{$setting}; - my $invalid = "Invalid $setting '" . overload::StrVal($value) + if (exists $spec->{coerce}) { + my $value = $spec->{coerce}; + my $invalid = "Invalid coerce '" . overload::StrVal($value) . "' for $into->$name - not a coderef"; die "$invalid or code-convertible object" unless ref $value and (ref $value eq 'CODE' or blessed($value)); @@ -71,6 +70,19 @@ sub generate_method { if !eval { \&$value }; } + if (exists $spec->{default}) { + my $value = $spec->{default}; + if (!defined $value || ref $value) { + my $invalid = "Invalid default '" . overload::StrVal($value) + . "' for $into->$name - not a coderef or non-ref"; + die "$invalid or code-convertible object" + unless ref $value and (ref $value eq 'CODE' or blessed($value)); + die "$invalid and could not be converted to a coderef: $@" + if !eval { \&$value }; + } + } + + my %methods; if (my $reader = $spec->{reader}) { if (our $CAN_HAZ_XS && $self->is_simple_get($name, $spec)) { @@ -254,9 +266,14 @@ sub _generate_use_default { sub _generate_get_default { my ($self, $me, $name, $spec) = @_; - $spec->{default} - ? $self->_generate_call_code($name, 'default', $me, $spec->{default}) - : "${me}->${\$spec->{builder}}" + if (exists $spec->{default}) { + ref $spec->{default} + ? $self->_generate_call_code($name, 'default', $me, $spec->{default}) + : perlstring $spec->{default}; + } + else { + "${me}->${\$spec->{builder}}" + } } sub generate_simple_get { diff --git a/t/accessor-default.t b/t/accessor-default.t index fd1108b..58eac3e 100644 --- a/t/accessor-default.t +++ b/t/accessor-default.t @@ -22,6 +22,7 @@ my $c_ran; sub _build_eight { {} } has nine => (is => 'lazy', coerce => sub { $c_ran = 1; $_[0] }); sub _build_nine { {} } + has ten => (is => 'lazy', default => 5 ); } sub check { @@ -54,4 +55,6 @@ $c_ran = 0; check nine => map Foo->new->nine, 1..2; ok($c_ran, 'coerce lazy default'); +is(Foo->new->ten, 5, 'non-ref default'); + done_testing; diff --git a/t/method-generate-accessor.t b/t/method-generate-accessor.t index 64dbfee..6da7e99 100644 --- a/t/method-generate-accessor.t +++ b/t/method-generate-accessor.t @@ -32,12 +32,18 @@ like( qr/Unknown is purple/, 'is purple rejected' ); -for my $setting (qw( default coerce )) { - like( - exception { $gen->generate_method('Foo' => 'four' => { is => 'ro', $setting => 5 }) }, - qr/Invalid $setting/, "$setting - scalar rejected" - ); +like( + exception { $gen->generate_method('Foo' => 'four' => { is => 'ro', coerce => 5 }) }, + qr/Invalid coerce/, "coerce - scalar rejected" +); +is( + exception { $gen->generate_method('Foo' => 'four' => { is => 'ro', default => 5 }) }, + undef, "default - non-ref scalar accepted" +); + + +for my $setting (qw( default coerce )) { like( exception { $gen->generate_method('Foo' => 'five' => { is => 'ro', $setting => [] }) }, qr/Invalid $setting/, "$setting - arrayref rejected"