Squashed commit of the following:

commit 0d0fc578def25e8c4d83a911fac0f285b9fe4687
Author: Jesse Luehrs <doy@tozt.net>
Date:   Mon Jul 5 16:30:32 2010 -0500

    changelog

commit a1935c6559b2b82b1a54fc23230d5fb066774715
Author: Jesse Luehrs <doy@tozt.net>
Date:   Mon Jul 5 19:29:48 2010 -0500

    just use cmop's _generate_default_value

commit 33399a9225667fb68364acf6b9a1badb744c1435
Author: Jesse Luehrs <doy@tozt.net>
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 <vanstyn@intellitree.com>
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 <doy@tozt.net>
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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
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 (executable)
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;