[libclass-tiny-perl] 06/11: Add support for __no_BUILD__ constructor argument

[gregor herrmann]

This is an automated email from the git hooks/post-receive script.

gregoa pushed a commit to annotated tag release-1.000
in repository libclass-tiny-perl.

commit a954d9529115dde0393e794b85bf5f225ae5d8a0
Author: David Golden <dagolden at cpan.org>
Date:   Tue Jul 15 17:33:18 2014 -0400

    Add support for __no_BUILD__ constructor argument
    
    When Moo or Moose (or other frameworks) subclass a Class::Tiny class,
    they want to be able to delegate construction but control the BUILD
    calls themselves.  The "__no_BUILD__" argument is an agreed convention
    that indicates that the constructor must not run BUILD, as the caller
    is taking responsibility for doing so later.
---
 lib/Class/Tiny.pm |  5 +++--
 t/delta.t         | 11 ++++++++---
 t/lib/Delta.pm    |  4 ++--
 3 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm
index 841436a..ac7eb36 100644
--- a/lib/Class/Tiny.pm
+++ b/lib/Class/Tiny.pm
@@ -114,9 +114,10 @@ sub new {
         Carp::croak("$class->new() got an odd number of elements");
     }
 
-    # create object and invoke BUILD
+    # create object and invoke BUILD (unless we were given __no_BUILD__)
+    my $no_build = delete $args->{__no_BUILD__};
     my $self = bless {%$args}, $class;
-    for my $s ( reverse @$linear_isa ) {
+    for my $s ( $no_build ? () : reverse @$linear_isa ) {
         next unless my $builder = $BUILD_CACHE{$s};
         $builder->( $self, $args );
     }
diff --git a/t/delta.t b/t/delta.t
index e3e37c0..26e5e3e 100644
--- a/t/delta.t
+++ b/t/delta.t
@@ -16,9 +16,14 @@ subtest "attribute set as list" => sub {
 
 subtest "hiding constructor argument" => sub {
     my $obj = new_ok( "Delta", [ foo => 42, bar => 23, hide_me => 1 ] );
-    is( $obj->foo, 42, "foo is set" );
-    is( $obj->bar, 23, "bar is set" );
-    is( $obj->{hide_me}, 1, "hidden constructor argument still in object" );
+    is( $obj->foo,       42, "foo is set" );
+    is( $obj->bar,       23, "bar is set" );
+    is( $obj->{hide_me}, 1,  "hidden constructor argument still in object" );
+};
+
+subtest "__no_BUILD__" => sub {
+    my $obj = new_ok( "Delta", [ __no_BUILD__ => 1 ], "new( __no_BUILD__ => 1 )" );
+    is( $Delta::counter, 0, "BUILD method didn't run" );
 };
 
 subtest "destructor" => sub {
diff --git a/t/lib/Delta.pm b/t/lib/Delta.pm
index 7577f76..6dd2837 100644
--- a/t/lib/Delta.pm
+++ b/t/lib/Delta.pm
@@ -4,7 +4,7 @@ use warnings;
 
 package Delta;
 
-our $counter = 0;
+our $counter   = 0;
 our $exception = 0;
 
 use Carp ();
@@ -25,7 +25,7 @@ sub BUILD {
 
 sub DEMOLISH {
     my $self = shift;
-    $counter--;
+    $counter--   if $counter > 0;
     $exception++ if keys %$self > 2; # Echo will delete first
 }
 

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libclass-tiny-perl.git