[libclass-tiny-perl] 02/05: Added tests for multiple inheritance.

[gregor herrmann]

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

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

commit 963c9fcb85e289e1b05d5b2ae0383c3688a5b52c
Author: Gelu Lupas <gelu at devnull.ro>
Date:   Fri Nov 1 20:44:50 2013 +0200

    Added tests for multiple inheritance.
---
 t/juliett.t      | 90 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 t/lib/India.pm   | 10 +++++++
 t/lib/Juliett.pm | 10 +++++++
 3 files changed, 110 insertions(+)

diff --git a/t/juliett.t b/t/juliett.t
new file mode 100644
index 0000000..ff785cc
--- /dev/null
+++ b/t/juliett.t
@@ -0,0 +1,90 @@
+use 5.008001;
+use strict;
+use warnings;
+use lib 't/lib';
+
+use Test::More 0.96;
+use TestUtils;
+
+require_ok("Juliett");
+
+subtest "attribute list" => sub {
+    is_deeply(
+        [ sort Class::Tiny->get_all_attributes_for("Juliett") ],
+        [ sort qw/foo bar baz qux kit/ ],
+        "attribute list correct",
+    );
+};
+
+subtest "empty list constructor" => sub {
+    my $obj = new_ok("Juliett");
+    is( $obj->foo, undef, "foo is undef" );
+    is( $obj->bar, undef, "bar is undef" );
+    is( $obj->baz, undef, "baz is undef" );
+    is( $obj->qux, undef, "qux is undef" );
+    is( $obj->kit, undef, "kit is undef" );
+};
+
+subtest "empty hash object constructor" => sub {
+    my $obj = new_ok( "Juliett", [ {} ] );
+    is( $obj->foo, undef, "foo is undef" );
+    is( $obj->bar, undef, "bar is undef" );
+    is( $obj->baz, undef, "baz is undef" );
+    is( $obj->qux, undef, "qux is undef" );
+    is( $obj->kit, undef, "kit is undef" );
+};
+
+subtest "subclass attribute set as list" => sub {
+    my $obj = new_ok( "Juliett", [ kit => 23 ] );
+    is( $obj->foo, undef, "foo is undef" );
+    is( $obj->bar, undef, "bar is undef" );
+    is( $obj->qux, undef, "baz is undef" );
+    is( $obj->qux, undef, "qux is undef" );
+    is( $obj->kit, 23,    "kit is set" );
+};
+
+subtest "superclass attribute set as list" => sub {
+    my $obj = new_ok( "Juliett", [ bar => 42, baz => 23, qux => 13, kit => 31 ] );
+    is( $obj->foo, undef, "foo is undef" );
+    is( $obj->bar, 42,    "bar is set" );
+    is( $obj->baz, 23,    "baz is set" );
+    is( $obj->qux, 13,    "qux is set" );
+    is( $obj->kit, 31,    "kit is set" );
+};
+
+subtest "all attributes set as list" => sub {
+    my $obj =
+      new_ok( "Juliett", [ foo => 13, bar => 42, baz => 23, qux => 11, kit => 31 ] );
+    is( $obj->foo, 13, "foo is set" );
+    is( $obj->bar, 42, "bar is set" );
+    is( $obj->baz, 23, "baz is set" );
+    is( $obj->qux, 11, "qux is set" );
+    is( $obj->kit, 31, "kit is set" );
+};
+
+subtest "attributes are RW" => sub {
+    my $obj = new_ok( "Juliett", [ { foo => 23, bar => 42 } ] );
+    is( $obj->foo(24), 24, "changing foo returns new value" );
+    is( $obj->foo,     24, "accessing foo returns changed value" );
+    is( $obj->baz(42), 42, "changing baz returns new value" );
+    is( $obj->baz,     42, "accessing baz returns changed value" );
+    is( $obj->qux(11), 11, "changing qux returns new value" );
+    is( $obj->qux,     11, "accessing qux returns changed value" );
+    is( $obj->kit(31), 31, "changing kit returns new value" );
+    is( $obj->kit,     31, "accessing kit rerutns changed value" );
+};
+
+subtest "exceptions" => sub {
+    like(
+        exception {
+            Juliett->new( foo => 23, bar => 42, baz => 13, qux => 11, kit => 31, wibble => 0 );
+        },
+        qr/Invalid attributes for Juliett: wibble/,
+        "creating object with 'wibble' dies",
+    );
+
+};
+
+done_testing;
+# COPYRIGHT
+# vim: ts=4 sts=4 sw=4 et:
diff --git a/t/lib/India.pm b/t/lib/India.pm
new file mode 100644
index 0000000..1781a7a
--- /dev/null
+++ b/t/lib/India.pm
@@ -0,0 +1,10 @@
+use 5.008001;
+use strict;
+use warnings;
+
+package India;
+use base 'Alfa';
+
+use Class::Tiny qw/qux/;
+
+1;
diff --git a/t/lib/Juliett.pm b/t/lib/Juliett.pm
new file mode 100644
index 0000000..e0aa37c
--- /dev/null
+++ b/t/lib/Juliett.pm
@@ -0,0 +1,10 @@
+use 5.008001;
+use strict;
+use warnings;
+
+package Juliett;
+use base 'Baker', 'India';
+
+use Class::Tiny qw/kit/;
+
+1;

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