From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 8 Nov 2010 04:53:12 +0000 (+0000)
Subject: refactor constructor generation and test more complex cases
X-Git-Tag: 0.009001~53
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3a9a65a4ce52f0d4bcbd4121961bb271d1e63a09;p=gitmo%2FMoo.git

refactor constructor generation and test more complex cases
---

diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index f922f9c..79f2e91 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -25,6 +25,11 @@ sub generate_method {
   ;
 }
 
+sub is_simple_attribute {
+  my ($self, $name, $spec) = @_;
+  return !grep $spec->{$_}, qw(lazy default builder isa trigger);
+}
+
 sub _generate_get {
   my ($self, $name, $spec) = @_;
   my $simple = $self->_generate_simple_get('$_[0]', $name);
@@ -136,6 +141,68 @@ sub _generate_call_code {
   return "${cap_name}->(${values})";
 }
 
+sub generate_populate_set {
+  my $self = shift;
+  local $self->{captures} = {};
+  my $code = $self->_generate_populate_set(@_);
+  return ($code, $self->{captures});
+}
+
+sub _generate_populate_set {
+  my ($self, $me, $name, $spec, $source, $test) = @_;
+  if (!$spec->{lazy} and
+        ($spec->{default} or $spec->{builder})) {
+    my $get_indent = ' ' x ($spec->{isa} ? 6 : 4);
+    my $get_value = 
+      "(\n${get_indent}  ${test}\n${get_indent}   ? ${source}\n${get_indent}   : "
+        .$self->_generate_get_default(
+          '$new', $_, $spec
+        )
+        ."\n${get_indent})";
+    ($spec->{isa}
+      ? "    {\n      my \$value = ".$get_value.";\n      "
+	.$self->_generate_isa_check(
+	  $name, '$value', $spec->{isa}
+	).";\n"
+	.'      '.$self->_generate_simple_set($me, $name, '$value').";\n"
+	."    }\n"
+      : '    '.$self->_generate_simple_set($me, $name, $get_value).";\n"
+    )
+    .($spec->{trigger}
+      ? '    '
+	.$self->_generate_trigger(
+	  $name, $me, $self->_generate_simple_get($me, $name),
+	  $spec->{trigger}
+	)." if ${test};\n"
+      : ''
+    );
+  } else {
+    "    if (${test}) {\n"
+      .($spec->{isa}
+        ? "      "
+	  .$self->_generate_isa_check(
+	    $name, $source, $spec->{isa}
+	  ).";\n"
+        : ""
+      )
+      ."      ".$self->_generate_simple_set($me, $name, $source).";\n"
+      .($spec->{trigger}
+	? "      "
+	  .$self->_generate_trigger(
+	    $name, $me, $self->_generate_simple_get($me, $name),
+	    $spec->{trigger}
+	  ).";\n"
+	: ""
+      )
+      ."    }\n";
+  }
+}
+
+sub generate_multi_set {
+  my ($self, $me, $to_set, $from) = @_;
+  "\@{${me}}{qw(${\join ' ', @$to_set})} = $from";
+}
+
 sub generate_simple_set {
   my $self = shift;
   local $self->{captures} = {};
diff --git a/lib/Method/Generate/Constructor.pm b/lib/Method/Generate/Constructor.pm
index 0064eac..0ecf401 100644
--- a/lib/Method/Generate/Constructor.pm
+++ b/lib/Method/Generate/Constructor.pm
@@ -40,10 +40,8 @@ sub generate_method {
   my $body = '    my $class = shift;'."\n";
   $body .= $self->_generate_args;
   $body .= $self->_check_required($spec);
-  $body .= $self->_check_isa($spec);
   $body .= '    my $new = bless({}, $class);'."\n";
   $body .= $self->_assign_new($spec);
-  $body .= $self->_fire_triggers($spec);
   if ($into->can('BUILD')) {
     require Method::Generate::BuildAll;
     $body .= Method::Generate::BuildAll->new->buildall_body_for(
@@ -57,6 +55,12 @@ sub generate_method {
   ;
 }
 
+sub _cap_call {
+  my ($self, $code, $captures) = @_;
+  @{$self->{captures}}{keys %$captures} = values %$captures if $captures;
+  $code;
+}
+
 sub _generate_args {
   my ($self) = @_;
   q{    my $args = ref($_[0]) eq 'HASH' ? $_[0] : { @_ };}."\n";
@@ -65,10 +69,11 @@ sub _generate_args {
 sub _assign_new {
   my ($self, $spec) = @_;
   my (@init, @slots, %test);
+  my $ag = $self->accessor_generator;
   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} or $attr_spec->{default} or $attr_spec->{builder}) {
+    unless ($ag->is_simple_attribute($name, $attr_spec)) {
       $test{$name} = $i;
       next NAME;
     }
@@ -78,40 +83,18 @@ sub _assign_new {
   return '' unless @init or %test;
   join '', (
     @init
-      ? '    @{$new}{qw('.join(' ',@slots).')}'
-        .' = @{$args}{qw('.join(' ',@init).')};'."\n"
+      ? '    '.$self->_cap_call($ag->generate_multi_set(
+	  '$new', [ @slots ], '@{$args}{qw('.join(' ',@init).')}'
+	)).";\n"
       : ''
   ), map {
     my $arg_key = perlstring($test{$_});
-    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;
+    $self->_cap_call($ag->generate_populate_set(
+      '$new', $_, $attr_spec, $source, $test
+    ));
   } sort keys %test;
 }
 
diff --git a/t/accessor-mixed.t b/t/accessor-mixed.t
new file mode 100644
index 0000000..83bc7bc
--- /dev/null
+++ b/t/accessor-mixed.t
@@ -0,0 +1,50 @@
+use strictures 1;
+use Test::More;
+
+my @result;
+
+{
+  package Foo;
+
+  use Class::Tiny;
+
+  my @isa = (isa => sub { push @result, 'isa', $_[0] });
+  my @trigger = (trigger => sub { push @result, 'trigger', $_[1] });
+  sub _mkdefault {
+    my $val = shift;
+    (default => sub { push @result, 'default', $val; $val; })
+  }
+
+  has a1 => (
+    is => 'ro', @isa
+  );
+  has a2 => (
+    is => 'ro', @isa, @trigger
+  );
+  has a3 => (
+    is => 'ro', @isa, @trigger
+  );
+  has a4 => (
+    is => 'ro', @trigger, _mkdefault('a4')
+  );
+  has a5 => (
+    is => 'ro', @trigger, _mkdefault('a5')
+  );
+  has a6 => (
+    is => 'ro', @isa, @trigger, _mkdefault('a6')
+  );
+  has a7 => (
+    is => 'ro', @isa, @trigger, _mkdefault('a7')
+  );
+}
+
+my $foo = Foo->new(a1 => 'a1', a2 => 'a2', a4 => 'a4', a6 => 'a6');
+
+is_deeply(
+  \@result,
+  [ qw(isa a1 isa a2 trigger a2 trigger a4 default a5 isa a6 trigger a6
+    default a7 isa a7) ],
+  'Stuff fired in expected order'
+);
+
+done_testing;
diff --git a/t/method-generate-constructor.t b/t/method-generate-constructor.t
index 96d604c..db10020 100644
--- a/t/method-generate-constructor.t
+++ b/t/method-generate-constructor.t
@@ -3,8 +3,11 @@ use Test::More;
 use Test::Fatal;
 
 use Method::Generate::Constructor;
+use Method::Generate::Accessor;
 
-my $gen = Method::Generate::Constructor->new;
+my $gen = Method::Generate::Constructor->new(
+  accessor_generator => Method::Generate::Accessor->new
+);
 
 $gen->generate_method('Foo', 'new', {
   one => { },