From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sun, 7 Nov 2010 21:29:03 +0000 (+0000)
Subject: support for default at construction time
X-Git-Tag: 0.009001~57
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=649ac26439bb707eb25094d19ea056e2503356fe;p=gitmo%2FMoo.git

support for default at construction time
---

diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index 6a0326b..f922f9c 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -30,8 +30,8 @@ sub _generate_get {
   my $simple = $self->_generate_simple_get('$_[0]', $name);
   my ($lazy, $default, $builder) = @{$spec}{qw(lazy default builder)};
   return $simple unless $lazy and ($default or $builder);
-  'do { '.$self->_generate_default(
-    '$_[0]', $name, $default, $builder,
+  'do { '.$self->_generate_use_default(
+    '$_[0]', $name, $spec,
     $self->_generate_simple_has('$_[0]', $name),
   ).'; '.$simple.' }';
 }
@@ -41,17 +41,27 @@ sub _generate_simple_has {
   "exists ${me}->{${\perlstring $name}}";
 }
 
-sub _generate_default {
-  my ($self, $me, $name, $default, $builder, $test) = @_;
+sub generate_get_default {
+  my $self = shift;
+  local $self->{captures} = {};
+  my $code = $self->_generate_get_default(@_);
+  return ($code, $self->{captures});
+}
+
+sub _generate_use_default {
+  my ($self, $me, $name, $spec, $test) = @_;
   $self->_generate_simple_set(
-    $me, $name, (
-      $default
-        ? $self->_generate_call_code($name, 'default', $me, $default)
-        : "${me}->${builder}"
-    )
+    $me, $name, $self->_generate_get_default($me, $name, $spec)
   ).' unless '.$test;
 }
 
+sub _generate_get_default {
+  my ($self, $me, $name, $spec) = @_;
+  $spec->{default}
+    ? $self->_generate_call_code($name, 'default', $me, $spec->{default})
+    : "${me}->${\$spec->{builder}}"
+}
+
 sub generate_simple_get {
   shift->_generate_simple_get(@_);
 }
@@ -126,6 +136,13 @@ sub _generate_call_code {
   return "${cap_name}->(${values})";
 }
 
+sub generate_simple_set {
+  my $self = shift;
+  local $self->{captures} = {};
+  my $code = $self->_generate_simple_set(@_);
+  return ($code, $self->{captures});
+}
+
 sub _generate_simple_set {
   my ($self, $me, $name, $value) = @_;
   my $name_str = perlstring $name;
diff --git a/lib/Method/Generate/Constructor.pm b/lib/Method/Generate/Constructor.pm
index de3111f..d62545d 100644
--- a/lib/Method/Generate/Constructor.pm
+++ b/lib/Method/Generate/Constructor.pm
@@ -62,14 +62,14 @@ sub _assign_new {
   NAME: foreach my $name (sort keys %$spec) {
     my $attr_spec = $spec->{$name};
     next NAME unless defined(my $i = $attr_spec->{init_arg});
-    if ($attr_spec->{lazy}) {
+    if ($attr_spec->{lazy} or $attr_spec->{default} or $attr_spec->{builder}) {
       $test{$name} = $i;
       next NAME;
     }
     push @init, $i;
     push @slots, $name;
   }
-  return '' unless @init;
+  return '' unless @init or %test;
   join '', (
     @init
       ? '    @{$new}{qw('.join(' ',@slots).')}'
@@ -77,8 +77,35 @@ sub _assign_new {
       : ''
   ), map {
     my $arg_key = perlstring($test{$_});
-    "    \$new->{${\perlstring($_)}} = \$args->{$arg_key}\n"
-    ."      if exists \$args->{$arg_key};\n"
+    my $ag = $self->accessor_generator;
+    my $test = "exists \$args->{$arg_key}";
+    my $source = "\$args->{$arg_key}";
+    my $attr_spec = $spec->{$_};
+    my ($code, $add_captures);
+    if (!$attr_spec->{lazy} and
+          ($attr_spec->{default} or $attr_spec->{builder})) {
+      my $get_captures;
+      ($code, $add_captures) = $ag->generate_simple_set(
+        '$new', $_,
+        "(\n      ${test}\n        ? ${source}\n        : "
+          .do {
+            (my $get, $get_captures) = $ag->generate_get_default(
+              '$new', $_, $attr_spec
+            );
+            $get;
+          }
+          ."\n    )"
+      );
+      @{$add_captures}{keys %$get_captures} = values %$get_captures;
+      $code .= ";\n";
+    } else {
+      ($code, $add_captures) = $ag->generate_simple_set(
+        '$new', $_, "\$args->{$arg_key}"
+      );
+      $code .= " if ${test};\n";
+    }
+    @{$self->{captures}}{keys %$add_captures} = values %$add_captures;
+    '    '.$code;
   } sort keys %test;
 }
 
@@ -108,7 +135,12 @@ sub _check_isa {
       $name, "\$args->{${init_str}}", $isa
     );
     @{$captures}{keys %$add_captures} = values %$add_captures;
-    $check .= "    ${code} if exists \$args->{${init_str}};\n";
+    $check .= "    ${code}".(
+      (not($spec->{lazy}) and ($spec->{default} or $spec->{builder})
+        ? ";\n"
+        : "if exists \$args->{${init_str}};\n"
+      )
+    );
   }
   return $check;
 }
diff --git a/t/accessor-default.t b/t/accessor-default.t
index af6e448..80786d0 100644
--- a/t/accessor-default.t
+++ b/t/accessor-default.t
@@ -11,7 +11,7 @@ use Test::More;
   has two => (is => 'ro', lazy => 1, builder => '_build_two');
   sub _build_two { {} }
   has three => (is => 'ro', default => quote_sub q{ {} });
-  has four => (is => 'ro', default => '_build_four');
+  has four => (is => 'ro', builder => '_build_four');
   sub _build_four { {} }
 }
 
@@ -27,4 +27,8 @@ check one => map Foo->new->one, 1..2;
 
 check two => map Foo->new->two, 1..2;
 
+check three => map Foo->new->{three}, 1..2;
+
+check four => map Foo->new->{four}, 1..2;
+
 done_testing;