From: Dave Rolsky Date: Mon, 26 Jul 2010 17:53:55 +0000 (-0500) Subject: Squashed commit of the following: X-Git-Tag: 1.10~28 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=47bfa72ec1063777f444c2146171592347b198f3;p=gitmo%2FMoose.git Squashed commit of the following: commit 0d0fc578def25e8c4d83a911fac0f285b9fe4687 Author: Jesse Luehrs Date: Mon Jul 5 16:30:32 2010 -0500 changelog commit a1935c6559b2b82b1a54fc23230d5fb066774715 Author: Jesse Luehrs Date: Mon Jul 5 19:29:48 2010 -0500 just use cmop's _generate_default_value commit 33399a9225667fb68364acf6b9a1badb744c1435 Author: Jesse Luehrs Date: Mon Jul 5 02:07:21 2010 -0500 avoid converting ints to strings when validating the Int tc commit 6012070770f47ba52cf7177a69c4e0bf4a1320af Author: Henry Van Styn Date: Mon Jul 5 02:57:28 2010 -0400 don't stringify numeric defaults in the inlined codepath added extra check in Moose::Meta::Method::Constructor::_generate_default_value to return the raw default value if it passes looks_like_number($attr->default). This fixes the bug where non-lazy attributes with defaults set to numbers would be returned as a string instead of a number (i.e. attribute with default => 100 would be returned as "100" instead of 100) commit d1939fbdc40718a351c02435ca2766c058273c23 Author: Jesse Luehrs Date: Mon Jul 5 00:22:19 2010 -0500 failing test for attributes with numeric defaults during immutability --- diff --git a/Changes b/Changes index 77489df..7163ac1 100644 --- a/Changes +++ b/Changes @@ -48,6 +48,10 @@ for, noteworthy changes. * Attributes now warn if their accessors overwrite a locally defined function (not just method). (doy) + * Inlined code no longer stringifies numeric attribute defaults (vg, doy). + + * default => undef now works properly (doy). + [OTHER] * Bump our required perl version to 5.8.3, since earlier versions fail tests diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm index 6cb093b..1082e7b 100644 --- a/lib/Moose/Meta/Method/Constructor.pm +++ b/lib/Moose/Meta/Method/Constructor.pm @@ -95,11 +95,14 @@ sub _initialize_body { defined $_ ? $_->_compiled_type_constraint : undef; } @type_constraints; + my $defaults = [map { $_->default } @$attrs]; + my ( $code, $e ) = $self->_compile_code( code => $source, environment => { '$meta' => \$self, '$attrs' => \$attrs, + '$defaults' => \$defaults, '@type_constraints' => \@type_constraints, '@type_constraint_bodies' => \@type_constraint_bodies, }, @@ -340,22 +343,6 @@ sub _generate_type_constraint_check { ); } -sub _generate_default_value { - my ($self, $attr, $index) = @_; - # NOTE: - # default values can either be CODE refs - # in which case we need to call them. Or - # they can be scalars (strings/numbers) - # in which case we can just deal with them - # in the code we eval. - if ($attr->is_default_a_coderef) { - return '$attrs->[' . $index . ']->default($instance)'; - } - else { - return q{"} . quotemeta( $attr->default ) . q{"}; - } -} - 1; __END__ diff --git a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm index 386d5ef..91b1b0c 100644 --- a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm +++ b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm @@ -24,7 +24,12 @@ sub Str { sub Num { !ref($_[0]) && looks_like_number($_[0]) } -sub Int { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ } +# using a temporary here because regex matching promotes an IV to a PV, +# and that confuses some things (like JSON.pm) +sub Int { + my $value = $_[0]; + defined($value) && !ref($value) && $value =~ /^-?[0-9]+$/ +} sub ScalarRef { ref($_[0]) eq 'SCALAR' || ref($_[0]) eq 'REF' } sub ArrayRef { ref($_[0]) eq 'ARRAY' } diff --git a/t/020_attributes/034_numeric_defaults.t b/t/020_attributes/034_numeric_defaults.t new file mode 100755 index 0000000..e52f47e --- /dev/null +++ b/t/020_attributes/034_numeric_defaults.t @@ -0,0 +1,128 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Moose; +use B; + +{ + package Foo; + use Moose; + + has foo => (is => 'ro', default => 100); + + sub bar { 100 } +} + +with_immutable { + my $foo = Foo->new; + for my $meth (qw(foo bar)) { + my $val = $foo->$meth; + my $b = B::svref_2object(\$val); + my $flags = $b->FLAGS; + ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int"); + ok(!($flags & B::SVf_POK), "not a string"); + } +} 'Foo'; + +{ + package Bar; + use Moose; + + has foo => (is => 'ro', lazy => 1, default => 100); + + sub bar { 100 } +} + +with_immutable { + my $bar = Bar->new; + for my $meth (qw(foo bar)) { + my $val = $bar->$meth; + my $b = B::svref_2object(\$val); + my $flags = $b->FLAGS; + ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int"); + ok(!($flags & B::SVf_POK), "not a string"); + } +} 'Bar'; + +{ + package Baz; + use Moose; + + has foo => (is => 'ro', isa => 'Int', lazy => 1, default => 100); + + sub bar { 100 } +} + +with_immutable { + my $baz = Baz->new; + for my $meth (qw(foo bar)) { + my $val = $baz->$meth; + my $b = B::svref_2object(\$val); + my $flags = $b->FLAGS; + ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int"); + ok(!($flags & B::SVf_POK), "not a string"); + } +} 'Baz'; + +{ + package Foo2; + use Moose; + + has foo => (is => 'ro', default => 10.5); + + sub bar { 10.5 } +} + +with_immutable { + my $foo2 = Foo2->new; + for my $meth (qw(foo bar)) { + my $val = $foo2->$meth; + my $b = B::svref_2object(\$val); + my $flags = $b->FLAGS; + ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num"); + ok(!($flags & B::SVf_POK), "not a string"); + } +} 'Foo2'; + +{ + package Bar2; + use Moose; + + has foo => (is => 'ro', lazy => 1, default => 10.5); + + sub bar { 10.5 } +} + +with_immutable { + my $bar2 = Bar2->new; + for my $meth (qw(foo bar)) { + my $val = $bar2->$meth; + my $b = B::svref_2object(\$val); + my $flags = $b->FLAGS; + ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num"); + ok(!($flags & B::SVf_POK), "not a string"); + } +} 'Bar2'; + +{ + package Baz2; + use Moose; + + has foo => (is => 'ro', isa => 'Num', lazy => 1, default => 10.5); + + sub bar { 10.5 } +} + +with_immutable { + my $baz2 = Baz2->new; + for my $meth (qw(foo bar)) { + my $val = $baz2->$meth; + my $b = B::svref_2object(\$val); + my $flags = $b->FLAGS; + ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num"); + ok(!($flags & B::SVf_POK), "not a string"); + } +} 'Baz2'; + +done_testing; diff --git a/t/020_attributes/035_default_undef.t b/t/020_attributes/035_default_undef.t new file mode 100755 index 0000000..fcd8174 --- /dev/null +++ b/t/020_attributes/035_default_undef.t @@ -0,0 +1,24 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Moose; + +{ + package Foo; + use Moose; + + has foo => ( + is => 'ro', + isa => 'Maybe[Int]', + default => undef, + predicate => 'has_foo', + ); +} + +with_immutable { + is(Foo->new->foo, undef); + ok(Foo->new->has_foo); +} 'Foo'; + +done_testing;