[libclass-tiny-perl] 05/11: fix and test introspection for attribute overrides

[gregor herrmann]

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

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

commit 682755ce93b885e25b68d7b626072720e4701ea3
Author: David Golden <dagol...@cpan.org>
Date:   Wed Sep 4 21:35:54 2013 -0400

    fix and test introspection for attribute overrides
---
 lib/Class/Tiny.pm |  5 +++--
 t/hotel.t         | 38 ++++++++++++++++++++++++++++++++++++++
 t/lib/Hotel.pm    | 14 ++++++++++++++
 3 files changed, 55 insertions(+), 2 deletions(-)

diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm
index 0dd0a53..59f54fd 100644
--- a/lib/Class/Tiny.pm
+++ b/lib/Class/Tiny.pm
@@ -61,13 +61,14 @@ CODE
 
 sub get_all_attributes_for {
     my ( $class, $pkg ) = @_;
-    return map { keys %{ $CLASS_ATTRIBUTES{$_} || {} } } @{ 
mro::get_linear_isa($pkg) };
+    my %attr = map { $_ => undef } map { keys %{ $CLASS_ATTRIBUTES{$_} || {} } 
} @{ mro::get_linear_isa($pkg) };
+    return keys %attr;
 }
 
 sub get_all_attribute_defaults_for {
     my ( $class, $pkg ) = @_;
     my $defaults = {};
-    for my $p ( @{ mro::get_linear_isa($pkg) } ) {
+    for my $p ( reverse @{ mro::get_linear_isa($pkg) } ) {
         while ( my ( $k, $v ) = each %{ $CLASS_ATTRIBUTES{$p} || {} } ) {
             $defaults->{$k} = $v;
         }
diff --git a/t/hotel.t b/t/hotel.t
new file mode 100644
index 0000000..aeb7e93
--- /dev/null
+++ b/t/hotel.t
@@ -0,0 +1,38 @@
+use 5.008001;
+use strict;
+use warnings;
+use lib 't/lib';
+
+use Test::More 0.96;
+use TestUtils;
+
+require_ok("Hotel");
+
+subtest "attribute list" => sub {
+    my $attributes = [ sort Class::Tiny->get_all_attributes_for("Hotel") ];
+    is_deeply(
+        $attributes, 
+        [ sort qw/foo bar wibble wobble zig zag/ ],
+        "attribute list correct",
+    ) or diag explain $attributes;
+};
+
+subtest "attribute defaults" => sub {
+    my $def = Class::Tiny->get_all_attribute_defaults_for("Hotel");
+    is( keys %$def,         6,      "defaults hashref size" );
+    is( $def->{foo},        undef,  "foo default is undef" );
+    is( $def->{bar},        undef,  "bar default is undef" );
+    is( $def->{wibble},     23,     "wibble default overrides" );
+};
+
+subtest "attribute set as list" => sub {
+    my $obj = new_ok( "Hotel", [ foo => 42, bar => 23 ] );
+    is( $obj->foo, 42, "foo is set" );
+    is( $obj->bar, 23, "bar is set" );
+    is( $obj->wibble, 23, "wibble is set" );
+    is( ref $obj->wobble, 'HASH', "wobble default overrides" );
+};
+
+done_testing;
+# COPYRIGHT
+# vim: ts=4 sts=4 sw=4 et:
diff --git a/t/lib/Hotel.pm b/t/lib/Hotel.pm
new file mode 100644
index 0000000..859adff
--- /dev/null
+++ b/t/lib/Hotel.pm
@@ -0,0 +1,14 @@
+use 5.008001;
+use strict;
+use warnings;
+
+package Hotel;
+
+use base 'Golf';
+
+use Class::Tiny {
+    wibble => 23,
+    wobble => sub { {} },
+};
+
+1;

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

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits